[PATCH 3/4] Make define-builtin-markup{, -list}-command #:category #:properties keywords

[David Kastrup]

The specification of category and properties makes the *-builtin-*
variants diverge syntactically from the user specified markup.  Moving
those specifications into keyword arguments makes the builtin defining
macros upwards compatible with the user specified ones.
---
 scm/define-markup-commands.scm |    6 +++---
 scm/markup.scm                 |   37 +++++++++++++++++++++++--------------
 2 files changed, 26 insertions(+), 17 deletions(-)

diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index 0910f81..9628774 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -16,8 +16,8 @@
 ;;;
 ;;; (define-builtin-markup-command (command-name layout props args...)
 ;;;   args-signature
-;;;   category
-;;;   property-bindings
+;;;   [ #:category category ]
+;;;   [ #:properties property-bindings ]
 ;;;   documentation-string
 ;;;   ..body..)
 ;;;
@@ -36,7 +36,7 @@
 ;;;   args...
 ;;;     the command arguments. There are restrictions on the
 ;;;     possible arguments for a markup command.
-;;;     First, arguments are distingued according to their type:
+;;;     First, arguments are distinguished according to their type:
 ;;;       1) a markup (or a string), corresponding to type predicate `markup?'
 ;;;       2) a list of markups, corresponding to type predicate `markup-list?'
 ;;;       3) any scheme object, corresponding to type predicates such as
diff --git a/scm/markup.scm b/scm/markup.scm
index ceb6a86..c9baee3 100644
--- a/scm/markup.scm
+++ b/scm/markup.scm
@@ -45,8 +45,12 @@ The command is now available in markup mode, e.g.
 ;; List of markup list functions
 (define-public markup-list-function-list (list))
 
-(define-macro (define-builtin-markup-command command-and-args signature
-                category properties-or-copied-function . body)
+(use-modules (ice-9 optargs))
+
+(defmacro* define-builtin-markup-command
+  (command-and-args signature
+   #:key (category '()) (properties '())
+   #:rest body)
   "
 * Define a COMMAND-markup function after command-and-args and body,
 register COMMAND-markup and its signature,
@@ -60,14 +64,14 @@ register COMMAND-markup and its signature,
 Syntax:
   (define-builtin-markup-command (COMMAND layout props . arguments)
                                  argument-types
-                                 category
-                                 properties
+                                 [ #:category category ]
+                                 [ #:properties properties ]
     \"documentation string\"
     ...command body...)
  or:
   (define-builtin-markup-command COMMAND
                                  argument-types
-                                 category
+                                 [ :category category ]
                                  function)
 
 where:
@@ -76,17 +80,21 @@ where:
   properties a list of (property default-value) lists or COMMANDx-markup 
elements
     (when a COMMANDx-markup is found, the properties of the said commandx are
     added instead). No check is performed against cyclical references!
+
+  The specified properties are available as let-bound variables in the
+  command body.
 "
   (let* ((command (if (pair? command-and-args) (car command-and-args) 
command-and-args))
          (args (if (pair? command-and-args) (cdr command-and-args) '()))
          (command-name (string->symbol (format #f "~a-markup" command)))
          (make-markup-name (string->symbol (format #f "make-~a-markup" 
command))))
+    (while (and (pair? body) (keyword? (car body)))
+          (set! body (cddr body)))
     `(begin
        ;; define the COMMAND-markup function
        ,(if (pair? args)
             (let ((documentation (car body))
-                  (real-body (cdr body))
-                  (properties properties-or-copied-function))
+                  (real-body (cdr body)))
               `(define-public (,command-name ,@args)
                  ,documentation
                  (let ,(filter identity
@@ -102,7 +110,7 @@ where:
                                     properties))
                    ,@real-body)))
             (let ((args (gensym "args"))
-                  (markup-command properties-or-copied-function))
+                  (markup-command (car body)))
               `(define-public (,command-name . ,args)
                  ,(format #f "Copy of the ~a command." markup-command)
                  (apply ,markup-command ,args))))
@@ -125,21 +133,23 @@ where:
                                          (else
                                           `(list ',(car prop-spec)))))
                                 (if (pair? args)
-                                    properties-or-copied-function
+                                    properties
                                     (list)))))
        ;; define the make-COMMAND-markup function
        (define-public (,make-markup-name . args)
          (let ((sig (list ,@signature)))
            (make-markup ,command-name ,(symbol->string make-markup-name) sig 
args))))))
 
-(define-macro (define-builtin-markup-list-command command-and-args signature
-                properties . body)
+(defmacro* define-builtin-markup-list-command
+  (command-and-args signature #:key (properties '()) #:rest body)
   "Same as `define-builtin-markup-command, but defines a command that, when
 interpreted, returns a list of stencils instead os a single one"
   (let* ((command (if (pair? command-and-args) (car command-and-args) 
command-and-args))
          (args (if (pair? command-and-args) (cdr command-and-args) '()))
          (command-name (string->symbol (format #f "~a-markup-list" command)))
          (make-markup-name (string->symbol (format #f "make-~a-markup-list" 
command))))
+    (while (and (pair? body) (keyword? (car body)))
+          (set! body (cddr body)))
     `(begin
        ;; define the COMMAND-markup-list function
        ,(if (pair? args)
@@ -158,7 +168,7 @@ interpreted, returns a list of stencils instead os a single 
one"
                                             `(,prop (chain-assoc-get ',prop 
,props ,default-value)))
                                           #f))
                                     properties))
-                   ,@body)))
+                   ,@real-body)))
             (let ((args (gensym "args"))
                   (markup-command (car body)))
             `(define-public (,command-name . ,args)
@@ -215,8 +225,7 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked 
function.
 ;;; markup constructors
 ;;; lilypond-like syntax for markup construction in scheme.
 
-(use-modules (ice-9 optargs)
-             (ice-9 receive))
+(use-modules (ice-9 receive))
 
 (defmacro*-public markup (#:rest body)
   "The `markup' macro provides a lilypond-like syntax for building markups.
-- 
1.6.5.3.153.g0670