;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 2003--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 2003--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
"
Internally markup is stored as lists, whose head is a function.
To add a function, use the def-markup-command utility.
- (def-markup-command (mycommand paper prop arg1 ...) (arg1-type? ...)
+ (def-markup-command (mycommand layout prop arg1 ...) (arg1-type? ...)
\"my command usage and description\"
...function body...)
* define a make-COMMAND-markup function.
Syntax:
- (def-markup-command (COMMAND paper props arg1 arg2 ...) (arg1-type? arg2-type? ...)
+ (def-markup-command (COMMAND layout props arg1 arg2 ...) (arg1-type? arg2-type? ...)
\"documentation string\"
...command body...)
or:
- #: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.
(let ((proc (markup-symbol-to-proc (string->symbol (string-append code "-markup")))))
(and proc (cons proc (markup-command-keyword 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))))
+"
+ (map-in-order (lambda (arg)
+ (let ((result arg))
+ (for-each (lambda (cmd)
+ (set! result (append cmd (list result))))
+ commands)
+ result))
+ markups))
+
;;;;;;;;;;;;;;;;;;;;;;
;;; markup type predicates
(not (not (markup-command-signature x))))
(define (markup-list? arg)
- (define (markup-list-inner? l)
- (or (null? l)
- (and (markup? (car l)) (markup-list-inner? (cdr l)))))
+ (define (markup-list-inner? lst)
+ (or (null? lst)
+ (and (markup? (car lst)) (markup-list-inner? (cdr lst)))))
(and (list? arg) (markup-list-inner? arg)))
(define (markup-argument-list? signature arguments)
(make-line-markup (list-insert-separator markups sep))
empty-markup))
-(define-public brew-new-markup-stencil Text_item::print)
-(define-public interpret-markup Text_item::interpret_markup)
+(define-public brew-new-markup-stencil Text_interface::print)
+(define-public interpret-markup Text_interface::interpret_markup)
(define-public (prepend-alist-chain key val chain)
(cons (acons key val (car chain)) (cdr chain)))
(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))))
projects / lilypond.git / blobdiff