From: David Kastrup <dak@gnu.org>
Date: Thu, 21 Mar 2013 19:32:33 +0000 (+0100)
Subject: Move map-markup-command-list into parser internals
X-Git-Tag: release/2.17.16-1~30
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=e7d8a172d79b5172dfc66df8c17cb292d6baccbb;p=lilypond.git

Move map-markup-command-list into parser internals
---

diff --git a/lily/parser.yy b/lily/parser.yy
index ee413b301f..d59d329c8e 100644
--- 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 4cbf9a67aa..3fdf698727 100644
--- 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 a3d3a9d927..07194407c5 100644
--- 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))