X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=4a97c1c664f635417366382c51e42891ab209228;hb=5e7ba357ed642cad2e07f53d8c27d96128fe7dab;hp=791547706f4e8f6faf302bbd0e46a72a5dcb575b;hpb=49adeb064850d230ef3f1163aa29cfa5930f996e;p=lilypond.git

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 791547706f..4a97c1c664 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -1067,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."
@@ -1121,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."
 
@@ -1145,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."
@@ -1177,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."
 
@@ -1580,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."
@@ -1620,15 +1605,19 @@ look at bar lines nor different accidentals at the same note name."
 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)))
+   (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
@@ -1748,10 +1737,9 @@ 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)
@@ -2400,37 +2388,124 @@ Offsets are restricted to immutable properties and values of type @code{number},
     self)
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; The following are used by \magnifyMusic
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; \magnifyMusic and \magnifyStaff
 
-(define-public (scale-fontSize mag)
-  "Used by @code{\\magnifyMusic}.  Look up the current fontSize and
-scale it by the magnification factor @var{mag}."
+;; 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)
-      (let* ((fontSize (ly:context-property context 'fontSize 0))
-             (new-fontSize (+ fontSize (magnification->font-size mag))))
-        (ly:context-set-property! context 'fontSize new-fontSize)))))
-
-(define-public (revert-fontSize mag)
-  "Used by @code{\\magnifyMusic}.  Calculate the previous fontSize value
-(before scaling) by factoring out the magnification factor @var{mag}."
+      (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)
-      (let* ((fontSize (ly:context-property context 'fontSize 0))
-             (old-fontSize (- fontSize (magnification->font-size mag))))
-        (ly:context-set-property! context 'fontSize old-fontSize)))))
-
-(define-public (scale-props props mag allowed-to-shrink?)
-  "Used by @code{\\magnifyMusic}.  For each prop in @var{props}, find
-the current value of the requested prop, scale it by the magnification
-factor @var{mag}, and do the equivalent of a
-@code{\\temporary@tie{}\\override} with the new value.  If
-@code{allowed-to-shrink?} is @code{#f}, don't let the new value be less
-than the current value.  Props are formatted like:
-
+      (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
-'(Slur height-limit)
+'((Stem thickness)
+  (Slur line-thickness)
+  ...)
 @end example"
   (make-apply-context
     (lambda (context)
@@ -2439,23 +2514,78 @@ than the current value.  Props are formatted like:
                (prop (cadr grob-prop-list))
                (where (if (eq? grob 'SpacingSpanner)
                         (ly:context-find context 'Score)
-                        context))
-               (grob-def (ly:context-grob-definition where grob))
-               (val (ly:assoc-get prop grob-def 1))
-               (proc (lambda (x)
-                       (if allowed-to-shrink?
-                         (* x mag)
-                         (* x (max 1 mag)))))
-               (new-val (if (number-pair? val)
-                          (cons (proc (car val))
-                                (proc (cdr val)))
-                          (proc val))))
-          (ly:context-pushpop-property where grob prop new-val)))
-      (for-each scale-prop props))))
-
+                        (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 won't work.  This uses two reference
+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."
@@ -2469,21 +2599,3 @@ scaling, then does the equivalent of a
              (scaled-default (+ 119/925 (* mag 13/37)))
              (new-val (* scaled-default ratio-to-default)))
         (ly:context-pushpop-property context 'Beam 'beam-thickness new-val)))))
-
-(define-public (revert-props props)
-  "Used by @code{\\magnifyMusic}.  Revert each prop in @var{props}.
-Props are formatted like:
-
-@example
-'(Slur height-limit)
-@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)
-                        context)))
-            (ly:context-pushpop-property where grob prop)))
-      (for-each revert-prop props))))