X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=ly%2Fmusic-functions-init.ly;h=f41fc6e7a007db21d28e355269a6685962b77d16;hb=07328e4a7271fb2553823c42fbe60a8c6613cafa;hp=54ada96164a7e6697b5a79fd74885de2d0500dcb;hpb=26a04c1f923f384d3a36c571bb3ebcdb1aabda9b;p=lilypond.git

diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly
index 54ada96164..f41fc6e7a0 100644
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -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.15.18"
+\version "2.16.0"
 
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -36,7 +36,7 @@ acciaccatura =
    (_i "Create an acciaccatura from the following music expression"))
 
 %% keep these two together
-"instrument-definitions" = #'()
+instrument-definitions = #'()
 addInstrumentDefinition =
 #(define-void-function
    (parser location name lst) (string? list?)
@@ -85,6 +85,37 @@ markups), or inside a score.")
 	       'elements (list (make-music 'PageTurnEvent
 					   'break-permission 'allow))))
 
+alterBroken =
+#(define-music-function (parser location name property arg)
+  (string? scheme? list?)
+  (_i "Override @var{property} for pieces of broken spanner @var{name} with
+values @var{arg}.")
+  (let* ((name (string-delete name char-set:blank)) ; remove any spaces
+         (name-components (string-split name #\.))
+         (context-name "Bottom")
+         (grob-name #f))
+
+    (if (> 2 (length name-components))
+        (set! grob-name (car name-components))
+        (begin
+          (set! grob-name (cadr name-components))
+          (set! context-name (car name-components))))
+
+    ;; only apply override if grob is a spanner
+    (let ((description
+            (assoc-get (string->symbol grob-name) all-grob-descriptions)))
+      (if (and description
+               (member 'spanner-interface
+                       (assoc-get 'interfaces
+                                  (assoc-get 'meta description))))
+          #{
+            \override $context-name . $grob-name $property =
+              #(value-for-spanner-piece arg)
+          #}
+          (begin
+            (ly:input-warning location (_ "not a spanner name, `~a'") grob-name)
+            (make-music 'SequentialMusic 'void #t))))))
+
 appendToTag =
 #(define-music-function (parser location tag more music)
    (symbol? ly:music? ly:music?)
@@ -304,27 +335,22 @@ endSpanners =
 #(define-music-function (parser location music) (ly:music?)
    (_i "Terminate the next spanner prematurely after exactly one note
 without the need of a specific end spanner.")
-   (if (memq (ly:music-property music 'name) '(EventChord NoteEvent))
-       (let* ((start-span-evs (filter (lambda (ev)
-					(equal? (ly:music-property ev 'span-direction)
-						START))
-				      (extract-typed-music music 'span-event)))
-	      (stop-span-evs
-	       (map (lambda (m)
-		      (let ((c (music-clone m)))
-			(set! (ly:music-property c 'span-direction) STOP)
-			c))
-		    start-span-evs))
-	      (end-ev-chord (make-music 'EventChord
-					'elements stop-span-evs))
-	      (total (make-music 'SequentialMusic
-				 'elements (list music
-						 end-ev-chord))))
-	 total)
-
-       (begin
-	 (ly:input-message location (_ "argument endSpanners is not an EventChord: ~a") music)
-	 music)))
+   (let* ((start-span-evs (filter (lambda (ev)
+				    (equal? (ly:music-property ev 'span-direction)
+					    START))
+				  (extract-typed-music music 'span-event)))
+	  (stop-span-evs
+	   (map (lambda (m)
+		  (let ((c (music-clone m)))
+		    (set! (ly:music-property c 'span-direction) STOP)
+		    c))
+		start-span-evs))
+	  (end-ev-chord (make-music 'EventChord
+				    'elements stop-span-evs))
+	  (total (make-music 'SequentialMusic
+			     'elements (list music
+					     end-ev-chord))))
+     total))
 
 eventChords =
 #(define-music-function (parser location music) (ly:music?)
@@ -449,6 +475,31 @@ given through @var{ratio}.")
     \revert NoteHead #'stencil
   #})
 
+hide =
+#(define-music-function (parser location item) (string-or-music?)
+   (_i "Set @var{item}'s @samp{transparent} property to @code{#t},
+making it invisible while still retaining its dimensions.
+
+If @var{item} is a string, the result is an override for the grob name
+specified by it.  If @var{item} is a music expression, the result is
+the same music expression with an appropriate tweak applied to it.")
+   (if (string? item)
+       #{ \override $item #'transparent = ##t #}
+       #{ \tweak #'transparent ##t $item #}))
+
+inStaffSegno =
+#(define-music-function (parser location) ()
+   (_i "Put the segno variant 'varsegno' at this position into the staff,
+compatible with the repeat command.")
+   (make-music 'ApplyContext
+               'procedure
+               (lambda (ctx)
+                 (let ((score-ctx (ly:context-find ctx 'Score)))
+                   (if (ly:context? score-ctx)
+                     (let ((old-rc (ly:context-property score-ctx 'repeatCommands '())))
+                       (if (eq? (memq 'segno-display old-rc) #f)
+                         (ly:context-set-property! score-ctx 'repeatCommands (cons 'segno-display old-rc)))))))))
+
 instrumentSwitch =
 #(define-music-function
    (parser location name) (string?)
@@ -625,6 +676,18 @@ octaveCheck =
    (make-music 'RelativeOctaveCheck
                'pitch pitch))
 
+omit =
+#(define-music-function (parser location item) (string-or-music?)
+   (_i "Set @var{item}'s @samp{stencil} property to @code{#f},
+effectively omitting it without taking up space.
+
+If @var{item} is a string, the result is an override for the grob name
+specified by it.  If @var{item} is a music expression, the result is
+the same music expression with an appropriate tweak applied to it.")
+   (if (string? item)
+       #{ \override $item #'stencil = ##f #}
+       #{ \tweak #'stencil ##f $item #}))
+
 once =
 #(define-music-function (parser location music) (ly:music?)
    (_i "Set @code{once} to @code{#t} on all layout instruction events in @var{music}.")
@@ -1028,11 +1091,17 @@ a context modification duplicating their effect.")
 	       (cons* 'push
 		      (ly:music-property m 'symbol)
 		      (ly:music-property m 'grob-value)
-		      (ly:music-property m 'grob-property-path)))
+                      (cond
+                       ((ly:music-property m 'grob-property #f) => list)
+                       (else
+                        (ly:music-property m 'grob-property-path)))))
 	      ((RevertProperty)
 	       (cons* 'pop
 		      (ly:music-property m 'symbol)
-		      (ly:music-property m 'grob-property-path)))))
+                      (cond
+                       ((ly:music-property m 'grob-property #f) => list)
+                       (else
+                        (ly:music-property m 'grob-property-path)))))))
 	   (case (ly:music-property m 'name)
 	     ((ApplyContext)
 	      (ly:add-context-mod mods
@@ -1050,12 +1119,16 @@ a context modification duplicating their effect.")
      mods))
 
 shape =
-#(define-music-function (parser location grob offsets)
-   (string? list?)
-   (_i "Offset control-points of @var{grob} by @var{offsets}.  The argument
-is a list of number pairs or list of such lists.  Each element of a pair
-represents an offset to one of the coordinates of a control-point.")
-   (define ((shape-curve offsets) grob)
+#(define-music-function (parser location offsets item)
+   (list? string-or-music?)
+   (_i "Offset control-points of @var{item} by @var{offsets}.  The
+argument is a list of number pairs or list of such lists.  Each
+element of a pair represents an offset to one of the coordinates of a
+control-point.  If @var{item} is a string, the result is
+@code{\\once\\override} for the specified grob type.  If @var{item} is
+a music expression, the result is the same music expression with an
+appropriate tweak applied.")
+   (define (shape-curve grob)
      (let* ((orig (ly:grob-original grob))
             (siblings (if (ly:spanner? grob)
                           (ly:spanner-broken-into orig) '()))
@@ -1086,10 +1159,13 @@ represents an offset to one of the coordinates of a control-point.")
        (if (>= total-found 2)
            (helper siblings offsets)
            (offset-control-points (car offsets)))))
-
-   #{
-     \once \override $grob #'control-points = #(shape-curve offsets)
-   #})
+   (if (ly:music? item)
+       #{
+         \tweak #'control-points #shape-curve $item
+       #}
+       #{
+         \once \override $item #'control-points = #shape-curve
+       #}))
 
 shiftDurations =
 #(define-music-function (parser location dur dots arg)
@@ -1101,6 +1177,31 @@ shiftDurations =
     (lambda (x)
       (shift-one-duration-log x dur dots)) arg))
 
+single =
+#(define-music-function (parser location overrides music)
+   (ly:music? ly:music?)
+   (_i "Convert @var{overrides} to tweaks and apply them to @var{music}.
+This does not convert @code{\\revert}, @code{\\set} or @code{\\unset}
+and ignores nested overrides.")
+   (set! (ly:music-property music 'tweaks)
+         (fold-some-music
+          (lambda (m) (eq? (ly:music-property m 'name)
+                           'OverrideProperty))
+          (lambda (m tweaks)
+            (let ((p (cond
+                      ((ly:music-property m 'grob-property #f) => list)
+                      (else
+                       (ly:music-property m 'grob-property-path)))))
+              (if (pair? (cdr p))
+                  tweaks ;ignore nested properties
+                  (acons (cons (ly:music-property m 'symbol) ;grob name
+                               (car p)) ;grob property
+                         (ly:music-property m 'grob-value)
+                         tweaks))))
+          (ly:music-property music 'tweaks)
+          overrides))
+   music)
+
 skip =
 #(define-music-function (parser location dur) (ly:duration?)
   (_i "Skip forward by @var{dur}.")
@@ -1126,7 +1227,7 @@ the `parameters' assoc list.")
 
 styledNoteHeads =
 #(define-music-function (parser location style heads music)
-   (symbol? list-or-symbol? ly:music?)
+   (symbol? symbol-list-or-symbol? ly:music?)
    (_i "Set @var{heads} in @var{music} to @var{style}.")
    (style-note-heads heads style music))
 
@@ -1141,6 +1242,47 @@ tag =
 	  (ly:music-property arg 'tags)))
    arg)
 
+temporary =
+#(define-music-function (parser location music)
+   (ly:music?)
+   (_i "Make any @code{\\override} in @var{music} replace an existing
+grob property value only temporarily, restoring the old value when a
+corresponding @code{\\revert} is executed.  This is achieved by
+clearing the @samp{pop-first} property normally set on
+@code{\\override}s.
+
+An @code{\\override}/@/@code{\\revert} sequence created by using
+@code{\\temporary} and @code{\\undo} on the same music containing
+overrides will cancel out perfectly or cause a@tie{}warning.
+
+Non-property-related music is ignored, warnings are generated for any
+property-changing music that isn't an @code{\\override}.")
+   (define warned #f)
+   (for-some-music
+    (lambda (m)
+      (and (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))
+           (case (ly:music-property m 'name)
+             ((OverrideProperty)
+              (if (ly:music-property m 'pop-first #f)
+                  (set! (ly:music-property m 'pop-first) '()))
+              (if (ly:music-property m 'once #f)
+                  (set! (ly:music-property m 'once) '()))
+              #t)
+             ((ContextSpeccedMusic)
+              #f)
+             (else
+              (if (not warned)
+                  (begin
+                    (ly:input-warning location (_ "Cannot make ~a revertible")
+                                      (ly:music-property m 'name))
+                    (set! warned #t)))
+              #t))))
+    music)
+   music)
+
 time =
 #(define-music-function (parser location beat-structure fraction)
    ((number-list? '()) fraction?)
@@ -1220,6 +1362,59 @@ are affected.")
 	   (ly:music-property music 'tweaks)))
    music)
 
+undo =
+#(define-music-function (parser location music)
+   (ly:music?)
+   (_i "Convert @code{\\override} and @code{\\set} in @var{music} to
+@code{\\revert} and @code{\\unset}, respectively.  Any reverts and
+unsets already in @var{music} cause a warning.  Non-property-related music is ignored.")
+   (define warned #f)
+   (let loop
+       ((music music))
+     (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)))
+            (lambda (m overrides)
+              (case (ly:music-property m 'name)
+                ((OverrideProperty)
+                 (cons
+                  (make-music 'RevertProperty
+                              'symbol (ly:music-property m 'symbol)
+                              'grob-property-path
+                              (cond
+                               ((ly:music-property m 'grob-property #f) => list)
+                               (else
+                                (ly:music-property m 'grob-property-path))))
+                  overrides))
+                ((PropertySet)
+                 (cons
+                  (make-music 'PropertyUnset
+                              'symbol (ly:music-property m 'symbol))
+                  overrides))
+                ((ContextSpeccedMusic)
+                 (cons
+                  (make-music 'ContextSpeccedMusic
+                              'element (loop (ly:music-property m 'element))
+                              'context-type (ly:music-property m 'context-type))
+                  overrides))
+                (else
+                 (if (not warned)
+                     (begin
+                       (ly:input-warning location (_ "Cannot revert ~a")
+                                         (ly:music-property m 'name))
+                       (set! warned #t)))
+                 overrides)))
+            '()
+            music)))
+       (cond
+        ((null? lst) (make-music 'Music))
+        ((null? (cdr lst)) (car lst))
+        (else (make-sequential-music lst))))))
+
 unfoldRepeats =
 #(define-music-function (parser location music) (ly:music?)
    (_i "Force any @code{\\repeat volta}, @code{\\repeat tremolo} or