X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmarkup.scm;h=a4f723e04c1d6f1162ee881b58f7af0f9acfa3d3;hb=85d4958c021936c64b6ef9d514a6a2b0d269cc58;hp=47ebe5d2bcd969f110a4a0adbb70a7516e6bdba3;hpb=a066a93ee74edebb9d238a1bac93c3bc7e8e6e4a;p=lilypond.git

diff --git a/scm/markup.scm b/scm/markup.scm
index 47ebe5d2bc..a4f723e04c 100644
--- a/scm/markup.scm
+++ b/scm/markup.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2003--2011 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2003--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -32,8 +32,7 @@ Example:
   (markup \"foo\"
           #:raise 0.2 #:hbracket #:bold \"bar\"
           #:override '(baseline-skip . 4)
-          #:bracket #:column (\"baz\" \"bazr\" \"bla\"))
-Use `markup*' in a \\notemode context."
+          #:bracket #:column (\"baz\" \"bazr\" \"bla\"))"
 
   (car (compile-all-markup-expressions `(#:line ,body))))
 
@@ -63,7 +62,8 @@ Use `markup*' in a \\notemode context."
   (cons (acons key val (car chain)) (cdr chain)))
 
 (define-public (stack-stencil-line space stencils)
-  "DOCME"
+  "Adjoin a list of STENCILS along the X axis, leaving SPACE between the
+   end of each stencil and the reference point of the following stencil."
   (if (and (pair? stencils)
            (ly:stencil? (car stencils)))
 
@@ -71,7 +71,7 @@ Use `markup*' in a \\notemode context."
                (ly:stencil? (cadr stencils)))
           (let* ((tail (stack-stencil-line space (cdr stencils)))
                  (head (car stencils))
-                 (xoff (+ space (interval-length (ly:stencil-extent head X)))))
+                 (xoff (+ space (interval-end (ly:stencil-extent head X)))))
             (ly:stencil-add head
                             (ly:stencil-translate-axis tail xoff X)))
           (car stencils))
@@ -80,7 +80,8 @@ Use `markup*' in a \\notemode context."
 
 ;;; convert a full markup object to an approximate pure string representation
 
-(define-public (markup->string m)
+(define-public (markup->string m . argscopes)
+(let* ((scopes (if (pair? argscopes) (car argscopes) '())))
   ;; markup commands with one markup argument, formatting ignored
   (define markups-first-argument '(list
                                    bold-markup box-markup caps-markup dynamic-markup finger-markup
@@ -106,9 +107,9 @@ Use `markup*' in a \\notemode context."
                                     translate-scaled-markup with-url-markup scale-markup ))
 
   ;; helper functions to handle string cons like string lists
-  (define (markup-cons->string-cons c)
-    (if (not (pair? c)) (markup->string c)
-        (cons (markup->string (car c)) (markup-cons->string-cons (cdr c)))))
+  (define (markup-cons->string-cons c scopes)
+    (if (not (pair? c)) (markup->string c scopes)
+        (cons (markup->string (car c) scopes) (markup-cons->string-cons (cdr c) scopes))))
   (define (string-cons-join c)
     (if (not (pair? c)) c
         (string-join (list (car c) (string-cons-join (cdr c))) "")))
@@ -116,24 +117,36 @@ Use `markup*' in a \\notemode context."
   (cond
    ((string? m) m)
    ((null? m) "")
+   ((not (pair? m)) "")
 
    ;; handle \concat (string-join without spaces)
    ((and (pair? m) (equal? (car m) concat-markup))
-    (string-cons-join (markup-cons->string-cons (cadr m))) )
+    (string-cons-join (markup-cons->string-cons (cadr m) scopes)) )
 
    ;; markup functions with the markup as first arg
    ((member (car m) (primitive-eval markups-first-argument))
-    (markup->string (cadr m)))
+    (markup->string (cadr m) scopes))
 
    ;; markup functions with markup as second arg
    ((member (car m) (primitive-eval markups-second-argument))
-    (markup->string (cddr m)))
+    (markup->string (cddr m) scopes))
+
+   ;; fromproperty-markup reads property values from the header block:
+   ((equal? (car m) fromproperty-markup)
+    (let* ((varname (symbol->string (cadr m)))
+           ;; cut off the header: prefix from the variable name:
+           (newvarname (if (string-prefix? "header:" varname) (substring varname 7) varname))
+           (var (string->symbol newvarname))
+           (mod (make-module 1)))
+      ;; Prevent loops by temporarily clearing the variable we have just looked up
+      (module-define! mod var "")
+      (markup->string (ly:modules-lookup scopes var) (cons mod scopes))))
 
    ;; ignore all other markup functions
    ((markup-function? (car m)) "")
 
    ;; handle markup lists
    ((list? m)
-    (string-join (map markup->string m) " "))
+    (string-join (map (lambda (mm) (markup->string mm scopes)) m) " "))
 
-   (else "ERROR, unable to extract string from markup")))
+   (else "ERROR, unable to extract string from markup"))))