From: Werner Lemberg <wl@gnu.org>
Date: Wed, 29 Nov 2006 17:27:55 +0000 (+0100)
Subject: Add \concat markup command.
X-Git-Tag: release/2.11.1-1~33^2~1
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=0c8c9010f016254c575abdfb614d4a87b521087a;p=lilypond.git

Add \concat markup command.
---

diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index cb0b2a843a..25ced26a9b 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -416,6 +416,28 @@ determines the space between each markup in @var{args}."
      space
      (remove ly:stencil-empty? stencils))))
 
+(define-markup-command (concat layout props args) (markup-list?)
+  "Concatenate @var{args} in a horizontal line, without spaces inbetween.
+Strings and simple markups are concatenated on the input level, allowing
+ligatures.  For example, @code{\\concat @{ \"f\" \\simple #\"i\" @}} is
+equivalent to @code{\"fi\"}."
+
+  (define (concat-string-args arg-list)
+    (fold-right (lambda (arg result-list)
+                  (let ((result (if (pair? result-list)
+                                    (car result-list)
+                                  '())))
+                    (if (and (pair? arg) (eqv? (car arg) simple-markup))
+                      (set! arg (cadr arg)))
+                    (if (and (string? result) (string? arg))
+                        (cons (string-append arg result) (cdr result-list))
+                      (cons arg result-list))))
+                '()
+                arg-list))
+
+  (interpret-markup layout
+                    (prepend-alist-chain 'word-space 0 props)
+                    (make-line-markup (concat-string-args args))))
 
 (define (wordwrap-stencils stencils
 			   justify base-space line-width text-dir)