;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 2000--2011 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2000--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;; Jan Nieuwenhuizen <janneke@gnu.org>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
;;; functions that take a markup as their last argument.
;;;
;;; args-signature
-;;; the arguments signature, i.e. a list of type predicates which
+;;; the arguments signature, i.e., a list of type predicates which
;;; are used to type check the arguments, and also to define the general
;;; argument types (markup, markup-list, scheme) that the command is
;;; expecting.
;;;
;;; category
;;; for documentation purpose, builtin markup commands are grouped by
-;;; category. This can be any symbol. When documentation is generated,
+;;; category. This can be any symbol. When documentation is generated,
;;; the symbol is converted to a capitalized string, where hyphens are
;;; replaced by spaces.
;;;
;;; property-bindings
;;; this is used both for documentation generation, and to ease
-;;; programming the command itself. It is list of
+;;; programming the command itself. It is list of
;;; (property-name default-value)
;;; or (property-name)
-;;; elements. Each property is looked-up in the `props' argument, and
+;;; elements. Each property is looked-up in the `props' argument, and
;;; the symbol naming the property is bound to its value.
;;; When the property is not found in `props', then the symbol is bound
-;;; to the given default value. When no default value is given, #f is
+;;; to the given default value. When no default value is given, #f is
;;; used instead.
;;; Thus, using the following property bindings:
;;; ((thickness 0.1)
;;; ..body..)
;;; When a command `B' internally calls an other command `A', it may
;;; desirable to see in `B' documentation all the properties and
-;;; default values used by `A'. In that case, add `A-markup' to the
-;;; property-bindings of B. (This is used when generating
+;;; default values used by `A'. In that case, add `A-markup' to the
+;;; property-bindings of B. (This is used when generating
;;; documentation, but won't create bindings.)
;;;
;;; documentation-string
;;; the command documentation string (used to generate manuals)
;;;
;;; body
-;;; the command body. The function is supposed to return a stencil.
+;;; the command body. The function is supposed to return a stencil.
;;;
;;; Each markup command definition shall have a documentation string
;;; with description, syntax and example.
@lilypond[verbatim,quote]
\\markup {
- \\with-url #\"http://lilypond.org/web/\" {
+ \\with-url #\"http://lilypond.org/\" {
LilyPond ... \\italic {
music notation for everyone
}
"
@cindex referencing page numbers in text
-Add a link to the page @var{page-number} around @var{arg}. This only works in
-the PDF backend.
+Add a link to the page @var{page-number} around @var{arg}. This only works
+in the PDF backend.
@lilypond[verbatim,quote]
\\markup {
"
@cindex referencing page labels in text
-Add a link to the page holding label @var{label} around @var{arg}. This
+Add a link to the page holding label @var{label} around @var{arg}. This
only works in the PDF backend.
@lilypond[verbatim,quote]
\\markup {
- \\with-link #\"label\" { \\italic { This links to the page containing the label... } }
+ \\with-link #'label {
+ \\italic { This links to the page containing the label... }
+ }
}
@end lilypond"
(let* ((arg-stencil (interpret-markup layout props arg))
;; FIXME
(ly:make-stencil
(list 'embedded-ps
- (format "
+ (format #f "
gsave currentpoint translate
0.1 setlinewidth
~a
indent = 0.0\\cm
\\context {
\\Score
- \\override RehearsalMark #'break-align-symbols =
- #'(time-signature key-signature)
- \\override RehearsalMark #'self-alignment-X = #LEFT
+ \\override RehearsalMark
+ #'break-align-symbols = #'(time-signature key-signature)
+ \\override RehearsalMark
+ #'self-alignment-X = #LEFT
}
\\context {
\\Staff
- \\override TimeSignature #'break-align-anchor-alignment = #LEFT
+ \\override TimeSignature
+ #'break-align-anchor-alignment = #LEFT
}
}
}
(define-markup-command (tied-lyric layout props str)
(string?)
#:category music
+ #:properties ((word-space))
"
@cindex simple text strings with tie characters
Like simple-markup, but use tie characters for @q{~} tilde symbols.
@lilypond[verbatim,quote]
-\\markup {
- \\tied-lyric #\"Lasciate~i monti\"
-}
-@end lilypond"
- (if (string-contains str "~")
- (let*
- ((parts (string-split str #\~))
- (tie-str (ly:wide-char->utf-8 #x203f))
- (joined (list-join parts tie-str))
- (join-stencil (interpret-markup layout props tie-str))
- )
+\\markup \\column {
+ \\tied-lyric #\"Siam navi~all'onde~algenti Lasciate~in abbandono\"
+ \\tied-lyric #\"Impetuosi venti I nostri~affetti sono\"
+ \\tied-lyric #\"Ogni diletto~e scoglio Tutta la vita~e~un mar.\"
+}
+@end lilypond"
+ (define (replace-ties tie str)
+ (if (string-contains str "~")
+ (let*
+ ((half-space (/ word-space 2))
+ (parts (string-split str #\~))
+ (tie-str (markup #:hspace half-space
+ #:musicglyph tie
+ #:hspace half-space))
+ (joined (list-join parts tie-str)))
+ (make-concat-markup joined))
+ str))
+
+ (define short-tie-regexp (make-regexp "~[^.]~"))
+ (define (match-short str) (regexp-exec short-tie-regexp str))
+
+ (define (replace-short str mkp)
+ (let ((match (match-short str)))
+ (if (not match)
+ (make-concat-markup (list
+ mkp
+ (replace-ties "ties.lyric.default" str)))
+ (let ((new-str (match:suffix match))
+ (new-mkp (make-concat-markup (list
+ mkp
+ (replace-ties "ties.lyric.default"
+ (match:prefix match))
+ (replace-ties "ties.lyric.short"
+ (match:substring match))))))
+ (replace-short new-str new-mkp)))))
- (interpret-markup layout
- (prepend-alist-chain
- 'word-space
- (/ (interval-length (ly:stencil-extent join-stencil X)) -3.5)
- props)
- (make-line-markup joined)))
- ;(map (lambda (s) (interpret-markup layout props s)) parts))
- (interpret-markup layout props str)))
+ (interpret-markup layout
+ props
+ (replace-short str (markup))))
(define-public empty-markup
(make-simple-markup ""))
\\header {
title = \"My title\"
myText = \"Lorem ipsum dolor sit amet, consectetur adipisicing
- elit, sed do eiusmod tempor incididunt ut labore et dolore magna
- aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco
- laboris nisi ut aliquip ex ea commodo consequat.\"
+ elit, sed do eiusmod tempor incididunt ut labore et dolore
+ magna aliqua. Ut enim ad minim veniam, quis nostrud
+ exercitation ullamco laboris nisi ut aliquip ex ea commodo
+ consequat.\"
}
\\paper {
(define (general-column align-dir baseline mols)
"Stack @var{mols} vertically, aligned to @var{align-dir} horizontally."
- (let* ((aligned-mols (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols)))
- (stack-lines -1 0.0 baseline aligned-mols)))
+ (let* ((aligned-mols (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols))
+ (stacked-stencil (stack-lines -1 0.0 baseline aligned-mols))
+ (stacked-extent (ly:stencil-extent stacked-stencil X)))
+ (ly:stencil-translate-axis stacked-stencil (- (car stacked-extent)) X )))
(define-markup-command (center-column layout props args)
(markup-list?)
"
@cindex setting horizontal text alignment
-Set horizontal alignment. If @var{dir} is @code{-1}, then it is
+Set horizontal alignment. If @var{dir} is @w{@code{-1}}, then it is
left-aligned, while @code{+1} is right. Values in between interpolate
alignment accordingly.
;; property
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-markup-command (property-recursive layout props symbol)
+ (symbol?)
+ #:category other
+ "Print out a warning when a header field markup contains some recursive
+markup definition."
+ (ly:warning "Recursive definition of property ~a detected!" symbol)
+ empty-stencil)
+
(define-markup-command (fromproperty layout props symbol)
(symbol?)
#:category other
@end lilypond"
(let ((m (chain-assoc-get symbol props)))
(if (markup? m)
- (interpret-markup layout props m)
+ ;; prevent infinite loops by clearing the interpreted property:
+ (interpret-markup layout (cons (list (cons symbol `(,property-recursive-markup ,symbol))) props) m)
empty-stencil)))
(define-markup-command (on-the-fly layout props procedure arg)
- (symbol? markup?)
+ (procedure? markup?)
#:category other
"Apply the @var{procedure} markup command to @var{arg}.
@var{procedure} should take a single argument."
(define-markup-command (footnote layout props mkup note)
(markup? markup?)
#:category other
- "Have footnote @var{note} act as an annotation to the markup @var{mkup}."
+ "Have footnote @var{note} act as an annotation to the markup @var{mkup}.
+
+@lilypond[verbatim,quote]
+\\markup {
+ \\auto-footnote a b
+ \\override #'(padding . 0.2)
+ \\auto-footnote c d
+}
+@end lilypond
+The footnote will not be annotated automatically."
(ly:stencil-combine-at-edge
(interpret-markup layout props mkup)
X
RIGHT
(ly:make-stencil
- `(footnote ,(interpret-markup layout props note))
+ `(footnote (gensym "footnote") #f ,(interpret-markup layout props note))
'(0 . 0)
'(0 . 0))
0.0))
+(define-markup-command (auto-footnote layout props mkup note)
+ (markup? markup?)
+ #:category other
+ #:properties ((raise 0.5)
+ (padding 0.0))
+ "Have footnote @var{note} act as an annotation to the markup @var{mkup}.
+
+@lilypond[verbatim,quote]
+\\markup {
+ \\auto-footnote a b
+ \\override #'(padding . 0.2)
+ \\auto-footnote c d
+}
+@end lilypond
+The footnote will be annotated automatically."
+ (let* ((markup-stencil (interpret-markup layout props mkup))
+ (footnote-hash (gensym "footnote"))
+ (stencil-seed 0)
+ (gauge-stencil (interpret-markup
+ layout
+ props
+ ((ly:output-def-lookup
+ layout
+ 'footnote-numbering-function)
+ stencil-seed)))
+ (x-ext (ly:stencil-extent gauge-stencil X))
+ (y-ext (ly:stencil-extent gauge-stencil Y))
+ (footnote-number
+ `(delay-stencil-evaluation
+ ,(delay
+ (ly:stencil-expr
+ (let* ((table
+ (ly:output-def-lookup layout
+ 'number-footnote-table))
+ (footnote-stencil (if (list? table)
+ (assoc-get footnote-hash
+ table)
+ empty-stencil))
+ (footnote-stencil (if (ly:stencil? footnote-stencil)
+ footnote-stencil
+ (begin
+ (ly:programming-error
+"Cannot find correct footnote for a markup object.")
+ empty-stencil)))
+ (gap (- (interval-length x-ext)
+ (interval-length
+ (ly:stencil-extent footnote-stencil X))))
+ (y-trans (- (+ (cdr y-ext)
+ raise)
+ (cdr (ly:stencil-extent footnote-stencil
+ Y)))))
+ (ly:stencil-translate footnote-stencil
+ (cons gap y-trans)))))))
+ (main-stencil (ly:stencil-combine-at-edge
+ markup-stencil
+ X
+ RIGHT
+ (ly:make-stencil footnote-number x-ext y-ext)
+ padding)))
+ (ly:stencil-add
+ main-stencil
+ (ly:make-stencil
+ `(footnote ,footnote-hash #t ,(interpret-markup layout props note))
+ '(0 . 0)
+ '(0 . 0)))))
+
(define-markup-command (override layout props new-prop arg)
(pair? markup?)
#:category other
}
@end lilypond"
(let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12))
- (text-props (list (ly:output-def-lookup layout 'text-font-defaults)))
- (ref-word-space (chain-assoc-get 'word-space text-props 0.6))
- (ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
- (magnification (/ size ref-size)))
- (interpret-markup layout
- (cons `((baseline-skip . ,(* magnification ref-baseline))
- (word-space . ,(* magnification ref-word-space))
- (font-size . ,(magnification->font-size magnification)))
- props)
- arg)))
+ (text-props (list (ly:output-def-lookup layout 'text-font-defaults)))
+ (ref-word-space (chain-assoc-get 'word-space text-props 0.6))
+ (ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
+ (magnification (/ size ref-size)))
+ (interpret-markup
+ layout
+ (cons
+ `((baseline-skip . ,(* magnification ref-baseline))
+ (word-space . ,(* magnification ref-word-space))
+ (font-size . ,(magnification->font-size magnification)))
+ props)
+ arg)))
(define-markup-command (fontsize layout props increment arg)
(number? markup?)
smaller
}
@end lilypond"
- (let ((entries (list
- (cons 'baseline-skip (* baseline-skip (magstep increment)))
- (cons 'word-space (* word-space (magstep increment)))
- (cons 'font-size (+ font-size increment)))))
- (interpret-markup layout (cons entries props) arg)))
+ (interpret-markup
+ layout
+ (cons
+ `((baseline-skip . ,(* baseline-skip (magstep increment)))
+ (word-space . ,(* word-space (magstep increment)))
+ (font-size . ,(+ font-size increment)))
+ props)
+ arg))
(define-markup-command (magnify layout props sz arg)
(number? markup?)
@lilypond[verbatim,quote]
\\markup {
\\huge \\bold \\sans \\caps {
- Some text with font overrides
+ huge bold sans caps
\\hspace #2
\\normal-text {
- Default text, same font-size
+ huge normal
}
\\hspace #2
- More text as before
+ as before
}
}
@end lilypond"
}
@end lilypond"
(let*
- ((name (format "arrowheads.~a.~a~a"
+ ((name (format #f "arrowheads.~a.~a~a"
(if filled
"close"
"open")
@end lilypond"
(define (get-glyph-name-candidates dir log style)
(map (lambda (dir-name)
- (format "noteheads.~a~a" dir-name
+ (format #f "noteheads.~a~a" dir-name
(if (and (symbol? style)
(not (equal? 'default style)))
(select-head-glyph style (min log 2))
(parenthesize-stencil
markup half-thickness scaled-width angularity padding)))
-\f
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Delayed markup evaluation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
"
@cindex referencing page numbers in text
-Reference to a page number. @var{label} is the label set on the referenced
+Reference to a page number. @var{label} is the label set on the referenced
page (using the @code{\\label} command), @var{gauge} a markup used to estimate
the maximum width of the page number, and @var{default} the value to display
when @var{label} is not found."
(page-number (if (list? table)
(assoc-get label table)
#f))
- (page-markup (if page-number (format "~a" page-number) default))
+ (page-markup (if page-number (format #f "~a" page-number) default))
(page-stencil (interpret-markup layout props page-markup))
(gap (- (interval-length x-ext)
(interval-length (ly:stencil-extent page-stencil X)))))
\\fill-with-pattern #1.5 #CENTER - left right
\\null
\"left-aligned :\"
- \\override #'(line-width . 50) \\fill-with-pattern #2 #LEFT : left first
- \\override #'(line-width . 50) \\fill-with-pattern #2 #LEFT : left second
+ \\override #'(line-width . 50)
+ \\fill-with-pattern #2 #LEFT : left first
+ \\override #'(line-width . 50)
+ \\fill-with-pattern #2 #LEFT : left second
}
@end lilypond"
(let* ((pattern-x-extent (ly:stencil-extent (interpret-markup layout props pattern) X))
#:pattern (1+ count) X space pattern
right))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Replacements
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-markup-command (replace layout props replacements arg)
+ (list? markup?)
+ #:category font
+ "
+Used to automatically replace a string by another in the markup @var{arg}.
+Each pair of the alist @var{replacements} specifies what should be replaced.
+The @code{key} is the string to be replaced by the @code{value} string.
+
+@lilypond[verbatim, quote]
+\\markup \\replace #'((\"thx\" . \"Thanks!\")) thx
+@end lilypond"
+ (interpret-markup
+ layout
+ (internal-add-text-replacements
+ props
+ replacements)
+ (markup arg)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Markup list commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
projects / lilypond.git / blobdiff