]> 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 4ee2e4dcaf5c7d942bcc74d83fb67d3d25d1d4f7..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.42"
+\version "2.16.0"
 
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -87,34 +87,23 @@ markups), or inside a score.")
 
 alterBroken =
 #(define-music-function (parser location name property arg)
-  (string? scheme? list?)
+  (symbol-list? symbol? 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))))))
+  (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)
@@ -475,6 +464,19 @@ 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,
@@ -664,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}.")
@@ -698,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))))))
 
 
 
@@ -1067,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
@@ -1089,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) '()))
@@ -1125,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)
@@ -1140,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}.")
@@ -1165,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))
 
@@ -1180,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?)
@@ -1259,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