X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmarkup.scm;h=3cf774d4a880bfd66f8e9cc8bd152411143aafa8;hb=a43a9465fda1728a64fae3619c3f936589dbbdf0;hp=f1e32402366a50b5cfa05aebcf71efb469f6c099;hpb=66adac8fa4ba5126100ff8748a2576c6983637c5;p=lilypond.git

diff --git a/scm/markup.scm b/scm/markup.scm
index f1e3240236..3cf774d4a8 100644
--- a/scm/markup.scm
+++ b/scm/markup.scm
@@ -1,8 +1,19 @@
-;;;; markup.scm -- Implement a user extensible markup scheme.
+;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;;  source file of the GNU LilyPond music typesetter
-;;;; 
-;;;; (c) 2003--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2003--2011 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
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
 
 "
 Internally markup is stored as lists, whose head is a function.
@@ -11,7 +22,7 @@ Internally markup is stored as lists, whose head is a function.
 
 When the markup is formatted, then FUNCTION is called as follows
 
-  (FUNCTION GROB PROPS ARG1 ARG2 ... ) 
+  (FUNCTION GROB PROPS ARG1 ARG2 ... )
 
 GROB is the current grob, PROPS is a list of alists, and ARG1.. are
 the rest of the arguments.
@@ -20,9 +31,7 @@ The function should return a stencil (i.e. a formatted, ready to
 print object).
 
 
