*** empty log message ***

[lilypond.git] / scm / new-markup.scm

diff --git a/scm/new-markup.scm b/scm/new-markup.scm
index d9cabccea2fc830c2223de59f835acc5c538a4cc..a5dbc73f58e43a6e731b8a34d4e50ab5402af59b 100644 (file)
--- a/scm/new-markup.scm
+++ b/scm/new-markup.scm
@@ -331,6 +331,24 @@ Also set markup-signature and markup-keyword object properties."
   (let ((proc (markup-symbol-to-proc (string->symbol (string-append code "-markup")))))
     (and proc (cons proc (markup-command-keyword proc)))))
 
+;;;;;;;;;;;;;;;;;;;;;;
+;;; used in parser.yy to map a list of markup commands on markup arguments
+(define-public (map-markup-command-list commands markups)
+  "`markups' being a list of markups, eg (markup1 markup2 markup3),
+and `commands' a list of commands with their scheme arguments, in reverse order,
+eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
+ ((bold (raise 4 (italic markup1)))
+  (bold (raise 4 (italic markup2)))
+  (bold (raise 4 (italic markup3))))
+"
+  (map-in-order (lambda (arg)
+                  (let ((result arg))
+                    (for-each (lambda (cmd)
+                                (set! result (append cmd (list result))))
+                              commands)
+                    result))
+                markups))
+
 ;;;;;;;;;;;;;;;;;;;;;;
 ;;; markup type predicates
 
@@ -338,9 +356,9 @@ Also set markup-signature and markup-keyword object properties."
   (not (not (markup-command-signature x))))
 
 (define (markup-list? arg)
-  (define (markup-list-inner? l)
-    (or (null? l)
-        (and (markup? (car l)) (markup-list-inner? (cdr l)))))
+  (define (markup-list-inner? lst)
+    (or (null? lst)
+        (and (markup? (car lst)) (markup-list-inner? (cdr lst)))))
   (and (list? arg) (markup-list-inner? arg)))
 
 (define (markup-argument-list? signature arguments)