;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 2003--2010 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
,(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))
;;;
(define-public (markup-command-signature-ref markup-command)
- "Return markup-command's signature (the 'markup-signature object property)"
+ "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 markup-command's signature (as object property)"
+ "Set @var{markup-command}'s signature (as object property)."
(set-object-property! markup-command 'markup-signature signature)
signature)
;;;;;;;;;;;;;;;;;;;;;;
;;; 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)
(object-property x 'markup-list-command)))
(define-public (markup-command-list? x)
- "Determine if `x' is a markup command list, ie. a list composed of
-a markup list function and its arguments."
+ "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 a true value if `x' is a list of markups or markup command lists."
+ "Return @code{#t} if @var{x} is a list of markups or markup command lists."
(define (markup-list-inner? lst)
(or (null? lst)
(and (or (markup? (car lst)) (markup-command-list? (car lst)))
(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")))
projects / lilypond.git / blobdiff