X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=2638e9997952bb75899a7148f9bc752e30553d63;hb=730d4eb3e0328e8ba0b376f8191a5bb6ae7f904c;hp=c77c1dc6fbbff36e50caec2fac3acf04e81ec988;hpb=40aac0ae57ee113faa860ba221d83d9e6312173e;p=lilypond.git

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index c77c1dc6fb..2638e99979 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -158,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))
@@ -173,20 +175,28 @@ equivalent to @var{obj}, that is, for a music expression, a
                                  (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))
@@ -896,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)
@@ -1055,10 +1067,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."
@@ -1109,10 +1117,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."
 
@@ -1133,10 +1137,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."
@@ -1165,10 +1165,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."
 
@@ -1219,7 +1215,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))))
@@ -1233,6 +1229,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)
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1419,22 +1416,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))
@@ -1442,17 +1442,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))
@@ -1484,7 +1484,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))
@@ -1494,7 +1494,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.
 
@@ -1511,10 +1511,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.
@@ -1528,25 +1536,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
@@ -1556,7 +1564,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."
@@ -1579,7 +1588,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)
@@ -1592,31 +1601,39 @@ look at bar lines nor different accidentals at the same note name."
                             (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)))
+  "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)))
-           (cons #f
-             (not
-              (and (equal? entrybn barnum) (equal? entrymp measurepos))))))))
+         (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
@@ -1720,10 +1737,17 @@ as a context."
      ;; 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))
+                                  `(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.
@@ -1779,8 +1803,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
@@ -1805,15 +1829,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)))
@@ -1829,7 +1853,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)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -2192,7 +2216,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))
@@ -2208,6 +2232,7 @@ of list @var{arg}."
     (if (>= (length siblings) 2)
         (helper siblings arg)
         (car arg))))
+(export value-for-spanner-piece)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; measure counter
@@ -2361,3 +2386,193 @@ Offsets are restricted to immutable properties and values of type @code{number},
                 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-all-space-alist-props grob-descriptions)
+  "Used by @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 have an
+initialized value for the @code{space-alist} property, and return them
+as a list in the following format:
+@example
+'((Ambitus space-alist)
+  (BarLine space-alist)
+  ...)
+@end example"
+  (define (has-space-alist? grob-desc)
+    (ly:assoc-get 'space-alist (cdr grob-desc)))
+  (let* ((grob-descriptions-with-space-alist
+           (filter has-space-alist? grob-descriptions))
+         (grob-names-with-space-alist
+           (map car grob-descriptions-with-space-alist)))
+    (map (lambda (grob-name) (list grob-name 'space-alist))
+         grob-names-with-space-alist)))
+
+(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
+              (staff-magnification-is-changing? context mag))
+        (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 (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 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
+              (staff-magnification-is-changing? context mag))
+        (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)))))