]> git.donarmstrong.com Git - lilypond.git/blobdiff - ly/music-functions-init.ly
Let \autochange accept optional arguments for the turning-point and clefs
[lilypond.git] / ly / music-functions-init.ly
index 475c2cec906692fd7f6f3d0c13118372400c598a..045262c0498c3cb1b1a42d84a970dda79f181fe0 100644 (file)
@@ -18,7 +18,7 @@
 %%%% You should have received a copy of the GNU General Public License
 %%%% along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
 
-\version "2.19.22"
+\version "2.19.25"
 
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -119,7 +119,7 @@ form of a spanner event, @var{property} may also have the form
                  (member 'spanner-interface
                          (assoc-get 'interfaces
                                     (assoc-get 'meta description))))
-            (override (append item (if (symbol? property)
+            (propertyOverride (append item (if (symbol? property)
                                        (list property)
                                        property))
                       (value-for-spanner-piece arg))
@@ -152,11 +152,18 @@ applyMusic =
    (func music))
 
 applyOutput =
-#(define-music-function (ctx proc) (symbol? procedure?)
-   (_i "Apply function @code{proc} to every layout object in context @code{ctx}")
-   (make-music 'ApplyOutputEvent
-               'procedure proc
-               'context-type ctx))
+#(define-music-function (target proc) (symbol-list-or-symbol? procedure?)
+   (_i "Apply function @code{proc} to every layout object matched by
+@var{target} which takes the form @code{Context} or @code{Context.Grob}.")
+   (let ((p (check-grob-path target (*location*) #:max 2)))
+     (if p
+         (make-music 'ApplyOutputEvent
+                     'procedure proc
+                     'context-type (car p)
+                     (if (pair? (cdr p))
+                         (list (cons 'symbol (cadr p)))
+                         '()))
+         (make-music 'Music))))
 
 appoggiatura =
 #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic
@@ -175,11 +182,26 @@ assertBeamSlope =
    (make-grob-property-override 'Beam 'positions (check-slope-callbacks comp)))
 
 autochange =
-#(define-music-function (music) (ly:music?)
-   (_i "Make voices that switch between staves automatically")
-   (make-autochange-music music))
-
-
+#(define-music-function (pitch clef-1 clef-2 music)
+  ((ly:pitch? (ly:make-pitch 0 0)) (ly:context-mod?)(ly:context-mod?) ly:music?)
+  (_i "Make voices that switch between staves automatically.  As an option the
+pitch where to switch staves may be specified.  The clefs for the staves are
+optional as well.  Setting clefs  works only for implicitly instantiated
+staves.")
+  (let ;; keep the contexts alive for the full duration
+       ((skip (make-skip-music (make-duration-of-length
+                                     (ly:music-length music)))))
+    #{
+      <<
+        \context Staff = "up" $(or clef-1 #{ \with { \clef "treble" } #})
+          <<
+          #(make-autochange-music pitch music)
+          \new Voice { #skip }
+          >>
+        \context Staff = "down" $(or clef-2 #{ \with { \clef "bass" } #})
+          \new Voice { #skip }
+      >>
+    #}))
 
 balloonGrobText =
 #(define-music-function (grob-name offset text)
@@ -808,7 +830,7 @@ transpose from @var{around} to @var{to}.")
 
 mark =
 #(define-music-function
-   (label) ((scheme? '()))
+   (label) ((number-or-markup?))
   "Make the music for the \\mark command."
   (let* ((set (and (integer? label)
                    (context-spec-music (make-property-set 'rehearsalMark label)
@@ -819,7 +841,7 @@ mark =
     (if set
         (make-sequential-music (list set ev))
         (begin
-          (set! (ly:music-property ev 'label) label)
+          (if label (set! (ly:music-property ev 'label) label))
           ev))))
 
 musicMap =
@@ -890,7 +912,7 @@ appropriate tweak applied.")
                                      property)) (*location*)
                          #:default 'Bottom #:min 3 #:max 3)))
         (if prop-path
-            (override prop-path (offsetter (third prop-path) offsets))
+            (propertyOverride prop-path (offsetter (third prop-path) offsets))
             (make-music 'Music)))))
 
 omit =
@@ -931,33 +953,6 @@ ottava =
    (make-music 'OttavaMusic
                'ottava-number octave))
 
-#(ly:expect-warning
-  (ly:translate-cpp-warning-scheme "identifier name is a keyword: `%s'")
-  "override")
-override =
-#(define-music-function (grob-property-path value)
-   (symbol-list? scheme?)
-   (_i "Set the grob property specified by @var{grob-property-path} to
-@var{value}.  @var{grob-property-path} is a symbol list of the form
-@code{Context.GrobName.property} or @code{GrobName.property}, possibly
-with subproperties given as well.  Because @code{\\override} is a
-reserved word with special syntax in LilyPond input, this music
-function will generally only be accessible from Scheme.")
-   (let ((p (check-grob-path grob-property-path (*parser*) (*location*)
-                             #:default 'Bottom
-                             #:min 3)))
-     (if p
-         (context-spec-music
-          (make-music 'OverrideProperty
-                      'symbol (cadr p)
-                      'origin (*location*)
-                      'grob-value value
-                      'grob-property-path (cddr p)
-                      'pop-first #t)
-          (car p))
-         (make-music 'Music))))
-
-
 overrideTimeSignatureSettings =
 #(define-music-function
    (time-signature base-moment beat-structure beam-exceptions)
@@ -1147,18 +1142,17 @@ change to the following voice."
        (and (or split-elt split-elts)
             (map
              (lambda (e es)
-               (apply music-clone music
-                      (append
-                       ;; reassigning the origin of the parent only
-                       ;; makes sense if the first expression in the
-                       ;; result is from a distributed origin
-                       (let ((origin
-                              (if (ly:music? elt)
-                                  (and (ly:music? e) (ly:music-property e 'origin #f))
-                                  (and (pair? es) (ly:music-property (car es) 'origin #f)))))
-                         (if origin (list 'origin origin) '()))
-                       (if (ly:music? e) (list 'element e) '())
-                       (if (pair? es) (list 'elements es) '()))))
+               (let ((m (ly:music-deep-copy music
+                       ;;; reassigning the origin of the parent only
+                       ;;; makes sense if the first expression in the
+                       ;;; result is from a distributed origin
+                                            (or (and (ly:music? e) e)
+                                                (and (pair? es) (car es))))))
+                 (if (ly:music? e)
+                     (set! (ly:music-property m 'element) e))
+                 (if (pair? es)
+                     (set! (ly:music-property m 'elements) es))
+                 m))
              (or split-elt (circular-list #f))
              (or split-elts (circular-list #f))))))
    (let ((voices (recurse-and-split music)))
@@ -1193,12 +1187,42 @@ parenthesize =
           two-context-settings
           shared-context-settings)
 
-   (let* ((pc-music (make-part-combine-music (list part1 part2) direction chord-range))
+   (let* ((pc-music (make-music 'PartCombineMusic))
+          (m1 (context-spec-music (make-non-relative-music part1) 'Voice "one"))
+          (m2 (context-spec-music (make-non-relative-music part2) 'Voice "two"))
+          (listener (ly:parser-lookup 'partCombineListener))
+          (evs2 (recording-group-emulate m2 listener))
+          (evs1 (recording-group-emulate m1 listener))
+          (split-list
+           (if (and (assoc "one" evs1) (assoc "two" evs2))
+               (determine-split-list (reverse! (assoc-get "one" evs1) '())
+                                     (reverse! (assoc-get "two" evs2) '())
+                                     chord-range)
+               '()))
           (L1 (ly:music-length part1))
           (L2 (ly:music-length part2))
           ;; keep the contexts alive for the full duration
           (skip (make-skip-music (make-duration-of-length
                                   (if (ly:moment<? L1 L2) L2 L1)))))
+
+     (set! (ly:music-property pc-music 'elements)
+           (list (make-music
+                  'PartCombinePartMusic
+                  'element m1
+                  'context-change-list
+                  (make-part-combine-context-changes
+                   default-part-combine-context-change-state-machine-one
+                   split-list))
+                 (make-music
+                  'PartCombinePartMusic
+                  'element m2
+                  'context-change-list
+                  (make-part-combine-context-changes
+                   default-part-combine-context-change-state-machine-two
+                   split-list))))
+
+     (set! (ly:music-property pc-music 'direction) direction)
+
      #{ \context Staff <<
           \context Voice = "one" \with #one-context-settings { #skip }
           \context Voice = "two" \with #two-context-settings { #skip }
@@ -1207,8 +1231,7 @@ parenthesize =
           \context NullVoice = "null" { #skip }
           #pc-music
           #(make-part-combine-marks
-            default-part-combine-mark-state-machine
-            (ly:music-property pc-music 'split-list))
+            default-part-combine-mark-state-machine split-list)
         >> #} ))
 
 partcombine =
@@ -1305,6 +1328,81 @@ print @var{secondary-note} as a stemless note head in parentheses.")
                            trill-events)))))
      main-note))
 
+propertyOverride =
+#(define-music-function (grob-property-path value)
+   (symbol-list? scheme?)
+   (_i "Set the grob property specified by @var{grob-property-path} to
+@var{value}.  @var{grob-property-path} is a symbol list of the form
+@code{Context.GrobName.property} or @code{GrobName.property}, possibly
+with subproperties given as well.  This music function is mostly intended
+for use from Scheme as a substitute for the built-in @code{\\override}
+command.")
+   (let ((p (check-grob-path grob-property-path (*location*)
+                             #:default 'Bottom
+                             #:min 3)))
+     (if p
+         (context-spec-music
+          (make-music 'OverrideProperty
+                      'symbol (cadr p)
+                      'origin (*location*)
+                      'grob-value value
+                      'grob-property-path (cddr p)
+                      'pop-first #t)
+          (car p))
+         (make-music 'Music))))
+
+propertyRevert =
+#(define-music-function (grob-property-path)
+   (symbol-list?)
+   (_i "Revert the grob property specified by @var{grob-property-path} to
+its previous value.  @var{grob-property-path} is a symbol list of the form
+@code{Context.GrobName.property} or @code{GrobName.property}, possibly
+with subproperties given as well.  This music function is mostly intended
+for use from Scheme as a substitute for the built-in @code{\\revert}
+command.")
+   (let ((p (check-grob-path grob-property-path (*location*)
+                             #:default 'Bottom
+                             #:min 3)))
+     (if p
+         (context-spec-music
+          (make-music 'RevertProperty
+                      'symbol (cadr p)
+                      'origin (*location*)
+                      'grob-property-path (cddr p))
+          (car p))
+         (make-music 'Music))))
+
+propertySet =
+#(define-music-function (property-path value)
+   (symbol-list-or-symbol? scheme?)
+   (_i "Set the context property specified by @var{property-path} to
+@var{value}.  This music function is mostly intended for use from
+Scheme as a substitute for the built-in @code{\\set} command.")
+   (let ((p (check-context-path property-path (*location*))))
+     (if p
+         (context-spec-music
+          (make-music 'PropertySet
+                      'symbol (cadr p)
+                      'value value
+                      'origin (*location*))
+          (car p))
+         (make-music 'Music))))
+
+propertyUnset =
+#(define-music-function (property-path)
+   (symbol-list-or-symbol?)
+   (_i "Unset the context property specified by @var{property-path}.
+This music function is mostly intended for use from Scheme as a
+substitute for the built-in @code{\\unset} command.")
+   (let ((p (check-context-path property-path (*location*))))
+     (if p
+         (context-spec-music
+          (make-music 'PropertyUnset
+                      'symbol (cadr p)
+                      'origin (*location*))
+          (car p))
+         (make-music 'Music))))
+
 pushToTag =
 #(define-music-function (tag more music)
    (symbol? ly:music? ly:music?)
@@ -1327,30 +1425,6 @@ usually contains spacers or multi-measure rests.")
                'element main-music
                'quoted-music-name what))
 
-#(ly:expect-warning
-  (ly:translate-cpp-warning-scheme "identifier name is a keyword: `%s'")
-  "revert")
-revert =
-#(define-music-function (grob-property-path)
-   (symbol-list?)
-   (_i "Revert the grob property specified by @var{grob-property-path} to
-its previous value.  @var{grob-property-path} is a symbol list of the form
-@code{Context.GrobName.property} or @code{GrobName.property}, possibly
-with subproperties given as well.  Because @code{\\revert} is a
-reserved word with special syntax in LilyPond input, this music
-function will generally only be accessible from Scheme.")
-   (let ((p (check-grob-path grob-property-path (*parser*) (*location*)
-                             #:default 'Bottom
-                             #:min 3)))
-     (if p
-         (context-spec-music
-          (make-music 'RevertProperty
-                      'symbol (cadr p)
-                      'origin (*location*)
-                      'grob-property-path (cddr p))
-          (car p))
-         (make-music 'Music))))
-
 
 relative =
 #(define-music-function (pitch music)
@@ -1761,16 +1835,55 @@ property (inside of an alist) is tweaked.")
                                  #:start 1
                                  #:default #t
                                  #:min 2)))
-         (if p
-             (set! (ly:music-property item 'tweaks)
-                   (acons (cond ((pair? (cddr p)) p)
-                                ((symbol? (car p))
-                                 (cons (car p) (cadr p)))
-                                (else (cadr p)))
-                          value
-                          (ly:music-property item 'tweaks))))
+         (cond ((not p))
+               ;; p now contains at least two elements.  The first
+               ;; element is #t when no grob has been explicitly
+               ;; specified, otherwise it is a grob name.
+               ((music-is-of-type? item 'context-specification)
+                ;; This is essentially dealing with the case
+                ;; \tweak color #red \tweak font-size #3 NoteHead
+                ;; namely when stacked tweaks end in a symbol list
+                ;; rather than a music expression.
+                ;;
+                ;; We have a tweak here to convert into an override,
+                ;; so we need to know the grob to apply it to.  That's
+                ;; easy if we have a directed tweak, and otherwise we
+                ;; need to find the symbol in the expression itself.
+                (let* ((elt (ly:music-property item 'element))
+                       (seq (if (music-is-of-type? elt 'sequential-music)
+                                elt
+                                (make-sequential-music (list elt))))
+                       (elts (ly:music-property seq 'elements))
+                       (symbol (if (symbol? (car p))
+                                   (car p)
+                                   (and (pair? elts)
+                                        (ly:music-property (car elts)
+                                                           'symbol)))))
+                  (if (symbol? symbol)
+                      (begin
+                        (set! (ly:music-property seq 'elements)
+                              (cons (make-music 'OverrideProperty
+                                                'symbol symbol
+                                                'grob-property-path (cdr p)
+                                                'pop-first #t
+                                                'grob-value value
+                                                'origin (*location*))
+                                    elts))
+                        (set! (ly:music-property item 'element) seq))
+                      (begin
+                        (ly:parser-error (_ "Cannot \\tweak")
+                                         (*location*))
+                        (ly:music-message item (_ "untweakable"))))))
+               (else
+                (set! (ly:music-property item 'tweaks)
+                      (acons (cond ((pair? (cddr p)) p)
+                                   ((symbol? (car p))
+                                    (cons (car p) (cadr p)))
+                                   (else (cadr p)))
+                             value
+                             (ly:music-property item 'tweaks)))))
          item)
-       (override (append item (if (symbol? prop) (list prop) prop)) value)))
+       (propertyOverride (append item (if (symbol? prop) (list prop) prop)) value)))
 
 undo =
 #(define-music-function (music)
@@ -1784,10 +1897,10 @@ unsets already in @var{music} cause a warning.  Non-property-related music is ig
      (let
          ((lst
            (fold-some-music
-            (lambda (m) (or (music-is-of-type? m 'layout-instruction-event)
-                            (music-is-of-type? m 'context-specification)
-                            (music-is-of-type? m 'apply-context)
-                            (music-is-of-type? m 'time-signature-music)))
+            (music-type-predicate '(layout-instruction-event
+                                    context-specification
+                                    apply-context
+                                    time-signature-music))
             (lambda (m overrides)
               (case (ly:music-property m 'name)
                 ((OverrideProperty)