From 1fb0cec0362ad8c6d2468c33af3bdd4d5bef827a Mon Sep 17 00:00:00 2001
From: David Kastrup <dak@gnu.org>
Date: Sun, 15 Jun 2014 14:12:34 +0200
Subject: [PATCH] Issue 4487/3: Implement partial markups

A partial markup acts as a chain of markup commands where everything but
the final markup has already been supplied.

For example:

bold-red-markup = \markup \bold \with-color #red \etc

\markup \bold-red "text"
\markuplist \column-lines \bold-red { One Two Three }

Please note that in order for \markup to recognize the resulting markup
command inside of markup expressions, the identifier to which the
resulting markup command is assigned needs to have "-markup" appended to
its name: LilyPond encodes markup command names in this manner so that
markup commands can use the same name as other entities outside of
markup mode.

Note also that this will not work with the markup macro since the latter
additionally requires the definition of a suitable make-bold-red-markup
command.
---
 input/regression/markup-partial.ly | 14 ++++++++++++++
 lily/include/lily-imports.hh       |  1 +
 lily/lily-imports.cc               |  1 +
 lily/parser.yy                     | 23 +++++++++++++++++++----
 scm/ly-syntax-constructors.scm     | 13 +++++++++++++
 5 files changed, 48 insertions(+), 4 deletions(-)
 create mode 100644 input/regression/markup-partial.ly

diff --git a/input/regression/markup-partial.ly b/input/regression/markup-partial.ly
new file mode 100644
index 0000000000..37d2255cd9
--- /dev/null
+++ b/input/regression/markup-partial.ly
@@ -0,0 +1,14 @@
+\version "2.19.24"
+
+\header
+{ texidoc = "Partial markups acts as a chain of markup
+  commands where everything but the final markup has already been
+  supplied."
+}
+
+\layout { ragged-right = ##t }
+
+bold-red-markup = \markup \bold \with-color #red \etc
+
+\markup \bold-red "Single markup"
+\markuplist \column-lines \bold-red { Markups in a list. }
diff --git a/lily/include/lily-imports.hh b/lily/include/lily-imports.hh
index 535b40bea4..383896a021 100644
--- a/lily/include/lily-imports.hh
+++ b/lily/include/lily-imports.hh
@@ -119,6 +119,7 @@ namespace Syntax {
   extern Variable multi_measure_rest;
   extern Variable music_function;
   extern Variable music_function_call_error;
+  extern Variable partial_markup;
   extern Variable partial_music_function;
   extern Variable property_operation;
   extern Variable repeat;
diff --git a/lily/lily-imports.cc b/lily/lily-imports.cc
index 2a8ecf9e84..3a694f9d10 100644
--- a/lily/lily-imports.cc
+++ b/lily/lily-imports.cc
@@ -112,6 +112,7 @@ namespace Syntax {
   Variable multi_measure_rest ("multi-measure-rest");
   Variable music_function ("music-function");
   Variable music_function_call_error ("music-function-call-error");
+  Variable partial_markup ("partial-markup");
   Variable partial_music_function ("partial-music-function");
   Variable property_operation ("property-operation");
   Variable repeat ("repeat");
diff --git a/lily/parser.yy b/lily/parser.yy
index e8fb1b9383..9da363df93 100644
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -510,6 +510,7 @@ embedded_scm_bare_arg:
 		$$ = parser->lexer_->eval_scm_token ($1, @1);
 	}
 	| FRACTION
+	| partial_markup
 	| full_markup_list
 	| context_modification
 	| score_block
@@ -692,6 +693,7 @@ identifier_init_nonumber:
 	| FRACTION
 	| string
         | embedded_scm
+	| partial_markup
 	| full_markup_list
         | context_modification
 	| partial_function ETC
@@ -3612,11 +3614,24 @@ full_markup_list:
 	}
 	;
 
-full_markup:
+markup_mode:
 	MARKUP
-		{ parser->lexer_->push_markup_state (); }
-	markup_top {
-		$$ = $3;
+	{
+		parser->lexer_->push_markup_state ();
+	}
+	;
+
+full_markup:
+	markup_mode markup_top {
+		$$ = $2;
+		parser->lexer_->pop_state ();
+	}
+	;
+
+partial_markup:
+	markup_mode markup_head_1_list ETC
+	{
+		$$ = MAKE_SYNTAX (partial_markup, @2, $2);
 		parser->lexer_->pop_state ();
 	}
 	;
diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm
index b617f72764..a0d35ae92e 100644
--- a/scm/ly-syntax-constructors.scm
+++ b/scm/ly-syntax-constructors.scm
@@ -198,6 +198,19 @@ into a @code{MultiMeasureTextEvent}."
                       (make-map-markup-commands-markup-list
                        compose complex) completed))))))))
 
+(define-public (partial-markup commands)
+  ;; Like composed-markup-list, except that the result is a single
+  ;; markup command that can be applied to one markup
+  (define (compose arg)
+    (fold
+     (lambda (cmd prev) (append cmd (list prev)))
+     arg
+     commands))
+  (let ((chain (lambda (layout props arg)
+                 (interpret-markup layout props (compose arg)))))
+    (set-object-property! chain 'markup-signature (list markup?))
+    chain))
+
 (define-public (property-operation ctx music-type symbol . args)
   (let* ((props (case music-type
                   ((PropertySet) (list 'value (car args)))
-- 
2.39.2