Move map-markup-command-list into parser internals

diff --git a/lily/parser.yy b/lily/parser.yy
index ee413b301feb33f4d16d4a372c4a4c4c0ccfd8bc..d59d329c8e6c59689ece7d1352c5278ca695f4ce 100644 (file)
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -3277,8 +3277,10 @@ markup_top:
        simple_markup_list {
                $$ = scm_list_2 (ly_lily_module_constant ("line-markup"),  $1);
        }
-       | markup_head_1_list simple_markup      {
-               $$ = scm_car (scm_call_2 (ly_lily_module_constant ("map-markup-command-list"), $1, scm_list_1 ($2)));
+       | markup_head_1_list simple_markup
+       {
+               $$ = scm_car (MAKE_SYNTAX ("composed-markup-list",
+                                          @2, $1, scm_list_1 ($2)));
        }
        | simple_markup {
                $$ = $1;
@@ -3336,8 +3338,8 @@ markup_score:
 
 markup_composed_list:
        markup_head_1_list markup_braced_list {
-               $$ = scm_call_2 (ly_lily_module_constant ("map-markup-command-list"), $1, $2);
-
+               $$ = MAKE_SYNTAX ("composed-markup-list",
+                                 @2, $1, $2);
        }
        ;
 
@@ -3415,9 +3417,10 @@ simple_markup:
        ;
 
 markup:
-       markup_head_1_list simple_markup        {
-               SCM mapper = ly_lily_module_constant ("map-markup-command-list");
-               $$ = scm_car (scm_call_2 (mapper, $1, scm_list_1 ($2)));
+       markup_head_1_list simple_markup
+       {
+               $$ = scm_car (MAKE_SYNTAX ("composed-markup-list",
+                                          @2, $1, scm_list_1 ($2)));
        }
        | simple_markup {
                $$ = $1;

diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm
index 4cbf9a67aa9a5b0e6775d415a3db36f8cadeaf29..3fdf6987273e4fa1e82d202e81d8e787ee5c8fc3 100644 (file)
--- a/scm/ly-syntax-constructors.scm
+++ b/scm/ly-syntax-constructors.scm
@@ -164,6 +164,29 @@ into a @code{MultiMeasureTextEvent}."
     (if create-new (set! (ly:music-property csm 'create-new) #t))
     csm))
 
+(define-ly-syntax (composed-markup-list parser location 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 (lambda (arg)
+         (fold
+          (lambda (cmd prev) (append cmd (list prev)))
+          arg
+          commands))
+       (if (every markup? markups)
+           markups
+           (begin
+             (ly:parser-error parser
+                              (format #f
+                                      (_ "uncomposable markup list elements ~a")
+                                      (remove markup? markups))
+                              location)
+             (filter markup? markups)))))
+
 (define-ly-syntax (property-operation parser location ctx music-type symbol . args)
   (let* ((props (case music-type
                  ((PropertySet) (list 'value (car args)))

diff --git a/scm/markup-macros.scm b/scm/markup-macros.scm
index a3d3a9d92739e9d26bec448301c52325364f9b22..07194407c536962dca1d3b64b74b08493bea4da7 100644 (file)
--- a/scm/markup-macros.scm
+++ b/scm/markup-macros.scm
@@ -454,20 +454,3 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
                (string->symbol (format #f "~a-markup-list" code)))))
     (and proc (markup-list-function? proc)
          (cons proc (markup-command-signature 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 (lambda (arg)
-         (fold
-          (lambda (cmd prev) (append cmd (list prev)))
-          arg
-          commands))
-       markups))