X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=b8ceadf5bde6d516fa464ed827c439ec87a80ee8;hb=1d3beed53413315ec6c0553b003b8c5776f8c38f;hp=ff2bcb7ec72ea5b79e311f1566247af73b4940a5;hpb=d0b51cc48c2d66efbd1cbdc682dd622e7a2a93f9;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index ff2bcb7ec7..b8ceadf5bd 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen +;;;; Copyright (C) 1998--2014 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify @@ -20,6 +20,7 @@ (use-modules (scm safe-utility-defs)) (use-modules (ice-9 optargs)) +(use-modules (srfi srfi-11)) ;;; ly:music-property with setter ;;; (ly:music-property my-music 'elements) @@ -137,7 +138,7 @@ For instance, (string-length "-markup"))))))) (define (transform-arg arg) (cond ((and (pair? arg) (markup? (car arg))) ;; a markup list - (apply append (map inner-markup->make-markup arg))) + (append-map inner-markup->make-markup arg)) ((and (not (string? arg)) (markup? arg)) ;; a markup (inner-markup->make-markup arg)) (else ;; scheme arg @@ -157,6 +158,8 @@ For instance, "Generate an expression that, once evaluated, may return an object equivalent to @var{obj}, that is, for a music expression, a @code{(make-music ...)} form." + (define (if-nonzero num) + (if (zero? num) '() (list num))) (cond (;; markup expression (markup? obj) (markup-expression->make-markup obj)) @@ -164,28 +167,36 @@ equivalent to @var{obj}, that is, for a music expression, a (ly:music? obj) `(make-music ',(ly:music-property obj 'name) - ,@(apply append (map (lambda (prop) - `(',(car prop) - ,(music->make-music (cdr prop)))) - (remove (lambda (prop) - (eqv? (car prop) 'origin)) - (ly:music-mutable-properties obj)))))) + ,@(append-map (lambda (prop) + `(',(car prop) + ,(music->make-music (cdr prop)))) + (remove (lambda (prop) + (eqv? (car prop) 'origin)) + (ly:music-mutable-properties obj))))) (;; moment (ly:moment? obj) - `(ly:make-moment ,(ly:moment-main-numerator obj) - ,(ly:moment-main-denominator obj) - ,(ly:moment-grace-numerator obj) - ,(ly:moment-grace-denominator obj))) + `(ly:make-moment + ,@(let ((main (ly:moment-main obj)) + (grace (ly:moment-grace obj))) + (cond ((zero? grace) (list main)) + ((negative? grace) (list main grace)) + (else ;;positive grace requires 4-arg form + (list (numerator main) + (denominator main) + (numerator grace) + (denominator grace))))))) (;; note duration (ly:duration? obj) `(ly:make-duration ,(ly:duration-log obj) - ,(ly:duration-dot-count obj) - ,(ly:duration-scale obj))) + ,@(if (= (ly:duration-scale obj) 1) + (if-nonzero (ly:duration-dot-count obj)) + (list (ly:duration-dot-count obj) + (ly:duration-scale obj))))) (;; note pitch (ly:pitch? obj) `(ly:make-pitch ,(ly:pitch-octave obj) ,(ly:pitch-notename obj) - ,(ly:pitch-alteration obj))) + ,@(if-nonzero (ly:pitch-alteration obj)))) (;; scheme procedure (procedure? obj) (or (procedure-name obj) obj)) @@ -242,18 +253,23 @@ The number of dots in the shifted music may not be less than zero." (max 0 (+ dot (ly:duration-dot-count d))) cp))) (set! (ly:music-property music 'duration) nd))) + ;clear cached length, since it's no longer valid + (set! (ly:music-property music 'length) '()) music)) (define-public (shift-duration-log music shift dot) (music-map (lambda (x) (shift-one-duration-log x shift dot)) music)) -(define-public (make-repeat name times main alts) - "Create a repeat music expression, with all properties initialized -properly." +(define-public (tremolo::get-music-list tremolo) + "Given a tremolo repeat, return a list of music to engrave for it. +This will be a stretched copy of its body, plus a TremoloEvent or +TremoloSpanEvent. + +This is called only by Chord_tremolo_iterator." (define (first-note-duration music) - "Finds the duration of the first NoteEvent by searching depth-first -through MUSIC." + "Finds the duration of the first NoteEvent by searching +depth-first through MUSIC." ;; NoteEvent or a non-expanded chord-repetition ;; We just take anything that actually sports an announced duration. (if (ly:duration? (ly:music-property music 'duration)) @@ -266,46 +282,72 @@ through MUSIC." (if (ly:duration? dur) dur (loop (cdr elts)))))))) - - (let ((talts (if (< times (length alts)) - (begin - (ly:warning (_ "More alternatives than repeats. Junking excess alternatives")) - (take alts times)) - alts)) - (r (make-repeated-music name))) - (set! (ly:music-property r 'element) main) - (set! (ly:music-property r 'repeat-count) (max times 1)) - (set! (ly:music-property r 'elements) talts) - (if (and (equal? name "tremolo") - (pair? (extract-named-music main '(EventChord NoteEvent)))) - ;; This works for single-note and multi-note tremolos! - (let* ((children (if (music-is-of-type? main 'sequential-music) - ;; \repeat tremolo n { ... } - (length (extract-named-music main '(EventChord - NoteEvent))) - ;; \repeat tremolo n c4 - 1)) - ;; # of dots is equal to the 1 in bitwise representation (minus 1)! - (dots (1- (logcount (* times children)))) - ;; The remaining missing multiplicator to scale the notes by + (let* ((times (ly:music-property tremolo 'repeat-count)) + (body (ly:music-property tremolo 'element)) + (children (if (music-is-of-type? body 'sequential-music) + ;; \repeat tremolo n { ... } + (length (extract-named-music body '(EventChord + NoteEvent))) + ;; \repeat tremolo n c4 + 1)) + (tremolo-type (if (positive? children) + (let* ((note-duration (first-note-duration body)) + (duration-log (if (ly:duration? note-duration) + (ly:duration-log note-duration) + 1))) + (ash 1 duration-log)) + '())) + (stretched (ly:music-deep-copy body))) + (if (positive? children) + ;; # of dots is equal to the 1 in bitwise representation (minus 1)! + (let* ((dots (1- (logcount (* times children)))) + ;; The remaining missing multiplier to scale the notes by ;; times * children (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots)))) - (shift (- (ly:intlog2 (floor mult)))) - (note-duration (first-note-duration r)) - (duration-log (if (ly:duration? note-duration) - (ly:duration-log note-duration) - 1)) - (tremolo-type (ash 1 duration-log))) - (set! (ly:music-property r 'tremolo-type) tremolo-type) + (shift (- (ly:intlog2 (floor mult))))) (if (not (and (integer? mult) (= (logcount mult) 1))) (ly:music-warning - main + body (ly:format (_ "invalid tremolo repeat count: ~a") times))) - ;; Adjust the time of the notes - (ly:music-compress r (ly:make-moment 1 children)) + ;; Make each note take the full duration + (ly:music-compress stretched (ly:make-moment 1 children)) ;; Adjust the displayed note durations - (shift-duration-log r shift dots)) - r))) + (shift-duration-log stretched shift dots))) + ;; Return the stretched body plus a tremolo event + (if (= children 1) + (list (make-music 'TremoloEvent + 'repeat-count times + 'tremolo-type tremolo-type + 'origin (ly:music-property tremolo 'origin)) + stretched) + (list (make-music 'TremoloSpanEvent + 'span-direction START + 'repeat-count times + 'tremolo-type tremolo-type + 'origin (ly:music-property tremolo 'origin)) + stretched + (make-music 'TremoloSpanEvent + 'span-direction STOP + 'origin (ly:music-property tremolo 'origin)))))) + +(define-public (make-repeat name times main alts) + "Create a repeat music expression, with all properties initialized +properly." + (let ((type (or (assoc-get name '(("volta" . VoltaRepeatedMusic) + ("unfold" . UnfoldedRepeatedMusic) + ("percent" . PercentRepeatedMusic) + ("tremolo" . TremoloRepeatedMusic))) + (begin (ly:warning (_ "unknown repeat type `~S': must be volta, unfold, percent, or tremolo") name) + 'VoltaRepeatedMusic))) + (talts (if (< times (length alts)) + (begin + (ly:warning (_ "More alternatives than repeats. Junking excess alternatives")) + (take alts times)) + alts))) + (make-music type + 'element main + 'repeat-count (max times 1) + 'elements talts))) (define (calc-repeat-slash-count music) "Given the child-list @var{music} in @code{PercentRepeatMusic}, @@ -340,40 +382,10 @@ beats to be distinguished." (define-public (unfold-repeats music) "Replace all repeats with unfolded repeats." - (let ((es (ly:music-property music 'elements)) (e (ly:music-property music 'element))) - (if (music-is-of-type? music 'repeated-music) - (let* ((props (ly:music-mutable-properties music)) - (old-name (ly:music-property music 'name)) - (flattened (flatten-alist props))) - (set! music (apply make-music (cons 'UnfoldedRepeatedMusic - flattened))) - - (if (and (equal? old-name 'TremoloRepeatedMusic) - (pair? (extract-named-music e '(EventChord NoteEvent)))) - ;; This works for single-note and multi-note tremolos! - (let* ((children (if (music-is-of-type? e 'sequential-music) - ;; \repeat tremolo n { ... } - (length (extract-named-music e '(EventChord - NoteEvent))) - ;; \repeat tremolo n c4 - 1)) - (times (ly:music-property music 'repeat-count)) - - ;; # of dots is equal to the 1 in bitwise representation (minus 1)! - (dots (1- (logcount (* times children)))) - ;; The remaining missing multiplicator to scale the notes by - ;; times * children - (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots)))) - (shift (- (ly:intlog2 (floor mult))))) - - ;; Adjust the time of the notes - (ly:music-compress music (ly:make-moment children 1)) - ;; Adjust the displayed note durations - (shift-duration-log music (- shift) (- dots)))))) - + (set! music (make-music 'UnfoldedRepeatedMusic music))) (if (pair? es) (set! (ly:music-property music 'elements) (map unfold-repeats es))) @@ -382,6 +394,26 @@ beats to be distinguished." (unfold-repeats e))) music)) +(define-public (unfold-repeats-fully music) + "Unfolds repeats and expands the resulting @code{unfolded-repeated-music}." + (map-some-music + (lambda (m) + (and (music-is-of-type? m 'unfolded-repeated-music) + (make-sequential-music + (ly:music-deep-copy + (let ((n (ly:music-property m 'repeat-count)) + (alts (ly:music-property m 'elements)) + (body (ly:music-property m 'element))) + (cond ((<= n 0) '()) + ((null? alts) (make-list n body)) + (else + (concatenate + (zip (make-list n body) + (append! (make-list (max 0 (- n (length alts))) + (car alts)) + alts)))))))))) + (unfold-repeats music))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; property setting music objs. @@ -503,6 +535,28 @@ in @var{grob}." TupletBracket TrillSpanner)) +(define general-grace-settings + `((Voice Stem font-size -3) + (Voice Flag font-size -3) + (Voice NoteHead font-size -3) + (Voice TabNoteHead font-size -4) + (Voice Dots font-size -3) + (Voice Stem length-fraction 0.8) + (Voice Stem no-stem-extend #t) + (Voice Beam beam-thickness 0.384) + (Voice Beam length-fraction 0.8) + (Voice Accidental font-size -4) + (Voice AccidentalCautionary font-size -4) + (Voice Script font-size -3) + (Voice Fingering font-size -8) + (Voice StringNumber font-size -8))) + +(define-public score-grace-settings + (append + `((Voice Stem direction ,UP) + (Voice Slur direction ,DOWN)) + general-grace-settings)) + (define-safe-public (make-voice-props-set n) (make-sequential-music (append @@ -510,26 +564,9 @@ in @var{grob}." (if (odd? n) -1 1))) direction-polyphonic-grobs) (list - (make-property-set 'graceSettings - ;; TODO: take this from voicedGraceSettings or similar. - '((Voice Stem font-size -3) - (Voice Flag font-size -3) - (Voice NoteHead font-size -3) - (Voice TabNoteHead font-size -4) - (Voice Dots font-size -3) - (Voice Stem length-fraction 0.8) - (Voice Stem no-stem-extend #t) - (Voice Beam beam-thickness 0.384) - (Voice Beam length-fraction 0.8) - (Voice Accidental font-size -4) - (Voice AccidentalCautionary font-size -4) - (Voice Script font-size -3) - (Voice Fingering font-size -8) - (Voice StringNumber font-size -8))) - + (make-property-set 'graceSettings general-grace-settings) (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)))))) - (define-safe-public (make-voice-props-override n) (make-sequential-music (append @@ -537,25 +574,8 @@ in @var{grob}." (if (odd? n) -1 1))) direction-polyphonic-grobs) (list - (make-property-set 'graceSettings - ;; TODO: take this from voicedGraceSettings or similar. - '((Voice Stem font-size -3) - (Voice Flag font-size -3) - (Voice NoteHead font-size -3) - (Voice TabNoteHead font-size -4) - (Voice Dots font-size -3) - (Voice Stem length-fraction 0.8) - (Voice Stem no-stem-extend #t) - (Voice Beam beam-thickness 0.384) - (Voice Beam length-fraction 0.8) - (Voice Accidental font-size -4) - (Voice AccidentalCautionary font-size -4) - (Voice Script font-size -3) - (Voice Fingering font-size -8) - (Voice StringNumber font-size -8))) - - (make-grob-property-override 'NoteColumn 'horizontal-shift (quotient n 2)) - (make-grob-property-override 'MultiMeasureRest 'staff-position (if (odd? n) -4 4)))))) + (make-property-set 'graceSettings general-grace-settings) + (make-grob-property-override 'NoteColumn 'horizontal-shift (quotient n 2)))))) (define-safe-public (make-voice-props-revert) (make-sequential-music @@ -563,8 +583,7 @@ in @var{grob}." (map (lambda (x) (make-grob-property-revert x 'direction)) direction-polyphonic-grobs) (list (make-property-unset 'graceSettings) - (make-grob-property-revert 'NoteColumn 'horizontal-shift) - (make-grob-property-revert 'MultiMeasureRest 'staff-position))))) + (make-grob-property-revert 'NoteColumn 'horizontal-shift))))) (define-safe-public (context-spec-music m context #:optional id) @@ -627,9 +646,10 @@ in @var{grob}." (make-music 'PropertyUnset 'symbol sym)) -(define-safe-public (make-articulation name) - (make-music 'ArticulationEvent - 'articulation-type name)) +(define-safe-public (make-articulation name . properties) + (apply make-music 'ArticulationEvent + 'articulation-type name + properties)) (define-public (make-lyric-event string duration) (make-music 'LyricEvent @@ -741,7 +761,8 @@ duration is replaced with the specified @var{duration}." (set! (ly:music-property repeat-chord 'articulations) (append! (set-origin! (ly:music-deep-copy arts)) - (ly:music-property repeat-chord 'articulations)))))) + (ly:music-property repeat-chord 'articulations))))) + repeat-chord) (define-public (expand-repeat-chords! event-types music) @@ -760,8 +781,7 @@ respective predecessor chord." last-chord)) (last-chord (set! (ly:music-property music 'duration) '()) - (copy-repeat-chord last-chord music chord-repeat event-types) - music) + (copy-repeat-chord last-chord music chord-repeat event-types)) (else (ly:music-warning music (_ "Bad chord repetition")) #f))) @@ -770,6 +790,73 @@ respective predecessor chord." (ly:music-property music 'elements))))) music) +;;; This does _not_ copy any articulations. Rationale: one main +;;; incentive for pitch-repeating durations is after ties, such that +;;; 4~2~8. can stand in for a 15/16 note in \partial 4 position. In +;;; this use case, any repeated articulations will be a nuisance. +;;; +;;; String assignments in TabStaff might seem like a worthwhile +;;; exception, but they would be better tackled by the respective +;;; engravers themselves (see issue 3662). +;;; +;;; Repeating chords as well seems problematic for things like +;;; \score { +;;; << +;;; \new Staff { c4 c c } +;;; \new RhythmicStaff { 4 4 4 4 } +;;; >> +;;; } +;;; +;;; However, because of MIDI it is not advisable to use RhythmicStaff +;;; without any initial pitch/drum-type. For music functions taking +;;; pure rhythms as an argument, the running of expand-repeat-notes! +;;; at scorification time is irrelevant: at that point of time, the +;;; music function has already run. + +(define-public (expand-repeat-notes! music) + "Walks through @var{music} and gives pitchless notes (not having a +pitch in code{pitch} or a drum type in @code{drum-type}) the pitch(es) +from the predecessor note/chord if available." + (let ((last-pitch #f)) + (map-some-music + (lambda (m) + (define (set-and-ret last) + (set! last-pitch last) + m) + (cond + ((music-is-of-type? m 'event-chord) + (set-and-ret m)) + ((music-is-of-type? m 'note-event) + (cond + ((or (ly:music-property m 'pitch #f) + (ly:music-property m 'drum-type #f)) + => set-and-ret) + ;; ok, naked rhythm. Go through the various cases of + ;; last-pitch + ;; nothing available: just keep as-is + ((not last-pitch) m) + ((ly:pitch? last-pitch) + (set! (ly:music-property m 'pitch) last-pitch) + m) + ((symbol? last-pitch) + (set! (ly:music-property m 'drum-type) last-pitch) + m) + ;; Ok, this is the big bad one: the reference is a chord. + ;; For now, we use the repeat chord logic. That's not + ;; really efficient as cleaning out all articulations is + ;; quite simpler than what copy-repeat-chord does. + (else + (copy-repeat-chord last-pitch + (make-music 'EventChord + 'elements + (ly:music-property m 'articulations) + 'origin + (ly:music-property m 'origin)) + (ly:music-property m 'duration) + '(rhythmic-event))))) + (else #f))) + music))) + ;;; splitting chords into voices. (define (voicify-list lst number) "Make a list of Musics. @@ -819,17 +906,19 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0. (lambda (elt) (grob::has-interface elt symbol))) -(define-public ((outputproperty-compatibility func sym val) grob g-context ao-context) +(define ((outputproperty-compatibility func sym val) grob g-context ao-context) (if (func grob) (set! (ly:grob-property grob sym) val))) +(export outputproperty-compatibility) -(define-public ((set-output-property grob-name symbol val) grob grob-c context) +(define ((set-output-property grob-name symbol val) grob grob-c context) "Usage example: @code{\\applyoutput #(set-output-property 'Clef 'extra-offset '(0 . 1))}" (let ((meta (ly:grob-property grob 'meta))) (if (equal? (assoc-get 'name meta) grob-name) (set! (ly:grob-property grob symbol) val)))) +(export set-output-property) (define-public (skip->rest mus) @@ -926,12 +1015,12 @@ actually fully cloned." (define-public (add-grace-property context-name grob sym val) "Set @var{sym}=@var{val} for @var{grob} in @var{context-name}." (define (set-prop context) - (let* ((where (ly:context-property-where-defined context 'graceSettings)) + (let* ((where (or (ly:context-find context context-name) context)) (current (ly:context-property where 'graceSettings)) (new-settings (append current (list (list context-name grob sym val))))) (ly:context-set-property! where 'graceSettings new-settings))) - (context-spec-music (make-apply-context set-prop) 'Voice)) + (make-apply-context set-prop)) (define-public (remove-grace-property context-name grob sym) "Remove all @var{sym} for @var{grob} in @var{context-name}." @@ -940,7 +1029,7 @@ actually fully cloned." (eq? (cadr property) grob) (eq? (caddr property) sym))) (define (delete-prop context) - (let* ((where (ly:context-property-where-defined context 'graceSettings)) + (let* ((where (or (ly:context-find context context-name) context)) (current (ly:context-property where 'graceSettings)) (prop-settings (filter (lambda(x) (sym-grob-context? x sym grob context-name)) @@ -950,8 +1039,7 @@ actually fully cloned." (set! new-settings (delete x new-settings))) prop-settings) (ly:context-set-property! where 'graceSettings new-settings))) - (context-spec-music (make-apply-context delete-prop) 'Voice)) - + (make-apply-context delete-prop)) (defmacro-public def-grace-function (start stop . docstring) @@ -987,24 +1075,37 @@ predicates require the parameter to be entered as Scheme expression. predicates, to be used in case of a type error in arguments or result." + (define (currying-lambda args doc-string? body) + (if (and (pair? args) + (pair? (car args))) + (currying-lambda (car args) doc-string? + `((lambda ,(cdr args) ,@body))) + (if doc-string? + `(lambda ,args ,doc-string? ,@body) + `(lambda ,args ,@body)))) + (set! signature (map (lambda (pred) (if (pair? pred) `(cons ,(car pred) ,(and (pair? (cdr pred)) (cadr pred))) pred)) (cons type signature))) - (if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body))) - ;; When the music function definition contains a i10n doc string, - ;; (_i "doc string"), keep the literal string only - (let ((docstring (cadar body)) - (body (cdr body))) - `(ly:make-music-function (list ,@signature) - (lambda ,args - ,docstring - ,@body))) - `(ly:make-music-function (list ,@signature) - (lambda ,args - ,@body)))) + + (let ((docstring + (and (pair? body) (pair? (cdr body)) + (if (string? (car body)) + (car body) + (and (pair? (car body)) + (eq? '_i (caar body)) + (pair? (cdar body)) + (string? (cadar body)) + (null? (cddar body)) + (cadar body)))))) + ;; When the music function definition contains an i10n doc string, + ;; (_i "doc string"), keep the literal string only + `(ly:make-music-function + (list ,@signature) + ,(currying-lambda args docstring (if docstring (cdr body) body))))) (defmacro-public define-music-function rest "Defining macro returning music functions. @@ -1095,6 +1196,8 @@ set to the @code{location} parameter." (clef (ly:music-property quote-music 'quoted-music-clef #f)) (main-voice (case dir ((1) 1) ((-1) 0) (else #f))) (cue-voice (and main-voice (- 1 main-voice))) + (cue-type (ly:music-property quote-music 'quoted-context-type #f)) + (cue-id (ly:music-property quote-music 'quoted-context-id)) (main-music (ly:music-property quote-music 'element)) (return-value quote-music)) @@ -1116,21 +1219,19 @@ set to the @code{location} parameter." (delq! #f (list (and clef (make-cue-clef-set clef)) - - ;; Need to establish CueVoice context even in #CENTER case - (context-spec-music - (if cue-voice - (make-voice-props-override cue-voice) - (make-music 'Music)) - 'CueVoice "cue") + (and cue-type cue-voice + (context-spec-music + (make-voice-props-override cue-voice) + cue-type cue-id)) quote-music - (and cue-voice + (and cue-type cue-voice (context-spec-music - (make-voice-props-revert) 'CueVoice "cue")) + (make-voice-props-revert) + cue-type cue-id)) (and clef (make-cue-clef-unset)))))) quote-music)) -(define-public ((quote-substitute quote-tab) music) +(define ((quote-substitute quote-tab) music) (let* ((quoted-name (ly:music-property music 'quoted-music-name)) (quoted-vector (and (string? quoted-name) (hash-ref quote-tab quoted-name #f)))) @@ -1144,6 +1245,7 @@ set to the @code{location} parameter." ly:quote-iterator::constructor)) (ly:music-warning music (ly:format (_ "cannot find quoted music: `~S'") quoted-name)))) music)) +(export quote-substitute) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1256,12 +1358,13 @@ then revert skipTypesetting." (else music)))) -(define-public toplevel-music-functions +(define-session-public toplevel-music-functions (list (lambda (music parser) (expand-repeat-chords! (cons 'rhythmic-event (ly:parser-lookup parser '$chord-repeat-events)) music)) + (lambda (music parser) (expand-repeat-notes! music)) (lambda (music parser) (voicify-music music)) (lambda (x parser) (music-map music-check-error x)) (lambda (x parser) (music-map precompute-music-length x)) @@ -1329,22 +1432,25 @@ Returns @code{#f} or the reason for the invalidation, a symbol." (car alteration-def)) (else 0))) -(define (check-pitch-against-signature context pitch barnum laziness octaveness) +(define (check-pitch-against-signature context pitch barnum laziness octaveness all-naturals) "Checks the need for an accidental and a @q{restore} accidental against -@code{localKeySignature}. The @var{laziness} is the number of measures +@code{localAlterations} and @code{keyAlterations}. +The @var{laziness} is the number of measures for which reminder accidentals are used (i.e., if @var{laziness} is zero, only cancel accidentals in the same measure; if @var{laziness} is three, we cancel accidentals up to three measures after they first appear. @var{octaveness} is either @code{'same-octave} or @code{'any-octave} and -specifies whether accidentals should be canceled in different octaves." +specifies whether accidentals should be canceled in different octaves. +If @var{all-naturals} is ##t, notes that do not occur in @code{keyAlterations} +also get an accidental." (let* ((ignore-octave (cond ((equal? octaveness 'any-octave) #t) ((equal? octaveness 'same-octave) #f) (else (ly:warning (_ "Unknown octaveness type: ~S ") octaveness) (ly:warning (_ "Defaulting to 'any-octave.")) #t))) - (key-sig (ly:context-property context 'keySignature)) - (local-key-sig (ly:context-property context 'localKeySignature)) + (key (ly:context-property context 'keyAlterations)) + (local (ly:context-property context 'localAlterations)) (notename (ly:pitch-notename pitch)) (octave (ly:pitch-octave pitch)) (pitch-handle (cons octave notename)) @@ -1352,17 +1458,17 @@ specifies whether accidentals should be canceled in different octaves." (need-accidental #f) (previous-alteration #f) (from-other-octaves #f) - (from-same-octave (assoc-get pitch-handle local-key-sig)) - (from-key-sig (or (assoc-get notename local-key-sig) + (from-same-octave (assoc-get pitch-handle local)) + (from-key-sig (or (assoc-get notename local) - ;; If no key signature match is found from localKeySignature, we may have a custom + ;; If no notename match is found from localAlterations, we may have a custom ;; type with octave-specific entries of the form ((octave . pitch) alteration) ;; instead of (pitch . alteration). Since this type cannot coexist with entries in - ;; localKeySignature, try extracting from keySignature instead. - (assoc-get pitch-handle key-sig)))) + ;; localAlterations, try extracting from keyAlterations instead. + (assoc-get pitch-handle key)))) - ;; loop through localKeySignature to search for a notename match from other octaves - (let loop ((l local-key-sig)) + ;; loop through localAlterations to search for a notename match from other octaves + (let loop ((l local)) (if (pair? l) (let ((entry (car l))) (if (and (pair? (car entry)) @@ -1394,7 +1500,7 @@ specifies whether accidentals should be canceled in different octaves." (let* ((prev-alt (extract-alteration previous-alteration)) (this-alt (ly:pitch-alteration pitch))) - (if (not (= this-alt prev-alt)) + (if (or (and all-naturals (eq? #f previous-alteration)) (not (= this-alt prev-alt))) (begin (set! need-accidental #t) (if (and (not (= this-alt 0)) @@ -1404,7 +1510,7 @@ specifies whether accidentals should be canceled in different octaves." (cons need-restore need-accidental))) -(define-public ((make-accidental-rule octaveness laziness) context pitch barnum measurepos) +(define ((make-accidental-rule octaveness laziness) context pitch barnum measurepos) "Create an accidental rule that makes its decision based on the octave of the note and a laziness value. @@ -1421,10 +1527,18 @@ is, to the end of current measure. A positive integer means that the accidental lasts over that many bar lines. @w{@code{-1}} is `forget immediately', that is, only look at key signature. @code{#t} is `forever'." - (check-pitch-against-signature context pitch barnum laziness octaveness)) + (check-pitch-against-signature context pitch barnum laziness octaveness #f)) +(export make-accidental-rule) + +(define ((make-accidental-dodecaphonic-rule octaveness laziness) context pitch barnum measurepos) + "Variation on function make-accidental-rule that creates an dodecaphonic +accidental rule." + + (check-pitch-against-signature context pitch barnum laziness octaveness #t)) +(export make-accidental-dodecaphonic-rule) (define (key-entry-notename entry) - "Return the pitch of an @var{entry} in @code{localKeySignature}. + "Return the pitch of an @var{entry} in @code{localAlterations}. The @samp{car} of the entry is either of the form @code{notename} or of the form @code{(octave . notename)}. The latter form is used for special key signatures or to indicate an explicit accidental. @@ -1438,25 +1552,25 @@ an accidental in music." (car entry))) (define (key-entry-octave entry) - "Return the octave of an entry in @code{localKeySignature} + "Return the octave of an entry in @code{localAlterations} or @code{#f} if the entry does not have an octave. See @code{key-entry-notename} for details." (and (pair? (car entry)) (caar entry))) (define (key-entry-bar-number entry) - "Return the bar number of an entry in @code{localKeySignature} + "Return the bar number of an entry in @code{localAlterations} or @code {#f} if the entry does not have a bar number. See @code{key-entry-notename} for details." (and (pair? (cdr entry)) (caddr entry))) (define (key-entry-measure-position entry) - "Return the measure position of an entry in @code{localKeySignature} + "Return the measure position of an entry in @code{localAlterations} or @code {#f} if the entry does not have a measure position. See @code{key-entry-notename} for details." (and (pair? (cdr entry)) (cdddr entry))) (define (key-entry-alteration entry) - "Return the alteration of an entry in localKeySignature. + "Return the alteration of an entry in localAlterations For convenience, returns @code{0} if entry is @code{#f}." (if entry @@ -1489,7 +1603,7 @@ If no matching entry is found, @var{#f} is returned." key signature @emph{and} does not directly follow a note on the same staff line. This rule should not be used alone because it does neither look at bar lines nor different accidentals at the same note name." - (let* ((keysig (ly:context-property context 'localKeySignature)) + (let* ((keysig (ly:context-property context 'localAlterations)) (entry (find-pitch-entry keysig pitch #t #t))) (if (not entry) (cons #f #f) @@ -1501,17 +1615,36 @@ look at bar lines nor different accidentals at the same note name." (cons #f (not (or (equal? acc key-acc) (and (equal? entrybn barnum) (equal? entrymp measurepos))))))))) +(define-public (dodecaphonic-no-repeat-rule context pitch barnum measurepos) + "An accidental rule that typesets an accidental before every +note (just as in the dodecaphonic accidental style) @emph{except} if +the note is immediately preceded by a note with the same pitch. This +is a common accidental style in contemporary notation." + (let* ((keysig (ly:context-property context 'localKeySignature)) + (entry (find-pitch-entry keysig pitch #t #t))) + (if (not entry) + (cons #f #t) + (let* ((entrymp (key-entry-measure-position entry)) + (entrybn (key-entry-bar-number entry))) + (cons #f + (not + (and (equal? entrybn barnum) (equal? entrymp measurepos)))))))) + (define-public (teaching-accidental-rule context pitch barnum measurepos) "An accidental rule that typesets a cautionary accidental if it is included in the key signature @emph{and} does not directly follow a note on the same staff line." - (let* ((keysig (ly:context-property context 'localKeySignature)) + (let* ((keysig (ly:context-property context 'localAlterations)) (entry (find-pitch-entry keysig pitch #t #t))) (if (not entry) (cons #f #f) - (let* ((entrymp (key-entry-measure-position entry)) + (let* ((global-entry (find-pitch-entry keysig pitch #f #f)) + (key-acc (key-entry-alteration global-entry)) + (acc (ly:pitch-alteration pitch)) + (entrymp (key-entry-measure-position entry)) (entrybn (key-entry-bar-number entry))) - (cons #f (not (and (equal? entrybn barnum) (equal? entrymp measurepos)))))))) + (cons #f (not (or (equal? acc key-acc) + (and (equal? entrybn barnum) (equal? entrymp measurepos))))))))) (define-public (set-accidentals-properties extra-natural auto-accs auto-cauts @@ -1611,6 +1744,22 @@ as a context." `(Staff ,(lambda (c p bn mp) '(#f . #t))) '() context)) + ;; As in dodecaphonic style with the exception that immediately + ;; repeated notes (in the same voice) don't get an accidental + ((equal? style 'dodecaphonic-no-repeat) + (set-accidentals-properties #f + `(Staff ,(make-accidental-rule 'same-octave 0) + ,dodecaphonic-no-repeat-rule) + '() + context)) + ;; Variety of the dodecaphonic style. Each note gets an accidental, + ;; except notes that were already handled in the same measure. + ((equal? style 'dodecaphonic-first) + (set-accidentals-properties #f + `(Staff ,(make-accidental-dodecaphonic-rule 'same-octave 0)) + '() + context)) + ;; Multivoice accidentals to be read both by musicians playing one voice ;; and musicians playing all voices. ;; Accidentals are typeset for each voice, but they ARE canceled across voices. @@ -1666,8 +1815,8 @@ as a context." ,teaching-accidental-rule) context)) - ;; do not set localKeySignature when a note alterated differently from - ;; localKeySignature is found. + ;; do not set localAlterations when a note alterated differently from + ;; localAlterations is found. ;; Causes accidentals to be printed at every note instead of ;; remembered for the duration of a measure. ;; accidentals not being remembered, causing accidentals always to @@ -1692,15 +1841,15 @@ as a context." (define-public (invalidate-alterations context) "Invalidate alterations in @var{context}. -Elements of @code{'localKeySignature} corresponding to local +Elements of @code{'localAlterations} corresponding to local alterations of the key signature have the form @code{'((octave . notename) . (alter barnum . measurepos))}. Replace them with a version where @code{alter} is set to @code{'clef} to force a repetition of accidentals. Entries that conform with the current key signature are not invalidated." - (let* ((keysig (ly:context-property context 'keySignature))) - (set! (ly:context-property context 'localKeySignature) + (let* ((keysig (ly:context-property context 'keyAlterations))) + (set! (ly:context-property context 'localAlterations) (map-in-order (lambda (entry) (let* ((localalt (key-entry-alteration entry))) @@ -1716,7 +1865,7 @@ Entries that conform with the current key signature are not invalidated." #t #t)))) entry (cons (car entry) (cons 'clef (cddr entry)))))) - (ly:context-property context 'localKeySignature))))) + (ly:context-property context 'localAlterations))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1880,38 +2029,111 @@ yourself." (map (lambda (x) (ly:music-property x 'pitch)) (event-chord-notes event-chord))) -(defmacro-public make-relative (pitches last-pitch music) - "The list of pitch-carrying variables in @var{pitches} is used as a -sequence for creating relativable music from @var{music}. -The variables in @var{pitches} are, when considered inside of -@code{\\relative}, all considered to be specifications to the preceding -variable. The first variable is relative to the preceding musical -context, and @var{last-pitch} specifies the pitch passed as relative -base onto the following musical context." +(define-public (event-chord-reduce music) + "Reduces event chords in @var{music} to their first note event, +retaining only the chord articulations. Returns the modified music." + (map-some-music + (lambda (m) + (and (music-is-of-type? m 'event-chord) + (let*-values (((notes arts) (partition + (lambda (mus) + (music-is-of-type? mus 'rhythmic-event)) + (ly:music-property m 'elements))) + ((dur) (ly:music-property m 'duration)) + ((full-arts) (append arts + (ly:music-property m 'articulations))) + ((first-note) (and (pair? notes) (car notes)))) + (cond (first-note + (set! (ly:music-property first-note 'articulations) + full-arts) + first-note) + ((ly:duration? dur) + ;; A repeat chord. Produce an unpitched note. + (make-music 'NoteEvent + 'duration dur + 'articulations full-arts)) + (else + (ly:music-error m (_ "Missing duration")) + (make-music 'NoteEvent + 'duration (ly:make-duration 2 0 0) + 'articulations full-arts)))))) + music)) + + +(defmacro-public make-relative (variables reference music) + "The list of pitch or music variables in @var{variables} is used as +a sequence for creating relativable music from @var{music}. + +When the constructed music is used outside of @code{\\relative}, it +just reflects plugging in the @var{variables} into @var{music}. + +The action inside of @code{\\relative}, however, is determined by +first relativizing the surrogate @var{reference} with the variables +plugged in and then using the variables relativized as a side effect +of relativizing @var{reference} for evaluating @var{music}. + +Since pitches don't have the object identity required for tracing the +effect of the reference call, they are replaced @emph{only} for the +purpose of evaluating @var{reference} with simple pitched note events. + +The surrogate @var{reference} expression has to be written with that +in mind. In addition, it must @emph{not} contain @emph{copies} of +music that is supposed to be relativized but rather the +@emph{originals}. This @emph{includes} the pitch expressions. As a +rule, inside of @code{#@{@dots{}#@}} variables must @emph{only} be +introduced using @code{#}, never via the copying construct @code{$}. +The reference expression will usually just be a sequential or chord +expression naming all variables in sequence, implying that following +music will be relativized according to the resulting pitch of the last +or first variable, respectively. + +Since the usual purpose is to create more complex music from general +arguments and since music expression parts must not occur more than +once, one @emph{does} generally need to use copying operators in the +@emph{replacement} expression @var{music} when using an argument more +than once there. Using an argument more than once in @var{reference}, +in contrast, does not make sense. + +There is another fine point to mind: @var{music} must @emph{only} +contain freshly constructed elements or copied constructs. This will +be the case anyway for regular LilyPond code inside of +@code{#@{@dots{}#@}}, but any other elements (apart from the +@var{variables} themselves which are already copied) must be created +or copied as well. + +The reason is that it is usually permitted to change music in-place as +long as one does a @var{ly:music-deep-copy} on it, and such a copy of +the whole resulting expression will @emph{not} be able to copy +variables/values inside of closures where the information for +relativization is being stored. +" ;; pitch and music generator might be stored instead in music ;; properties, and it might make sense to create a music type of its ;; own for this kind of construct rather than using ;; RelativeOctaveMusic - (define ((make-relative::to-relative-callback pitches p->m p->p) music pitch) - (let* ((chord (make-event-chord - (map - (lambda (p) - (make-music 'NoteEvent - 'pitch p)) - pitches))) - (pitchout (begin - (ly:make-music-relative! chord pitch) - (event-chord-pitches chord)))) - (set! (ly:music-property music 'element) - (apply p->m pitchout)) - (apply p->p pitchout))) + (define ((make-relative::to-relative-callback variables music-call ref-call) + music pitch) + (let* ((ref-vars (map (lambda (v) + (if (ly:pitch? v) + (make-music 'NoteEvent 'pitch v) + (ly:music-deep-copy v))) + variables)) + (after-pitch (ly:make-music-relative! (apply ref-call ref-vars) pitch)) + (actual-vars (map (lambda (v r) + (if (ly:pitch? v) + (ly:music-property r 'pitch) + r)) + variables ref-vars)) + (rel-music (apply music-call actual-vars))) + (set! (ly:music-property music 'element) rel-music) + after-pitch)) `(make-music 'RelativeOctaveMusic 'to-relative-callback (,make-relative::to-relative-callback - (list ,@pitches) - (lambda ,pitches ,music) - (lambda ,pitches ,last-pitch)) + (list ,@variables) + (lambda ,variables ,music) + (lambda ,variables ,reference)) 'element ,music)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1954,9 +2176,9 @@ base onto the following musical context." (layout (ly:grob-layout root)) (blot (ly:output-def-lookup layout 'blot-diameter))) ;; Hide spanned stems - (map (lambda (st) - (set! (ly:grob-property st 'stencil) #f)) - stems) + (for-each (lambda (st) + (set! (ly:grob-property st 'stencil) #f)) + stems) ;; Draw a nice looking stem with rounded corners (ly:round-filled-box (ly:grob-extent root root X) yextent blot)) ;; Nothing to connect, don't draw the span @@ -1988,7 +2210,7 @@ other stems just because of that." ;; two stems at this musical moment (if (<= 2 (length stems)) (let ((roots (filter stem-is-root? stems))) - (map (make-stem-span! stems trans) roots)))) + (for-each (make-stem-span! stems trans) roots)))) (define-public (Span_stem_engraver ctx) "Connect cross-staff stems to the stems above in the system" @@ -2006,7 +2228,7 @@ other stems just because of that." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The following is used by the alterBroken function. -(define-public ((value-for-spanner-piece arg) grob) +(define ((value-for-spanner-piece arg) grob) "Associate a piece of broken spanner @var{grob} with an element of list @var{arg}." (let* ((orig (ly:grob-original grob)) @@ -2022,6 +2244,7 @@ of list @var{arg}." (if (>= (length siblings) 2) (helper siblings arg) (car arg)))) +(export value-for-spanner-piece) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; measure counter @@ -2082,3 +2305,221 @@ Broken measures are numbered in parentheses." (cdr break-alignment-L-ext)))) X))) num)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The following are used by the \offset function + +(define (find-value-to-offset prop self alist) + "Return the first value of the property @var{prop} in the property +alist @var{alist} -- after having found @var{self}. If @var{self} is +not found, return the first value of @var{prop}." + (let ((segment (member (cons prop self) alist))) + (if (not segment) + (assoc-get prop alist) + (assoc-get prop (cdr segment))))) + +(define (offset-multiple-types arg offsets) + "Displace @var{arg} by @var{offsets} if @var{arg} is a number, a +number pair, or a list of number pairs. If @var{offsets} is an empty +list or if there is a type-mismatch, @var{arg} will be returned." + (cond + ((and (number? arg) (number? offsets)) + (+ arg offsets)) + ((and (number-pair? arg) + (or (number? offsets) + (number-pair? offsets))) + (coord-translate arg offsets)) + ((and (number-pair-list? arg) (number-pair-list? offsets)) + (map + (lambda (x y) (coord-translate x y)) + 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 (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)))) + + (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. + (if (equal? empty-interval vals) + (ly:warning "default '~a of ~a is ~a and can't be offset" + property grob vals) + (let* ((orig (ly:grob-original grob)) + (siblings + (if (ly:spanner? grob) + (ly:spanner-broken-into orig) + '())) + (total-found (length siblings)) + ; Since there is some flexibility in input syntax, + ; structure of `offsets' is normalized. + (offsets + (if (or (not (pair? offsets)) + (number-pair? offsets) + (and (number-pair-list? offsets) + (number-pair-list? vals))) + (list offsets) + offsets))) + + (define (helper sibs offs) + ; apply offsets to the siblings of broken spanners + (if (pair? offs) + (if (eq? (car sibs) grob) + (offset-multiple-types vals (car offs)) + (helper (cdr sibs) (cdr offs))) + vals)) + + (if (>= total-found 2) + (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) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The following are used by \magnifyMusic + +(define-public (scale-fontSize mag) + "Used by @code{\\magnifyMusic}. Look up the current fontSize and +scale it by the magnification factor @var{mag}." + (make-apply-context + (lambda (context) + (let* ((fontSize (ly:context-property context 'fontSize 0)) + (new-fontSize (+ fontSize (magnification->font-size mag)))) + (ly:context-set-property! context 'fontSize new-fontSize))))) + +(define-public (revert-fontSize mag) + "Used by @code{\\magnifyMusic}. Calculate the previous fontSize value +(before scaling) by factoring out the magnification factor @var{mag}." + (make-apply-context + (lambda (context) + (let* ((fontSize (ly:context-property context 'fontSize 0)) + (old-fontSize (- fontSize (magnification->font-size mag)))) + (ly:context-set-property! context 'fontSize old-fontSize))))) + +(define-public (scale-props props mag allowed-to-shrink?) + "Used by @code{\\magnifyMusic}. For each prop in @var{props}, find +the current value of the requested prop, scale it by the magnification +factor @var{mag}, and do the equivalent of a +@code{\\temporary@tie{}\\override} with the new value. If +@code{allowed-to-shrink?} is @code{#f}, don't let the new value be less +than the current value. Props are formatted like: + +@example +Slur.height-limit +Slur.details.region-size +@end example" + (make-apply-context + (lambda (context) + (define (scale-prop grob.prop) + (let* ((grob-prop-list (map string->symbol + (string-split + (symbol->string grob.prop) #\.))) + (prop-is-alist? (eq? 3 (length grob-prop-list))) + (grob (car grob-prop-list)) + (prop (cadr grob-prop-list)) + (where (if (eq? grob 'SpacingSpanner) + (ly:context-find context 'Score) + context)) + (grob-def (ly:context-grob-definition where grob))) + (if prop-is-alist? + (let* ((subprop (caddr grob-prop-list)) + (old-alist (ly:assoc-get prop grob-def)) + (val (ly:assoc-get subprop old-alist 1)) + (round-if-needed + (lambda (x) + ;; these props require exact integers + (if (or (eq? subprop 'multi-tie-region-size) + (eq? subprop 'single-tie-region-size)) + (inexact->exact (round x)) + x))) + (new-val (if allowed-to-shrink? + (round-if-needed (* val mag)) + (round-if-needed (* val (max 1 mag))))) + (new-alist (cons (cons subprop new-val) old-alist))) + (ly:context-pushpop-property where grob prop new-alist)) + (let* ((val (ly:assoc-get prop grob-def 1)) + (proc (lambda (x) + (if allowed-to-shrink? + (* x mag) + (* x (max 1 mag))))) + (new-val (if (number-pair? val) + (cons (proc (car val)) + (proc (cdr val))) + (proc val)))) + (ly:context-pushpop-property where grob prop new-val))))) + (for-each scale-prop props)))) + +(define-public (scale-beam-thickness mag) + "Used by @code{\\magnifyMusic}. Scaling @code{Beam.beam-thickness} +exactly to the @var{mag} value won't work. This uses two reference +values for @code{beam-thickness} to determine an acceptable value when +scaling, then does the equivalent of a +@code{\\temporary@tie{}\\override} with the new value." + (make-apply-context + (lambda (context) + (let* ((grob-def (ly:context-grob-definition context 'Beam)) + (val (ly:assoc-get 'beam-thickness grob-def 0.48)) + (ratio-to-default (/ val 0.48)) + ;; gives beam-thickness=0.48 when mag=1 (like default), + ;; gives beam-thickness=0.35 when mag=0.63 (like CueVoice) + (scaled-default (+ 119/925 (* mag 13/37))) + (new-val (* scaled-default ratio-to-default))) + (ly:context-pushpop-property context 'Beam 'beam-thickness new-val))))) + +(define-public (revert-props props) + "Used by @code{\\magnifyMusic}. Revert each prop in @var{props}. +Props are formatted like: + +@example +Slur.height-limit +Slur.details.region-size +@end example + +Nested properties are reverted by reverting the parent property only. +For example, @code{Slur.details.region-size} gets reverted like this: + +@example +\revert Slur.details +@end example + +This is safe as long as the number of reverts matches the number of +overrides. Any user overrides within a @code{\\magnifyMusic} block +should be reverted before closing the block." + (make-apply-context + (lambda (context) + (define (revert-prop grob.prop) + (let* ((grob-prop-list (map string->symbol + (string-split + (symbol->string grob.prop) #\.))) + (grob (car grob-prop-list)) + (prop (cadr grob-prop-list)) + (where (if (eq? grob 'SpacingSpanner) + (ly:context-find context 'Score) + context))) + (ly:context-pushpop-property where grob prop))) + (for-each revert-prop props))))