"Does @code{mus} belong to the music class @code{type}?"
(memq type (ly:music-property mus 'types)))
+(define-safe-public (music-type-predicate types)
+ "Returns a predicate function that can be used for checking
+music to have one of the types listed in @var{types}."
+ (if (cheap-list? types)
+ (lambda (m)
+ (any (lambda (t) (music-is-of-type? m t)) types))
+ (lambda (m) (music-is-of-type? m types))))
+
;; TODO move this
(define-public ly:grob-property
(make-procedure-with-setter ly:grob-property
location)
#f))))
+(define-safe-public (check-music-path path #:optional location #:key default)
+ "Check a music property path specification @var{path}, a symbol
+list (or a single symbol), for validity and possibly complete it.
+Returns the completed specification, or @code{#f} when rising an
+error (using optionally @code{location})."
+ (let* ((path (if (symbol? path) (list path) path)))
+ ;; A Guile 1.x bug specific to optargs precludes moving the
+ ;; defines out of the let
+ (define (property? s)
+ (object-property s 'music-type?))
+ (define (unspecial? s)
+ (not (property? s)))
+ (or (case (length path)
+ ((1) (and (property? (car path)) (cons default path)))
+ ((2) (and (unspecial? (car path)) (property? (cadr path)) path))
+ (else #f))
+ (begin
+ (ly:parser-error
+ (format #f (_ "bad music property ~a")
+ path)
+ location)
+ #f))))
+
(define-public (make-grob-property-set grob gprop val)
- "Make a @code{Music} expression that sets @var{gprop} to @var{val} in
-@var{grob}. Does a pop first, i.e., this is not an override."
+ "Make a @code{Music} expression that overrides a @var{gprop} to
+@var{val} in @var{grob}. Does a pop first, i.e. this is not a
+@code{\\temporary \\override}."
(make-music 'OverrideProperty
'symbol grob
'grob-property gprop
'pop-first #t))
(define-public (make-grob-property-override grob gprop val)
- "Make a @code{Music} expression that overrides @var{gprop} to @var{val}
-in @var{grob}."
+ "Make a @code{Music} expression that overrides @var{gprop} to
+@var{val} in @var{grob}. This is a @code{\\temporary \\override},
+making it possible to @code{\\revert} to any previous value afterwards."
(make-music 'OverrideProperty
'symbol grob
'grob-property gprop
(make-grob-property-revert 'NoteColumn 'horizontal-shift)))))
-(define-safe-public (context-spec-music m context #:optional id)
- "Add \\context CONTEXT = ID to M."
+(define-safe-public (context-spec-music m context #:optional id mods)
+ "Add \\context @var{context} = @var{id} \\with @var{mods} to @var{m}."
(let ((cm (make-music 'ContextSpeccedMusic
'element m
'context-type context)))
(if (string? id)
(set! (ly:music-property cm 'context-id) id))
+ (if mods
+ (set! (ly:music-property cm 'property-operations)
+ (if (ly:context-mod? mods)
+ (ly:get-context-mods mods)
+ mods)))
cm))
-(define-public (descend-to-context m context)
+(define-safe-public (descend-to-context m context #:optional id mods)
"Like @code{context-spec-music}, but only descending."
- (let ((cm (context-spec-music m context)))
+ (let ((cm (context-spec-music m context id mods)))
(ly:music-set-property! cm 'descend-only #t)
cm))
;; articulations on individual events since they can't actually get
;; into a repeat chord given its input syntax.
- (define (keep-element? m)
- (any (lambda (t) (music-is-of-type? m t))
- event-types))
+ (define keep-element? (music-type-predicate event-types))
(for-each
(lambda (field)
mus))
-(define-public (music-has-type music type)
- (memq type (ly:music-property music 'types)))
-
(define-public (music-clone music . music-properties)
"Clone @var{music} and set properties according to
@var{music-properties}, a list of alternating property symbols and
(define-public (pitch-of-note event-chord)
(let ((evs (filter (lambda (x)
- (music-has-type x 'note-event))
+ (music-is-of-type? x 'note-event))
(ly:music-property event-chord 'elements))))
(and (pair? evs)
"Return a flat list of all music with @var{type} (either a single
type symbol or a list of alternatives) inside of @var{music}, not
recursing into matches themselves."
- (extract-music
- music
- (if (cheap-list? type)
- (lambda (m)
- (any (lambda (t) (music-is-of-type? m t)) type))
- (lambda (m) (music-is-of-type? m type)))))
+ (extract-music music (music-type-predicate type)))
-(define*-public (event-chord-wrap! music)
+(define-public (event-chord-wrap! music)
"Wrap isolated rhythmic events and non-postevent events in
@var{music} inside of an @code{EventChord}. Chord repeats @samp{q}
are expanded using the default settings of the parser."
(set! (ly:music-property m 'articulations) '()))
(make-event-chord (cons m arts))))
(else #f)))
- (expand-repeat-chords!
- (cons 'rhythmic-event
- (ly:parser-lookup '$chord-repeat-events))
- music)))
+ (expand-repeat-notes!
+ (expand-repeat-chords!
+ (cons 'rhythmic-event
+ (ly:parser-lookup '$chord-repeat-events))
+ music))))
(define-public (event-chord-notes event-chord)
"Return a list of all notes from @var{event-chord}."
arg offsets))
(else arg)))
+(define-public (grob-transformer property func)
+ "Create an override value good for applying @var{func} to either
+pure or unpure values. @var{func} is called with the respective grob
+as first argument and the default value (after resolving all callbacks)
+as the second."
+ (define (worker self container-part grob . rest)
+ (let* ((immutable (ly:grob-basic-properties grob))
+ ;; We need to search the basic-properties alist for our
+ ;; property to obtain values to offset. Our search is
+ ;; complicated by the fact that calling the music function
+ ;; `offset' as an override conses a pair to the head of the
+ ;; alist. This pair must be discounted. The closure it
+ ;; contains is named `self' so it can be easily recognized.
+ ;; If `offset' is called as a tweak, the basic-property
+ ;; alist is unaffected.
+ (target (find-value-to-offset property self immutable))
+ ;; if target is a procedure, we need to apply it to our
+ ;; grob to calculate values to offset.
+ (vals (cond ((procedure? target) (target grob))
+ ;; Argument lists for a pure procedure pulled
+ ;; from an unpure-pure-container may be
+ ;; different from a normal procedure, so we
+ ;; need a different code path and calling
+ ;; convention for procedures pulled from an
+ ;; container as opposed to from the property
+ ((ly:unpure-pure-container? target)
+ (let ((part (container-part target)))
+ (if (procedure? part)
+ (apply part grob rest)
+ part)))
+ (else target))))
+ (func grob vals)))
+ ;; return the container named `self'. The container self-reference
+ ;; seems like chasing its own tail but gets dissolved by
+ ;; define/lambda separating binding and referencing of "self".
+ (define self (ly:make-unpure-pure-container
+ (lambda (grob)
+ (worker self ly:unpure-pure-container-unpure-part grob))
+ (lambda (grob . rest)
+ (apply worker self ly:unpure-pure-container-pure-part
+ grob rest))))
+ self)
+
(define-public (offsetter property offsets)
"Apply @var{offsets} to the default values of @var{property} of @var{grob}.
Offsets are restricted to immutable properties and values of type @code{number},
@code{number-pair}, or @code{number-pair-list}."
- (define (self grob)
- (let* ((immutable (ly:grob-basic-properties grob))
- ; We need to search the basic-properties alist for our property to
- ; obtain values to offset. Our search is complicated by the fact that
- ; calling the music function `offset' as an override conses a pair to
- ; the head of the alist. This pair must be discounted. The closure it
- ; contains is named `self' so it can be easily recognized. If `offset'
- ; is called as a tweak, the basic-property alist is unaffected.
- (target (find-value-to-offset property self immutable))
- ; if target is a procedure, we need to apply it to our grob to calculate
- ; values to offset.
- (vals
- (if (procedure? target)
- (target grob)
- target))
- (can-type-be-offset?
- (or (number? vals)
- (number-pair? vals)
- (number-pair-list? vals))))
-
+ (define (offset-fun grob vals)
+ (let ((can-type-be-offset?
+ (or (number? vals)
+ (number-pair? vals)
+ (number-pair-list? vals))))
(if can-type-be-offset?
- ; '(+inf.0 . -inf.0) would offset to itself. This will be confusing to a
- ; user unaware of the default value of the property, so issue a warning.
+ ;; '(+inf.0 . -inf.0) would offset to itself. This will be
+ ;; confusing to a user unaware of the default value of the
+ ;; property, so issue a warning.
(if (equal? empty-interval vals)
(ly:warning "default '~a of ~a is ~a and can't be offset"
property grob vals)
(ly:spanner-broken-into orig)
'()))
(total-found (length siblings))
- ; Since there is some flexibility in input syntax,
- ; structure of `offsets' is normalized.
+ ;; Since there is some flexibility in input
+ ;; syntax, structure of `offsets' is normalized.
(offsets
(if (or (not (pair? offsets))
(number-pair? offsets)
offsets)))
(define (helper sibs offs)
- ; apply offsets to the siblings of broken spanners
+ ;; apply offsets to the siblings of broken spanners
(if (pair? offs)
(if (eq? (car sibs) grob)
(offset-multiple-types vals (car offs))
(helper siblings offsets)
(offset-multiple-types vals (car offsets)))))
- (begin
- (ly:warning "the property '~a of ~a cannot be offset" property grob)
- vals))))
- ; return the closure named `self'
- self)
-
+ (begin
+ (ly:warning "the property '~a of ~a cannot be offset" property grob)
+ vals))))
+ (grob-transformer property offset-fun))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; \magnifyMusic and \magnifyStaff
projects / lilypond.git / blobdiff