From c323ee2c0207a02d8af1d0366fdf000f051fdb27 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Thu, 16 Jun 2005 14:03:52 +0000
Subject: One step further with the Guile port.

* src/guile/skribilo.scm:  Use `getopt-long'; include all the necessary
  modules that user-visible macros depend on.
  Use `read-hash-extend' to allow for DSSSL-style keywords, as needed by
  Skribe modules.

* src/guile/skribe/debug.scm:  Export `with-debug' and `%with-debug'.

* src/guile/skribe/lib.scm (new):  Fixed.
  (define-markup):  Fixed (more the `rest' argument to the end).

git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-5
---
 src/guile/skribe/debug.scm |  5 +++--
 src/guile/skribe/lib.scm   | 29 ++++++++++++++++++++---------
 2 files changed, 23 insertions(+), 11 deletions(-)

(limited to 'src/guile/skribe')

diff --git a/src/guile/skribe/debug.scm b/src/guile/skribe/debug.scm
index 01f88c2..e2bff27 100644
--- a/src/guile/skribe/debug.scm
+++ b/src/guile/skribe/debug.scm
@@ -25,7 +25,8 @@
 
 
 (define-module (skribe debug)
-   :export (debug-item skribe-debug set-skribe-debug! add-skribe-debug-symbol
+   :export (with-debug %with-debug
+	    debug-item skribe-debug set-skribe-debug! add-skribe-debug-symbol
 	    no-debug-color))
 
 (define *skribe-debug* 			0)
@@ -138,7 +139,7 @@
       r)))
 
 (define-macro (with-debug  level label . body)
-  `((in-module SKRIBE-DEBUG-MODULE %with-debug) ,level ,label (lambda () ,@body)))
+  `(%with-debug ,level ,label (lambda () ,@body)))
 
 ;;(define-macro (with-debug  level label . body)
 ;;  `(begin ,@body))
diff --git a/src/guile/skribe/lib.scm b/src/guile/skribe/lib.scm
index 4a9b471..fa5e962 100644
--- a/src/guile/skribe/lib.scm
+++ b/src/guile/skribe/lib.scm
@@ -29,23 +29,34 @@
 ;;;
 ;;; NEW
 ;;;
-(define (maybe-copy obj)
-  (if (pair-mutable? obj)
-      obj
-      (copy-tree obj)))
-
 (define-macro (new class . parameters)
-  `(make ,(string->symbol (format "<~a>" class))
+  `(make ,(string->symbol (format #f "<~a>" class))
      ,@(apply append (map (lambda (x)
-			    `(,(make-keyword (car x)) (maybe-copy ,(cadr x))))
+			    `(,(symbol->keyword (car x)) ,(cadr x)))
 			  parameters))))
 
 ;;;
 ;;; DEFINE-MARKUP
 ;;;
 (define-macro (define-markup bindings . body)
-  ;; This is just a STklos extended lambda. Nothing to do
-  `(define ,bindings ,@body))
+  ;; This is just an `(ice-9 optargs)' kind of `lambda*', with DSSSL
+  ;; keyword-style conversion enabled.  However, using `(ice-9 optargs)', the
+  ;; `#:rest' argument can only appear last which not what Skribe/DSSSL
+  ;; expect, hence `fix-rest-arg'.
+  (define (fix-rest-arg args)
+    (let loop ((args args)
+	       (result '())
+	       (rest-arg #f))
+      (if (null? args)
+	  (if rest-arg (append (reverse result) rest-arg) (reverse result))
+	  (let ((is-rest-arg? (eq? (car args) #:rest)))
+	    (loop (if is-rest-arg? (cddr args) (cdr args))
+		  (if is-rest-arg? result (cons (car args) result))
+		  (if is-rest-arg? (list (car args) (cadr args)) rest-arg))))))
+
+  (let ((name (car bindings))
+	(opts (cdr bindings)))
+    `(define* ,(cons name (fix-rest-arg opts)) ,@body)))
 
 
 ;;;
-- 
cgit v1.2.3