- #:COMMAND is used instead of \\COMMAND
- #:lines ( ... ) is used instead of { ... }
- - #:center ( ... ) is used instead of \\center < ... >
+ - #:center-align ( ... ) is used instead of \\center-align < ... >
- etc.
Example:
(define (compile-all-markup-expressions expr)
- "Return a list of canonical markups expressions, eg:
+ "Return a list of canonical markups expressions, e.g.:
(#:COMMAND1 arg11 arg12 #:COMMAND2 arg21 arg22 arg23)
===>
((make-COMMAND1-markup arg11 arg12)
(set! rest r))))
(define (keyword->make-markup key)
- "Transform a keyword, eg. #:COMMAND, in a make-COMMAND-markup symbol."
+ "Transform a keyword, e.g. #:COMMAND, in a make-COMMAND-markup symbol."
(string->symbol (string-append "make-" (symbol->string (keyword->symbol key)) "-markup")))
(define (compile-markup-expression expr)
"Return two values: the first complete canonical markup expression found in `expr',
-eg (make-COMMAND-markup arg1 arg2 ...), and the rest expression."
+e.g. (make-COMMAND-markup arg1 arg2 ...), and the rest expression."
(cond ((and (pair? expr)
(keyword? (car expr)))
;; expr === (#:COMMAND arg1 ...)
;; expr === ((#:COMMAND arg1 ...) ...)
(receive (m r) (compile-markup-expression (car expr))
(values m (cdr expr))))
+ ((and (pair? expr)
+ (string? (car expr))) ;; expr === ("string" ...)
+ (values `(make-simple-markup ,(car expr)) (cdr expr)))
(else
- ;; expr === (symbol ...) or ("string" ...) or ((funcall ...) ...)
+ ;; expr === (symbol ...) or ((funcall ...) ...)
(values (car expr)
(cdr expr)))))
(values (cons 'list (compile-all-markup-args (car expr))) (cdr expr)))
(else (values (car expr) (cdr expr)))))
+;;;;;;;;;;;;;;;
+;;; Debugging utilities: print markup expressions in a friendly fashion
+
+(use-modules (ice-9 format))
+(define (markup->string markup-expr)
+ "Return a string describing, in LilyPond syntax, the given markup expression."
+ (define (proc->command proc)
+ (let ((cmd-markup (symbol->string (procedure-name proc))))
+ (substring cmd-markup 0 (- (string-length cmd-markup)
+ (string-length "-markup")))))
+ (define (arg->string arg)
+ (cond ((and (pair? arg) (pair? (car arg))) ;; markup list
+ (format #f "~{ ~a~}" (map markup->string arg)))
+ ((pair? arg) ;; markup
+ (markup->string arg))
+ ((string? arg) ;; scheme string argument
+ (format #f "#\"~a\"" arg))
+ (else ;; other scheme arg
+ (format #f "#~a" arg))))
+ (let ((cmd (car markup-expr))
+ (args (cdr markup-expr)))
+ (cond ((eqv? cmd simple-markup) ;; a simple string
+ (format #f "\"~a\"" (car args)))
+ ((eqv? cmd line-markup) ;; { ... }
+ (format #f "{~a}" (arg->string (car args))))
+ ((eqv? cmd center-align-markup) ;; \center < ... >
+ (format #f "\\center-align <~a>" (arg->string (car args))))
+ ((eqv? cmd column-markup) ;; \column < ... >
+ (format #f "\\column <~a>" (arg->string (car args))))
+ (else ;; \command ...
+ (format #f "\\~a~{ ~a~} " (proc->command cmd) (map arg->string args))))))
+
+(define-public (display-markup markup-expr)
+ "Print a LilyPond-syntax equivalent for the given markup expression."
+ (display "\\markup ")
+ (display (markup->string markup-expr)))
+
;;;;;;;;;;;;;;;
;;; Utilities for storing and accessing markup commands signature
;;; and keyword.
(define-public (stack-stencil-line space stencils)
- (if (pair? stencils)
- (if (pair? (cdr stencils))
+ "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-get-extent head X)))))
+ (xoff (+ space (cdr (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))))