X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=ly%2Fmarkup-init.ly;h=5749c7bb8f9621a71813f4b40fcf9ce7ac9c6c80;hb=eeec992b7029d0982bf4ed0eb3995e9ca99c10e9;hp=c40bd88ad4f5d7fd6a217a07cdd8c595aace4006;hpb=789a4c85d7d886b108751b7ed83651f62d3e387a;p=lilypond.git

diff --git a/ly/markup-init.ly b/ly/markup-init.ly
index c40bd88ad4..5749c7bb8f 100644
--- a/ly/markup-init.ly
+++ b/ly/markup-init.ly
@@ -1,6 +1,6 @@
 %% -*- Mode: Scheme -*-
 
-\version "2.11.9"
+\version "2.12.0"
 
 %%;; to be define later, in a closure
 #(define-public toplevel-module-define-public! #f)
@@ -85,3 +85,36 @@ or:
                         ,(symbol->string make-markup-name)
                         (list ,@signature)
                         args))))))
+
+#(defmacro-public define-markup-list-command (command-and-args signature . body)
+  "Same as `define-markup-command', but defines a command that, when interpreted,
+returns a list of stencils, instead of a single one."
+  (let* ((command (if (pair? command-and-args)
+		      (car command-and-args)
+		      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))))
+    `(begin
+       ;; define the COMMAND-markup-list procedure in toplevel module
+       ,(if (pair? command-and-args)
+	    ;; 1/ (define (COMMAND-markup-list layout props arg1 arg2 ...)
+	    ;;	    ..command body))
+	    `(define-public-toplevel (,command-name ,@(cdr command-and-args))
+	       ,@body)
+	    ;; 2/ (define (COMMAND-markup-list . args) (apply function args))
+	    (let ((args (gensym "args"))
+		  (command (car body)))
+	    `(define-public-toplevel (,command-name . ,args)
+	       (apply ,command ,args))))
+       (let ((command-proc (toplevel-module-ref ',command-name)))
+	 ;; register its command signature
+	 (set! (markup-command-signature command-proc)
+	       (list ,@signature))
+	 ;; it's a markup-list command:
+	 (set-object-property! command-proc 'markup-list-command #t)
+	 ;; define the make-COMMAND-markup-list procedure in the toplevel module
+	 (define-public-toplevel (,make-markup-name . args)
+	   (list (make-markup command-proc
+			      ,(symbol->string make-markup-name)
+			      (list ,@signature)
+			      args)))))))