X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=4ba6c6517ba534fae13cb932f0a030ef893e14cf;hb=47db9a3883d726ca53e2133a3b2298f78dd6a32e;hp=fb29e73cd2d4cc79d752c1606e77654fce4584d3;hpb=3eb0d21c7cac9360c37c3376c8771e6e29c1a588;p=lilypond.git

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index fb29e73cd2..4ba6c6517b 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 <janneke@gnu.org>
+;;;; Copyright (C) 1998--2015 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; 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.
 
@@ -614,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
@@ -718,7 +751,11 @@ duration is replaced with the specified @var{duration}."
                    (set! (ly:music-property m 'articulations)
                          (set-origin! (filter! keep-element? arts))))
                (if (ly:duration? (ly:music-property m 'duration))
-                   (set! (ly:music-property m 'duration) duration))))
+                   (set! (ly:music-property m 'duration) duration))
+               (if (ly:music-property m 'cautionary #f)
+                   (set! (ly:music-property m 'cautionary) #f))
+               (if (ly:music-property m 'force-accidental #f)
+                   (set! (ly:music-property m 'force-accidental) #f))))
            elts)
           (append! elts (ly:music-property repeat-chord 'elements))))
   (let ((arts (filter keep-element?
@@ -728,7 +765,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)
@@ -747,8 +785,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)))
@@ -757,6 +794,76 @@ 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 <c e> }
+;;;     \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)
+         (if (any (lambda (m) (music-is-of-type? m 'rhythmic-event))
+                  (ly:music-property m 'elements))
+             (set! last-pitch m))
+         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.
@@ -806,17 +913,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)
@@ -965,10 +1074,6 @@ value (evaluated at definition time).  An optional parameter can be
 omitted in a call only when it can't get confused with a following
 parameter of different type.
 
-Predicates with syntactical significance are @code{ly:pitch?},
-@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
-predicates require the parameter to be entered as Scheme expression.
-
 @code{result-type?} can specify a default in the same manner as
 predicates, to be used in case of a type error in arguments or
 result."
@@ -978,9 +1083,9 @@ result."
              (pair? (car args)))
         (currying-lambda (car args) doc-string?
                          `((lambda ,(cdr args) ,@body)))
-        (if doc-string?
-            `(lambda ,args ,doc-string? ,@body)
-            `(lambda ,args ,@body))))
+        `(lambda ,args
+           ,(format #f "~a\n~a" (cddr args) (or doc-string? ""))
+           ,@body)))
 
   (set! signature (map (lambda (pred)
                          (if (pair? pred)
@@ -1019,10 +1124,6 @@ value (evaluated at definition time).  An optional parameter can be
 omitted in a call only when it can't get confused with a following
 parameter of different type.
 
-Predicates with syntactical significance are @code{ly:pitch?},
-@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
-predicates require the parameter to be entered as Scheme expression.
-
 Must return a music expression.  The @code{origin} is automatically
 set to the @code{location} parameter."
 
@@ -1043,10 +1144,6 @@ value (evaluated at definition time).  An optional parameter can be
 omitted in a call only when it can't get confused with a following
 parameter of different type.
 
-Predicates with syntactical significance are @code{ly:pitch?},
-@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
-predicates require the parameter to be entered as Scheme expression.
-
 Can return arbitrary expressions.  If a music expression is returned,
 its @code{origin} is automatically set to the @code{location}
 parameter."
@@ -1075,10 +1172,6 @@ value (evaluated at definition time).  An optional parameter can be
 omitted in a call only when it can't get confused with a following
 parameter of different type.
 
-Predicates with syntactical significance are @code{ly:pitch?},
-@code{ly:duration?}, @code{ly:music?}, @code{markup?}.  Other
-predicates require the parameter to be entered as Scheme expression.
-
 Must return an event expression.  The @code{origin} is automatically
 set to the @code{location} parameter."
 
@@ -1129,7 +1222,7 @@ set to the @code{location} parameter."
                  (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))))
@@ -1143,6 +1236,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)
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1255,12 +1349,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))
@@ -1328,22 +1423,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))
@@ -1351,17 +1449,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))
@@ -1393,7 +1491,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))
@@ -1403,7 +1501,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.
 
@@ -1420,10 +1518,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.
@@ -1437,25 +1543,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
@@ -1465,7 +1571,8 @@ For convenience, returns @code{0} if entry is @code{#f}."
       0))
 
 (define-public (find-pitch-entry keysig pitch accept-global accept-local)
-  "Return the first entry in @var{keysig} that matches @var{pitch}.
+  "Return the first entry in @var{keysig} that matches @var{pitch}
+by notename and octave.  Alteration is not considered.
 @var{accept-global} states whether key signature entries should be included.
 @var{accept-local} states whether local accidentals should be included.
 If no matching entry is found, @var{#f} is returned."
@@ -1488,7 +1595,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)
@@ -1500,17 +1607,40 @@ 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 'localAlterations))
+          (entry (find-pitch-entry keysig pitch #f #t)))
+     (if (not entry)
+         (cons #f #t)
+         (let ((entrymp (key-entry-measure-position entry))
+               (entrybn (key-entry-bar-number entry))
+               (entryalt (key-entry-alteration entry))
+               (alt (ly:pitch-alteration pitch)))
+           (cons #t
+                 (not (and (equal? entrybn barnum)
+                           (or (equal? measurepos entrymp)
+                               (ly:moment<? measurepos entrymp))
+                           (equal? entryalt alt))))))))
+
 (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
@@ -1610,6 +1740,21 @@ 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 ,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.
@@ -1665,8 +1810,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
@@ -1691,15 +1836,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)))
@@ -1715,7 +1860,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)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -1879,38 +2024,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))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1953,9 +2171,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
@@ -1987,7 +2205,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"
@@ -2005,7 +2223,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))
@@ -2021,63 +2239,370 @@ of list @var{arg}."
     (if (>= (length siblings) 2)
         (helper siblings arg)
         (car arg))))
