Merge branch 'stable'

[lilypond.git] / ly / markup-init.ly

diff --git a/ly/markup-init.ly b/ly/markup-init.ly
index f2461e41c32e44d0edc5a6f2b2b22481bf1789b2..5749c7bb8f9621a71813f4b40fcf9ce7ac9c6c80 100644 (file)
--- a/ly/markup-init.ly
+++ b/ly/markup-init.ly
@@ -1,5 +1,7 @@
 %% -*- Mode: Scheme -*-
 
+\version "2.12.0"
+
 %%;; to be define later, in a closure
 #(define-public toplevel-module-define-public! #f)
 #(define-public toplevel-module-ref #f)
@@ -83,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)))))))