-To add a builtin markup command, use the define-builtin-markup-command
-utility. In a user file, the define-markup-command macro shall be used
-(see ly/markup-init.ly).
+To add a markup command, use the define-markup-command utility.
 
   (define-markup-command (mycommand layout prop arg1 ...) (arg1-type? ...)
     \"my command usage and description\"
@@ -37,82 +46,201 @@ The command is now available in markup mode, e.g.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; markup definer utilities
 
-(define-macro (define-builtin-markup-command command-and-args signature . body)
+;; For documentation purposes
+;; category -> markup functions
+(define-public markup-functions-by-category (make-hash-table 150))
+;; markup function -> used properties
+(define-public markup-functions-properties (make-weak-key-hash-table 151))
+;; List of markup list functions
+(define-public markup-list-functions (make-weak-key-hash-table 151))
+
+(use-modules (ice-9 optargs))
+
+(defmacro*-public define-markup-command
+  (command-and-args signature
+   #:key (category '()) (properties '())
+   #:rest body)
   "
 * Define a COMMAND-markup function after command-and-args and body,
 register COMMAND-markup and its signature,
 
-* add COMMAND-markup to markup-function-list,
+* add COMMAND-markup to markup-functions-by-category,
 
-* sets COMMAND-markup markup-signature and markup-keyword object properties,
+* sets COMMAND-markup markup-signature object property,
 
 * define a make-COMMAND-markup function.
 
 Syntax:
-  (define-builtin-markup-command (COMMAND layout props arg1 arg2 ...)
-                                 (arg1-type? arg2-type? ...)
+  (define-markup-command (COMMAND layout props . arguments)
+                                 argument-types
+                                 [ #:properties properties ]
     \"documentation string\"
     ...command body...)
- or:
-  (define-builtin-markup-command COMMAND (arg1-type? arg2-type? ...)
-    function)
+
+where:
+  `argument-types' is a list of type predicates for arguments
+  `properties' a list of (property default-value) lists
+
+The specified properties are available as let-bound variables in the
+command body, using the respective `default-value' as fallback in case
+`property' is not found in `props'.  `props' itself is left unchanged:
+if you want defaults specified in that manner passed down into other
+markup functions, you need to adjust `props' yourself.
+
+The autogenerated documentation makes use of some optional
+specifications that are otherwise ignored:
+
+After `argument-types', you may also specify
+                                 [ #:category category ]
+where:
+  `category' is either a symbol or a symbol list specifying the
+             category for this markup command in the docs.
+
+As an element of the `properties' list, you may directly use a
+COMMANDx-markup symbol instead of a `(prop value)' list to indicate
+that this markup command is called by the newly defined command,
+adding its properties to the documented properties of the new
+command.  There is no protection against circular definitions.
 "
-  (let* ((command (if (pair? command-and-args) (car command-and-args) command-and-args))
-         (args (if (pair? command-and-args) (cdr command-and-args) '()))
+  (let* ((command (car command-and-args))
+         (args (cdr command-and-args))
          (command-name (string->symbol (format #f "~a-markup" command)))
          (make-markup-name (string->symbol (format #f "make-~a-markup" command))))
+    (while (and (pair? body) (keyword? (car body)))
+	   (set! body (cddr body)))
     `(begin
        ;; define the COMMAND-markup function
-       ,(if (pair? args)
-            `(define-public (,command-name ,@args)
-               ,@body)
-            (let ((args (gensym "args"))
-                  (markup-command (car body)))
-            `(define-public (,command-name . ,args)
-               ,(format #f "Copy of the ~a command" markup-command)
-               (apply ,markup-command ,args))))
+       ,(let* ((documentation (if (string? (car body))
+				  (list (car body))
+				  '()))
+	       (real-body (if (or (null? documentation)
+				  (null? (cdr body)))
+			      body (cdr body))))
+	  `(define-public (,command-name ,@args)
+	     ,@documentation
+	     (let ,(map (lambda (prop-spec)
+			  (let ((prop (car prop-spec))
+				(default-value (if (null? (cdr prop-spec))
+						   #f
+						   (cadr prop-spec)))
+				(props (cadr args)))
+			    `(,prop (chain-assoc-get ',prop ,props ,default-value))))
+			(filter pair? properties))
+	       ,@real-body)))
        (set! (markup-command-signature ,command-name) (list ,@signature))
-       ;; add the command to markup-function-list, for markup documentation
-       (if (not (member ,command-name markup-function-list))
-           (set! markup-function-list (cons ,command-name markup-function-list)))
+       ;; Register the new function, for markup documentation
+       ,@(map (lambda (category)
+		`(hashq-set!
+		  (or (hashq-ref markup-functions-by-category ',category)
+		      (let ((hash (make-weak-key-hash-table 151)))
+			(hashq-set! markup-functions-by-category ',category
+				    hash)
+			hash))
+		  ,command-name #t))
+	      (if (list? category) category (list category)))
+       ;; Used properties, for markup documentation
+       (hashq-set! markup-functions-properties
+		   ,command-name
+		   (list ,@(map (lambda (prop-spec)
+				  (cond ((symbol? prop-spec)
+					 prop-spec)
+					 ((not (null? (cdr prop-spec)))
+					  `(list ',(car prop-spec) ,(cadr prop-spec)))
+					 (else
+					  `(list ',(car prop-spec)))))
+				(if (pair? args)
+				    properties
+				    (list)))))
        ;; define the make-COMMAND-markup function
        (define-public (,make-markup-name . args)
-         (let ((sig (list ,@signature)))
-           (make-markup ,command-name ,(symbol->string make-markup-name) sig args))))))
+	 (let ((sig (list ,@signature)))
+	   (make-markup ,command-name ,(symbol->string make-markup-name) sig args))))))
+
+(defmacro*-public define-markup-list-command
+  (command-and-args signature #:key (properties '()) #:rest body)
+  "Same as `define-markup-command', but defines a command that, when
+interpreted, returns a list of stencils instead of a single one"
+  (let* ((command (car command-and-args))
+         (args (cdr command-and-args))
+         (command-name (string->symbol (format #f "~a-markup-list" command)))
+         (make-markup-name (string->symbol (format #f "make-~a-markup-list" command))))
+    (while (and (pair? body) (keyword? (car body)))
+	   (set! body (cddr body)))
+    `(begin
+       ;; define the COMMAND-markup-list function
+       ,(let* ((documentation (if (string? (car body))
+				  (list (car body))
+				  '()))
+	       (real-body (if (or (null? documentation)
+				  (null? (cdr body)))
+			      body (cdr body))))
+	  `(define-public (,command-name ,@args)
+	     ,@documentation
+	     (let ,(map (lambda (prop-spec)
+			  (let ((prop (car prop-spec))
+				(default-value (if (null? (cdr prop-spec))
+						   #f
+						   (cadr prop-spec)))
+				(props (cadr args)))
+			    `(,prop (chain-assoc-get ',prop ,props ,default-value))))
+			(filter pair? properties))
+	       ,@real-body)))
+       (set! (markup-command-signature ,command-name) (list ,@signature))
+       ;; add the command to markup-list-function-list, for markup documentation
+       (hashq-set! markup-list-functions ,command-name #t)
+       ;; Used properties, for markup documentation
+       (hashq-set! markup-functions-properties
+		   ,command-name
+		   (list ,@(map (lambda (prop-spec)
+				  (cond ((symbol? prop-spec)
+					 prop-spec)
+					 ((not (null? (cdr prop-spec)))
+					  `(list ',(car prop-spec) ,(cadr prop-spec)))
+					 (else
+					  `(list ',(car prop-spec)))))
+				(if (pair? args)
+				    properties
+				    (list)))))
+       ;; it's a markup-list command:
+       (set-object-property! ,command-name 'markup-list-command #t)
+       ;; define the make-COMMAND-markup-list function
+       (define-public (,make-markup-name . args)
+	 (let ((sig (list ,@signature)))
+	   (list (make-markup ,command-name
+			      ,(symbol->string make-markup-name) sig args)))))))
 
 (define-public (make-markup markup-function make-name signature args)
-  " Construct a markup object from MARKUP-FUNCTION and ARGS. Typecheck
-against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
-"
+  "Construct a markup object from @var{markup-function} and @var{args}.
+Typecheck against @var{signature}, reporting @var{make-name} as the
+user-invoked function."
   (let* ((arglen (length args))
-         (siglen (length signature))
-         (error-msg (if (and (> siglen 0) (> arglen 0))
-                        (markup-argument-list-error signature args 1)
-                        #f)))
+	 (siglen (length signature))
+	 (error-msg (if (and (> siglen 0) (> arglen 0))
+			(markup-argument-list-error signature args 1)
+			#f)))
     (if (or (not (= arglen siglen)) (< siglen 0) (< arglen 0))
-        (ly:error (string-append make-name ": "
-                   (_ "Wrong number of arguments.  Expect: ~A, found ~A: ~S"))
+	(ly:error (string-append make-name ": "
+		   (_ "Wrong number of arguments.  Expect: ~A, found ~A: ~S"))
 		  siglen arglen args))
     (if error-msg
-        (ly:error
+	(ly:error
 	 (string-append
 	  make-name ": "
-	  (_ "Invalid argument in position ~A.  Expect: ~A, found: ~S.")
-	  error-msg))
+	  (_ "Invalid argument in position ~A.  Expect: ~A, found: ~S."))
+	  (car error-msg) (cadr error-msg)(caddr error-msg))
 	(cons markup-function args))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; markup constructors
 ;;; lilypond-like syntax for markup construction in scheme.
 
-(use-modules (ice-9 optargs)
-             (ice-9 receive))
+(use-modules (ice-9 receive))
 
 (defmacro*-public markup (#:rest body)
   "The `markup' macro provides a lilypond-like syntax for building markups.
 
  - #:COMMAND is used instead of \\COMMAND
- - #:line ( ... ) is used instead of \line { ... }
+ - #:line ( ... ) is used instead of \\line { ... }
  - etc.
 
 Example:
@@ -124,17 +252,17 @@ Example:
          <==>
   (markup \"foo\"
           #:raise 0.2 #:hbracket #:bold \"bar\"
-          #:override '(baseline-skip . 4) 
+          #:override '(baseline-skip . 4)
           #:bracket #:column (\"baz\" \"bazr\" \"bla\"))
 Use `markup*' in a \\notemode context."
-  
+
   (car (compile-all-markup-expressions `(#:line ,body))))
 
 (defmacro*-public markup* (#:rest body)
   "Same as `markup', for use in a \\notes block."
   `(ly:export (markup ,@body)))
-  
-  
+
+
 (define (compile-all-markup-expressions expr)
   "Return a list of canonical markups expressions, e.g.:
   (#:COMMAND1 arg11 arg12 #:COMMAND2 arg21 arg22 arg23)
@@ -159,24 +287,26 @@ Use `markup*' in a \\notemode context."
   (cond ((and (pair? expr)
               (keyword? (car expr)))
          ;; expr === (#:COMMAND arg1 ...)
-         (let* ((command (symbol->string (keyword->symbol (car expr))))
-                (sig (markup-command-signature
-		      (car (lookup-markup-command command))))
-                (sig-len (length sig)))
-           (do ((i 0 (1+ i))
-                (args '() args)
-                (rest (cdr expr) rest))
-               ((>= i sig-len)
-                (values (cons (keyword->make-markup (car expr)) (reverse args)) rest))
-             (cond ((eqv? (list-ref sig i) markup-list?)
-                    ;; (car rest) is a markup list
-                    (set! args (cons `(list ,@(compile-all-markup-expressions (car rest))) args))
-                    (set! rest (cdr rest)))
-                   (else
-                    ;; pick up one arg in `rest'
-                    (receive (a r) (compile-markup-arg rest)
-                             (set! args (cons a args))
-                             (set! rest r)))))))
+         (let ((command (symbol->string (keyword->symbol (car expr)))))
+            (if (not (pair? (lookup-markup-command command)))
+                (ly:error (_ "Not a markup command: ~A") command))
+            (let* ((sig (markup-command-signature
+                         (car (lookup-markup-command command))))
+                   (sig-len (length sig)))
+              (do ((i 0 (1+ i))
+                   (args '() args)
+                   (rest (cdr expr) rest))
+                  ((>= i sig-len)
+                   (values (cons (keyword->make-markup (car expr)) (reverse args)) rest))
+                (cond ((eqv? (list-ref sig i) markup-list?)
+                       ;; (car rest) is a markup list
+                       (set! args (cons `(list ,@(compile-all-markup-expressions (car rest))) args))
+                       (set! rest (cdr rest)))
+                      (else
+                       ;; pick up one arg in `rest'
+                       (receive (a r) (compile-markup-arg rest)
+                         (set! args (cons a args))
+                         (set! rest r))))))))
         ((and (pair? expr)
               (pair? (car expr))
               (keyword? (caar expr)))
@@ -227,91 +357,61 @@ Use `markup*' in a \\notemode context."
 
 ;;;;;;;;;;;;;;;
 ;;; Utilities for storing and accessing markup commands signature
-;;; and keyword.
 ;;; Examples:
 ;;;
 ;;; (set! (markup-command-signature raise-markup) (list number? markup?))
-;;; ==> ((#<primitive-procedure number?> #<procedure markup? (obj)>) . scheme0-markup1)
+;;; ==> (#<primitive-procedure number?> #<procedure markup? (obj)>)
 ;;;
 ;;; (markup-command-signature raise-markup)
 ;;; ==> (#<primitive-procedure number?> #<procedure markup? (obj)>)
 ;;;
-;;; (markup-command-keyword raise-markup) ==> "scheme0-markup1"
-;;; 
-
-(define markup-command-signatures (make-hash-table 50))
-
-(define (markup-command-signature-ref markup-command)
-  "Return markup-command's signature, e.g. (number? markup?).
-markup-command may be a procedure."
-  (let ((sig-key (hashq-ref markup-command-signatures
-                            markup-command)))
-    (if sig-key (car sig-key) #f)))
-
-(define-public (markup-command-keyword markup-command)
-  "Return markup-command's keyword, e.g. \"scheme0markup1\".
-markup-command may be a procedure."
-  (let ((sig-key (hashq-ref markup-command-signatures
-                            markup-command)))
-    (if sig-key (cdr sig-key) #f)))
-
-(define (markup-command-signatureset! markup-command signature)
-  "Set markup-command's signature. markup-command must be a named procedure.
-Also set markup-signature and markup-keyword object properties."
-  (hashq-set! markup-command-signatures
-              markup-command
-              (cons signature (markup-signature-to-keyword signature)))
-  ;; these object properties are still in use somewhere
+
+(define-public (markup-command-signature-ref markup-command)
+  "Return @var{markup-command}'s signature (the @code{'markup-signature}
+object property)."
+  (object-property markup-command 'markup-signature))
+
+(define-public (markup-command-signature-set! markup-command signature)
+  "Set @var{markup-command}'s signature (as object property)."
   (set-object-property! markup-command 'markup-signature signature)
-  (set-object-property! markup-command 'markup-keyword (markup-signature-to-keyword signature)))
-  
+  signature)
+
 (define-public markup-command-signature
-  (make-procedure-with-setter markup-command-signature-ref markup-command-signatureset!))
-
-(define (markup-symbol-to-proc markup-sym)
-  "Return the markup command procedure which name is `markup-sym', if any."
-  (hash-fold (lambda (key val prev)
-               (or prev
-                   (if (eqv? (procedure-name key) markup-sym) key #f)))
-             #f
-             markup-command-signatures))
-
-(define-public markup-function-list '())
-
-(define-public (markup-signature-to-keyword sig)
-  " (A B C) -> a0-b1-c2 "
-  (if (null? sig)
-      'empty
-      (string->symbol (string-join (map
-                                    (let* ((count 0))
-                                      (lambda (func)
-                                        (set! count (+ count 1))
-                                        (string-append
-                                         ;; for reasons I don't get,
-                                         ;; (case func ((markup?) .. )
-                                         ;; doesn't work.
-                                         (cond 
-                                          ((eq? func markup?) "markup")
-                                          ((eq? func markup-list?) "markup-list")
-                                          (else "scheme"))
-                                         (number->string (- count 1)))))
-                                    sig)
-                         "-"))))
+  (make-procedure-with-setter markup-command-signature-ref
+                              markup-command-signature-set!))
+
+(define (lookup-markup-command-aux symbol)
+  (let ((proc (catch 'misc-error
+                (lambda ()
+                  (module-ref (current-module) symbol))
+                (lambda (key . args) #f))))
+    (and (procedure? proc) proc)))
 
 (define-public (lookup-markup-command code)
-  (let ((proc (markup-symbol-to-proc (string->symbol (string-append code "-markup")))))
-    (and proc (cons proc (markup-command-keyword proc)))))
+  (let ((proc (lookup-markup-command-aux
+	       (string->symbol (format #f "~a-markup" code)))))
+    (and proc (markup-function? proc)
+	 (cons proc (markup-command-signature proc)))))
+
+(define-public (lookup-markup-list-command code)
+  (let ((proc (lookup-markup-command-aux
+	       (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))))
-"
+  "@var{markups} being a list of markups, for example
+@code{(markup1 markup2 markup3)}, and @var{commands} a list of commands with
+their scheme arguments, in reverse order, for example
+@code{((italic) (raise 4) (bold))}, map the commands on each markup argument,
+for example
+@example
+((bold (raise 4 (italic markup1)))
+ (bold (raise 4 (italic markup2)))
+ (bold (raise 4 (italic markup3))))
+@end example"
   (map-in-order (lambda (arg)
                   (let ((result arg))
                     (for-each (lambda (cmd)
@@ -324,13 +424,25 @@ eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
 ;;; markup type predicates
 
 (define (markup-function? x)
-  (not (not (markup-command-signature x))))
+  (and (markup-command-signature x)
+       (not (object-property x 'markup-list-command))))
+
+(define (markup-list-function? x)
+  (and (markup-command-signature x)
+       (object-property x 'markup-list-command)))
+
+(define-public (markup-command-list? x)
+  "Determine whether @var{x} is a markup command list, i.e. a list
+composed of a markup list function and its arguments."
+  (and (pair? x) (markup-list-function? (car x))))
 
 (define-public (markup-list? arg)
+  "Return @code{#t} if @var{x} is a list of markups or markup command lists."
   (define (markup-list-inner? lst)
     (or (null? lst)
-        (and (markup? (car lst)) (markup-list-inner? (cdr lst)))))
-  (and (list? arg) (markup-list-inner? arg)))
+	(and (or (markup? (car lst)) (markup-command-list? (car lst)))
+             (markup-list-inner? (cdr lst)))))
+  (not (not (and (list? arg) (markup-list-inner? arg)))))
 
 (define (markup-argument-list? signature arguments)
   "Typecheck argument list."
@@ -360,10 +472,15 @@ eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
            (markup-argument-list? (markup-command-signature (car arg))
                                   (cdr arg)))))
 
-;; 
-;; typecheck, and throw an error when something amiss.
-;; 
+;;
+;;
+;;
+;;
 (define (markup-thrower-typecheck arg)
+  "typecheck, and throw an error when something amiss.
+
+Uncovered - cheap-markup? is used."
+
   (cond ((string? arg) #t)
         ((not (pair? arg))
          (throw 'markup-format "Not a pair" arg))
@@ -376,7 +493,7 @@ eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
 
 ;;
 ;; good enough if you only  use make-XXX-markup functions.
-;; 
+;;
 (define (cheap-markup? x)
   (or (string? x)
       (and (pair? x)
@@ -384,7 +501,7 @@ eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
 
 ;;
 ;; replace by markup-thrower-typecheck for more detailed diagnostics.
-;; 
+;;
 (define-public markup? cheap-markup?)
 
 ;; utility
@@ -397,6 +514,18 @@ eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
 
 
 (define-public interpret-markup ly:text-interface::interpret-markup)
+
+(define-public (interpret-markup-list layout props markup-list)
+  (let ((stencils (list)))
+    (for-each (lambda (m)
+		(set! stencils
+		      (if (markup-command-list? m)
+			  (append! (reverse! (apply (car m) layout props (cdr m)))
+				   stencils)
+			  (cons (interpret-markup layout props m) stencils))))
+	      markup-list)
+    (reverse! stencils)))
+
 (define-public (prepend-alist-chain key val chain)
   (cons (acons key val (car chain)) (cdr chain)))
 
@@ -404,14 +533,74 @@ eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
   "DOCME"
   (if (and (pair? stencils)
 	   (ly:stencil? (car stencils)))
-      
+
       (if (and (pair? (cdr stencils))
 	       (ly:stencil? (cadr stencils)))
           (let* ((tail (stack-stencil-line space (cdr stencils)))
                  (head (car stencils))
-                 (xoff (+ space (cdr (ly:stencil-extent head X)))))
+                 (xoff (+ space (interval-length (ly:stencil-extent head X)))))
             (ly:stencil-add head
                              (ly:stencil-translate-axis tail xoff X)))
           (car stencils))
       (ly:make-stencil '() '(0 . 0) '(0 . 0))))
 
+
+;;; convert a full markup object to an approximate pure string representation
+
+(define-public (markup->string m)
+  ;; markup commands with one markup argument, formatting ignored
+  (define markups-first-argument '(list
+    bold-markup box-markup caps-markup dynamic-markup finger-markup
+    fontCaps-markup huge-markup italic-markup large-markup larger-markup
+    medium-markup normal-size-sub-markup normal-size-super-markup
+    normal-text-markup normalsize-markup number-markup roman-markup
+    sans-markup simple-markup small-markup smallCaps-markup smaller-markup
+    sub-markup super-markup teeny-markup text-markup tiny-markup
+    typewriter-markup underline-markup upright-markup bracket-markup
+    circle-markup hbracket-markup parenthesize-markup rounded-box-markup
+
+    center-align-markup center-column-markup column-markup dir-column-markup
+    fill-line-markup justify-markup justify-string-markup left-align-markup
+    left-column-markup line-markup right-align-markup right-column-markup
+    vcenter-markup wordwrap-markup wordwrap-string-markup ))
+
+  ;; markup commands with markup as second argument, first argument
+  ;; specifies some formatting and is ignored
+  (define markups-second-argument '(list
+    abs-fontsize-markup fontsize-markup magnify-markup lower-markup
+    pad-around-markup pad-markup-markup pad-x-markup raise-markup
+    halign-markup hcenter-in-markup rotate-markup translate-markup
+    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 (string-cons-join c)
+    (if (not (pair? c)) c
+        (string-join (list (car c) (string-cons-join (cdr c))) "")))
+
+  (cond
+    ((string? m) m)
+    ((null? m) "")
+
+    ;; handle \concat (string-join without spaces)
+    ((and (pair? m) (equal? (car m) concat-markup))
+        (string-cons-join (markup-cons->string-cons (cadr m))) )
+
+    ;; markup functions with the markup as first arg
+    ((member (car m) (primitive-eval markups-first-argument))
+        (markup->string (cadr m)))
+
+    ;; markup functions with markup as second arg
+    ((member (car m) (primitive-eval markups-second-argument))
+        (markup->string (cddr m)))
+
+    ;; ignore all other markup functions
+    ((markup-function? (car m)) "")
+
+    ;; handle markup lists
+    ((list? m)
+        (string-join (map markup->string m) " "))
+
+    (else "ERROR, unable to extract string from markup")))