]> git.donarmstrong.com Git - lilypond.git/blobdiff - ly/music-functions-init.ly
Make \alterBroken, \hide, \omit, \overrideProperty, \shape take unquoted Context...
[lilypond.git] / ly / music-functions-init.ly
index 54ada96164a7e6697b5a79fd74885de2d0500dcb..9036f61e94d3a59ca7ee58032ff311e69abd85c8 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.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,26 @@ markups), or inside a score.")
               'elements (list (make-music 'PageTurnEvent
                                           'break-permission 'allow))))
 
+alterBroken =
+#(define-music-function (parser location name property arg)
+  (symbol-list? symbol? list?)
+  (_i "Override @var{property} for pieces of broken spanner @var{name} with
+values @var{arg}.")
+    ;; only apply override if grob is a spanner
+  (let ((description
+         (assoc-get (last name) all-grob-descriptions)))
+    (if (and description
+             (member 'spanner-interface
+                     (assoc-get 'interfaces
+                                (assoc-get 'meta description))))
+        #{
+          \override $name $property =
+          #(value-for-spanner-piece arg)
+        #}
+        (begin
+          (ly:input-warning location (_ "not a spanner name, `~a'") name)
+          (make-music 'SequentialMusic 'void #t)))))
+
 appendToTag =
 #(define-music-function (parser location tag more music)
    (symbol? ly:music? ly:music?)
@@ -304,27 +324,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 +464,32 @@ given through @var{ratio}.")
     \revert NoteHead #'stencil
   #})
 
+hide =
+#(define-music-function (parser location item) (symbol-list-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 symbol list of form @code{GrobName} or
+@code{Context.GrobName}, 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 (ly:music? item)
+       #{ \tweak #'transparent ##t $item #}
+       #{ \override $item #'transparent = ##t #}))
+
+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 +666,19 @@ octaveCheck =
    (make-music 'RelativeOctaveCheck
                'pitch pitch))
 
+omit =
+#(define-music-function (parser location item) (symbol-list-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 symbol list of form @code{GrobName} or
+@code{Context.GrobName}, 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 (ly:music? item)
+       #{ \tweak #'stencil ##f $item #}
+       #{ \override $item #'stencil = ##f #}))
+
 once =
 #(define-music-function (parser location music) (ly:music?)
    (_i "Set @code{once} to @code{#t} on all layout instruction events in @var{music}.")
@@ -659,30 +713,27 @@ of @var{base-moment}, @var{beat-structure}, and @var{beam-exceptions}.")
 
 overrideProperty =
 #(define-music-function (parser location name property value)
-   (string? symbol? scheme?)
+   (symbol-list? symbol? scheme?)
 
    (_i "Set @var{property} to @var{value} in all grobs named @var{name}.
-The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
-or @code{\"GrobName\"}.")
-
-   (let ((name-components (string-split name #\.))
-        (context-name 'Bottom)
-        (grob-name #f))
+The @var{name} argument is a symbol list of the form @code{Context.GrobName}
+or @code{GrobName}.")
+   (if (<= 1 (length name) 2)
+       (make-music 'ApplyOutputEvent
+                   'context-type (if (null? (cdr name)) 'Bottom
+                                     (car name))
+                   'procedure
+                   (lambda (grob orig-context context)
+                     (if (equal?
+                          (cdr (assoc 'name (ly:grob-property grob 'meta)))
+                          (last name))
+                         (set! (ly:grob-property grob property) value))))
+       (begin
+         (ly:parser-error parser (_ "bad grob name") location)
+         (make-music 'Music))))
+   
 
-     (if (> 2 (length name-components))
-        (set! grob-name (string->symbol (car name-components)))
-        (begin
-          (set! grob-name (string->symbol (list-ref name-components 1)))
-          (set! context-name (string->symbol (list-ref name-components 0)))))
 
-     (make-music 'ApplyOutputEvent
-                'context-type context-name
-                'procedure
-                (lambda (grob orig-context context)
-                  (if (equal?
-                       (cdr (assoc 'name (ly:grob-property grob 'meta)))
-                       grob-name)
-                      (set! (ly:grob-property grob property) value))))))
 
 
 
@@ -1028,11 +1079,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 +1107,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? symbol-list-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 +1147,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 +1165,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 +1215,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 +1230,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 +1350,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