+(export value-for-spanner-piece)
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; measure counter
-
-(define (measure-counter-stencil grob)
-  "Print a number for a measure count.  The number is centered using
-the extents of @code{BreakAlignment} grobs associated with
-@code{NonMusicalPaperColumn} grobs.  In the case of an unbroken measure, these
-columns are the left and right bounds of a @code{MeasureCounter} spanner.
-Broken measures are numbered in parentheses."
-  (let* ((orig (ly:grob-original grob))
-         (siblings (ly:spanner-broken-into orig)) ; have we been split?
-         (bounds (ly:grob-array->list (ly:grob-object grob 'columns)))
-         (refp (ly:grob-system grob))
-         ;; we use the first and/or last NonMusicalPaperColumn grob(s) of
-         ;; a system in the event that a MeasureCounter spanner is broken
-         (all-cols (ly:grob-array->list (ly:grob-object refp 'columns)))
-         (all-cols
-          (filter
-           (lambda (col) (eq? #t (ly:grob-property col 'non-musical)))
-           all-cols))
-         (left-bound
-          (if (or (null? siblings) ; spanner is unbroken
-                  (eq? grob (car siblings))) ; or the first piece
-              (car bounds)
-              (car all-cols)))
-         (right-bound
-          (if (or (null? siblings)
-                  (eq? grob (car (reverse siblings))))
-              (car (reverse bounds))
-              (car (reverse all-cols))))
-         (elts-L (ly:grob-array->list (ly:grob-object left-bound 'elements)))
-         (elts-R (ly:grob-array->list (ly:grob-object right-bound 'elements)))
-         (break-alignment-L
-          (filter
-           (lambda (elt) (grob::has-interface elt 'break-alignment-interface))
-           elts-L))
-         (break-alignment-R
-          (filter
-           (lambda (elt) (grob::has-interface elt 'break-alignment-interface))
-           elts-R))
-         (break-alignment-L-ext (ly:grob-extent (car break-alignment-L) refp X))
-         (break-alignment-R-ext (ly:grob-extent (car break-alignment-R) refp X))
-         (num (markup (number->string (ly:grob-property grob 'count-from))))
-         (num
-          (if (or (null? siblings)
-                  (eq? grob (car siblings)))
-              num
-              (make-parenthesize-markup num)))
-         (num (grob-interpret-markup grob num))
-         (num (ly:stencil-aligned-to num X (ly:grob-property grob 'self-alignment-X)))
-         (num
-          (ly:stencil-translate-axis
-           num
-           (+ (interval-length break-alignment-L-ext)
-              (* 0.5
-                 (- (car break-alignment-R-ext)
-                    (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)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; \magnifyMusic and \magnifyStaff
+
+;; defined as a function instead of a list because the
+;; all-grob-descriptions alist is not available yet
+(define-public (find-named-props prop-name grob-descriptions)
+  "Used by @code{\\magnifyMusic} and @code{\\magnifyStaff}.  When
+@var{grob-descriptions} is equal to the @code{all-grob-descriptions}
+alist (defined in @file{scm/define-grobs.scm}), this will find all grobs
+that can have a value for the @var{prop-name} property, and return them
+as a list in the following format:
+@example
+'((grob prop-name)
+  (grob prop-name)
+  ...)
+@end example"
+  (define (find-grobs-with-interface interface grob-descriptions)
+    (define (has-this-interface? grob-desc)
+      (let* ((meta (ly:assoc-get 'meta (cdr grob-desc)))
+             (interfaces (ly:assoc-get 'interfaces meta '())))
+        (memq interface interfaces)))
+    (let* ((grob-descriptions-with-this-interface
+             (filter has-this-interface? grob-descriptions))
+           (grob-names-with-this-interface
+             (map car grob-descriptions-with-this-interface)))
+      grob-names-with-this-interface))
+  (let* ((interface
+           (case prop-name
+             ((baseline-skip word-space) 'text-interface)
+             ((space-alist)              'break-aligned-interface)
+             (else (ly:programming-error
+                     "find-named-props: no interface associated with ~s"
+                     prop-name))))
+         (grobs-with-this-prop
+           (find-grobs-with-interface interface grob-descriptions)))
+    (map (lambda (x) (list x prop-name))
+         grobs-with-this-prop)))
+
+
+(define (magnifyStaff-is-set? context mag)
+  (let* ((Staff (ly:context-find context 'Staff))
+         (old-mag (ly:context-property Staff 'magnifyStaffValue)))
+    (not (null? old-mag))))
+
+(define (staff-magnification-is-changing? context mag)
+  (let* ((Staff (ly:context-find context 'Staff))
+         (old-mag (ly:context-property Staff 'magnifyStaffValue 1)))
+    (not (= old-mag mag))))
+
+(define-public (scale-fontSize func-name mag)
+  "Used by @code{\\magnifyMusic} and @code{\\magnifyStaff}.  Look up the
+current @code{fontSize} in the appropriate context and scale it by the
+magnification factor @var{mag}.  @var{func-name} is either
+@code{'magnifyMusic} or @code{'magnifyStaff}."
+  (make-apply-context
+    (lambda (context)
+      (if (or (eq? func-name 'magnifyMusic)
+              ;; for \magnifyStaff, only scale the fontSize
+              ;; if staff magnification is changing
+              ;; and does not equal 1
+              (and (staff-magnification-is-changing? context mag)
+                   (not (= mag 1))))
+        (let* ((where (case func-name
+                        ((magnifyMusic) context)
+                        ((magnifyStaff) (ly:context-find context 'Staff))))
+               (fontSize (ly:context-property where 'fontSize 0))
+               (new-fontSize (+ fontSize (magnification->font-size mag))))
+          (ly:context-set-property! where 'fontSize new-fontSize))))))
+
+(define-public (revert-fontSize func-name mag)
+  "Used by @code{\\magnifyMusic} and @code{\\magnifyStaff}.  Calculate
+the previous @code{fontSize} value (before scaling) by factoring out the
+magnification factor @var{mag} (if @var{func-name} is
+@code{'magnifyMusic}), or by factoring out the context property
+@code{magnifyStaffValue} (if @var{func-name} is @code{'magnifyStaff}).
+Revert the @code{fontSize} in the appropriate context accordingly.
+
+With @code{\\magnifyMusic}, the scaling is reverted after the music
+block it operates on.  @code{\\magnifyStaff} does not operate on a music
+block, so the scaling from a previous call (if there is one) is reverted
+before the new scaling takes effect."
+  (make-apply-context
+    (lambda (context)
+      (if (or (eq? func-name 'magnifyMusic)
+              ;; for \magnifyStaff...
+              (and
+                ;; don't revert the user's fontSize choice
+                ;; the first time \magnifyStaff is called
+                (magnifyStaff-is-set? context mag)
+                ;; only revert the previous fontSize
+                ;; if staff magnification is changing
+                (staff-magnification-is-changing? context mag)))
+        (let* ((where
+                 (case func-name
+                   ((magnifyMusic) context)
+                   ((magnifyStaff) (ly:context-find context 'Staff))))
+               (old-mag
+                 (case func-name
+                   ((magnifyMusic) mag)
+                   ((magnifyStaff)
+                    (ly:context-property where 'magnifyStaffValue 1))))
+               (fontSize (ly:context-property where 'fontSize 0))
+               (old-fontSize (- fontSize (magnification->font-size old-mag))))
+          (ly:context-set-property! where 'fontSize old-fontSize))))))
+
+(define-public (scale-props func-name mag allowed-to-shrink? props)
+  "Used by @code{\\magnifyMusic} and @code{\\magnifyStaff}.  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 in the appropriate
+context.  If @var{allowed-to-shrink?} is @code{#f}, don't let the new
+value be less than the current value.  @var{func-name} is either
+@code{'magnifyMusic} or @code{'magnifyStaff}.  The @var{props} list is
+formatted like:
+@example
+'((Stem thickness)
+  (Slur line-thickness)
+  ...)
+@end example"
+  (make-apply-context
+    (lambda (context)
+      (define (scale-prop grob-prop-list)
+        (let* ((grob (car grob-prop-list))
+               (prop (cadr grob-prop-list))
+               (where (if (eq? grob 'SpacingSpanner)
+                        (ly:context-find context 'Score)
+                        (case func-name
+                          ((magnifyMusic) context)
+                          ((magnifyStaff) (ly:context-find context 'Staff)))))
+               (grob-def (ly:context-grob-definition where grob)))
+          (if (eq? prop 'space-alist)
+            (let* ((space-alist (ly:assoc-get prop grob-def))
+                   (scale-spacing-tuple (lambda (x)
+                                          (cons (car x)
+                                                (cons (cadr x)
+                                                      (* mag (cddr x))))))
+                   (scaled-tuples (if space-alist
+                                      (map scale-spacing-tuple space-alist)
+                                      '()))
+                   (new-alist (append scaled-tuples space-alist)))
+              (ly:context-pushpop-property where grob prop new-alist))
+            (let* ((val (ly:assoc-get prop grob-def (case prop
+                                                      ((baseline-skip) 3)
+                                                      ((word-space)    0.6)
+                                                      (else            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)))))
+      (if (or (eq? func-name 'magnifyMusic)
+              ;; for \magnifyStaff, only scale the properties
+              ;; if staff magnification is changing
+              ;; and does not equal 1
+              (and (staff-magnification-is-changing? context mag)
+                   (not (= mag 1))))
+        (for-each scale-prop props)))))
+
+(define-public (revert-props func-name mag props)
+  "Used by @code{\\magnifyMusic} and @code{\\magnifyStaff}.  Revert each
+prop in @var{props} in the appropriate context.  @var{func-name} is
+either @code{'magnifyMusic} or @code{'magnifyStaff}.  The @var{props}
+list is formatted like:
+@example
+'((Stem thickness)
+  (Slur line-thickness)
+  ...)
+@end example"
+  (make-apply-context
+    (lambda (context)
+      (define (revert-prop grob-prop-list)
+        (let* ((grob (car grob-prop-list))
+               (prop (cadr grob-prop-list))
+               (where (if (eq? grob 'SpacingSpanner)
+                        (ly:context-find context 'Score)
+                        (case func-name
+                          ((magnifyMusic) context)
+                          ((magnifyStaff) (ly:context-find context 'Staff))))))
+          (ly:context-pushpop-property where grob prop)))
+      (if (or (eq? func-name 'magnifyMusic)
+              ;; for \magnifyStaff...
+              (and
+                ;; don't revert the user's property overrides
+                ;; the first time \magnifyStaff is called
+                (magnifyStaff-is-set? context mag)
+                ;; revert the overrides from the previous \magnifyStaff,
+                ;; but only if staff magnification is changing
+                (staff-magnification-is-changing? context mag)))
+        (for-each revert-prop props)))))
+
+;; \magnifyMusic only
+(define-public (scale-beam-thickness mag)
+  "Used by @code{\\magnifyMusic}.  Scaling @code{Beam.beam-thickness}
+exactly to the @var{mag} value will not 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)))))
+
+;; tag management
+;;
+
+(define tag-groups (make-hash-table))
+(call-after-session (lambda () (hash-clear! tag-groups)))
+
+(define-public (define-tag-group tags)
+  "Define a tag-group consisting of the given @var{tags}, a@tie{}list
+of symbols.  Returns @code{#f} if successful, and an error message if
+there is a conflicting tag group definition."
+  (cond ((not (symbol-list? tags)) (format #f (_ "not a symbol list: ~a") tags))
+        ((any (lambda (tag) (hashq-ref tag-groups tag)) tags)
+         => (lambda (group) (and (not (lset= eq? group tags))
+                                 (format #f (_ "conflicting tag group ~a") group))))
+        (else
+         (for-each
+          (lambda (elt) (hashq-set! tag-groups elt tags))
+          tags)
+         #f)))
+
+(define-public (tag-group-get tag)
+  "Return the tag group (as a list of symbols) that the given
+@var{tag} symbol belongs to, @code{#f} if none."
+  (hashq-ref tag-groups tag))
+
+(define-public (tags-remove-predicate tags)
+  "Returns a predicate that returns @code{#f} for any music that is to
+be removed by @{\\removeWithTag} on the given symbol or list of
+symbols @var{tags}."
+  (if (symbol? tags)
+      (lambda (m)
+        (not (memq tags (ly:music-property m 'tags))))
+      (lambda (m)
+        (not (any (lambda (t) (memq t tags))
+                  (ly:music-property m 'tags))))))
+
+(define-public (tags-keep-predicate tags)
+  "Returns a predicate that returns @code{#f} for any music that is to
+be removed by @{\\keepWithTag} on the given symbol or list of symbols
+@var{tags}."
+  (if (symbol? tags)
+      (let ((group (tag-group-get tags)))
+        (lambda (m)
+          (let ((music-tags (ly:music-property m 'tags)))
+            (or
+             (null? music-tags) ; redundant but very frequent
+             ;; We know of only one tag to keep.  Either we find it in
+             ;; the music tags, or all music tags must be from a
+             ;; different group
+             (memq tags music-tags)
+             (not (any (lambda (t) (eq? (tag-group-get t) group)) music-tags))))))
+      (let ((groups (delete-duplicates (map tag-group-get tags) eq?)))
+        (lambda (m)
+          (let ((music-tags (ly:music-property m 'tags)))
+            (or
+             (null? music-tags) ; redundant but very frequent
+             (any (lambda (t) (memq t tags)) music-tags)
+             ;; if no tag matches, no tag group should match either
+             (not (any (lambda (t) (memq (tag-group-get t) groups)) music-tags))))))))