Properly implement fromproperty markup handing in the pdftitle header field

The pdftitle header field is obtained by trying to convert the markup into a pure string.
Fromproperty markups need to be handled specially, since we have to mimick the header field
lookup in the conversion function... Thus we have to pass the header block to the
markup->string function and extract the header property values for fromproperty markups.

To keep the previous public API without the header argument working, the header
block is passed as an optional argument.

To prevent infinite loops, after looking up a header field, we temporarily
set it to an empty string for the following lookups. This is done by creating
a temporary guile module with that variable cleared.

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index ae97dbaf86ffada4614241493a3f11e6507dbd93..b412ab3269412a5a4809a10ea855b4c0b1adba1d 100644 (file)
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -424,7 +424,7 @@
           (fallbackval (ly:modules-lookup (list header) fallbackvar))
           (val (if overrideval overrideval fallbackval)))
       (if val
-         (format port "/~a (~a)\n" field (metadata-encode (markup->string val))))))
+         (format port "/~a (~a)\n" field (metadata-encode (markup->string val (list header)))))))
   (display "[ " port)
   (metadata-lookup-output 'pdfcomposer 'composer "Author")
   (format port "/Creator (LilyPond ~a)\n" (lilypond-version))

diff --git a/scm/markup.scm b/scm/markup.scm
index f402611d32434e5a2c9439069c14631b98b405f7..31bbaeeb420bb2d76373fb7d3a0551e40e9739eb 100644 (file)
--- a/scm/markup.scm
+++ b/scm/markup.scm
@@ -79,7 +79,8 @@ Example:
 
 ;;; 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
@@ -105,9 +106,9 @@ Example:
                                     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))) "")))
@@ -115,24 +116,36 @@ Example:
   (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"))))