aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/guile/skribilo/lib.scm41
1 files changed, 25 insertions, 16 deletions
diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm
index 3be013a..8c4c382 100644
--- a/src/guile/skribilo/lib.scm
+++ b/src/guile/skribilo/lib.scm
@@ -1,7 +1,7 @@
;;; lib.scm -- Utilities.
;;;
;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
-;;; Copyright 2005, 2007 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2005, 2007 Ludovic Courtès <ludo@gnu.org>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -73,29 +73,38 @@
(define-macro (define-markup 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 is not what Skribe/DSSSL
- ;; expect, hence `fix-rest-arg'.
+ ;; `:rest' argument can only appear last, which is not what Skribe/DSSSL
+ ;; expect, hence `fix-rest-arg'. In addition, all keyword arguments are
+ ;; allowed (hence `:allow-other-keys'); they are then checked by `verify'.
(define (fix-rest-arg args)
- (let loop ((args args)
- (result '())
- (rest-arg #f))
+ (let loop ((args args)
+ (result '())
+ (rest-arg '())
+ (has-keywords? #f))
(cond ((null? args)
- (if rest-arg
- (append (reverse result) rest-arg)
- (reverse result)))
+ (let ((result (if has-keywords?
+ (cons :allow-other-keys result)
+ result)))
+ (append! (reverse! result) rest-arg)))
((list? args)
- (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 ((is-rest-arg? (eq? (car args) :rest))
+ (is-keyword? (eq? (car args) :key)))
+ (if is-rest-arg?
+ (loop (cddr args)
+ result
+ (list (car args) (cadr args))
+ (or has-keywords? is-keyword?))
+ (loop (cdr args)
+ (cons (car args) result)
+ rest-arg
+ (or has-keywords? is-keyword?)))))
((pair? args)
(loop '()
(cons (car args) result)
- (list #:rest (cdr args)))))))
+ (list #:rest (cdr args))
+ has-keywords?)))))
(let ((name (car bindings))
(opts (cdr bindings)))