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))
arg offsets))
(else arg)))
-(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-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
(if (procedure? part)
(apply part grob rest)
part)))
- (else target)))
- (can-type-be-offset?
- (or (number? vals)
- (number-pair? vals)
- (number-pair-list? vals))))
+ (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 (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
(begin
(ly:warning "the property '~a of ~a cannot be offset" property 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)
+ (grob-transformer property offset-fun))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; \magnifyMusic and \magnifyStaff