Add function for overriding broken spanners to LilyPond. (issue 6397054)

[david . nalesnik]

Reviewers: ,

Description:
Add function for overriding broken spanners to LilyPond.

The music function \alterBroken is intended to facilitate overrides
applied independently to the pieces of broken spanners--one of the
perennial difficulties faced by users of LilyPond (addressed in
Extending 2.6:"Difficult Tweaks").  The function aims at generalization
by allowing the user to specify the name of the spanner and the property
to be overridden.

The function will override unbroken spanners, but it will ignore
non-spanners with a warning.

The function calls \override and may be prefaced by \once (or followed
by
a \revert of the relevant property).

Please review this at http://codereview.appspot.com/6397054/

Affected files:
  A input/regression/alter-broken.ly
  M ly/music-functions-init.ly
  M scm/music-functions.scm


Index: input/regression/alter-broken.ly
diff --git a/input/regression/alter-broken.ly  
b/input/regression/alter-broken.ly
new file mode 100644
index  
0000000000000000000000000000000000000000..4f03f4d6e7fd0899450afc4ad1bf853988535a09
--- /dev/null
+++ b/input/regression/alter-broken.ly
@@ -0,0 +1,45 @@
+\version "2.15.42"
+
+\header {
+  texidoc = "The command @code{\\alterBroken} may be used to override the
+pieces of a broken spanner independently.  The following example  
demonstrates
+its usage with a variety of data types."
+}
+
+\layout {
+  ragged-right = ##t
+}
+
+#(ly:expect-warning (_ "not a spanner name"))
+
+\relative c'' {
+  \alterBroken Slur #'positions #'((3 . 3) (5 . 5))
+  \alterBroken Slur #'color #'((0 0 1) (1 0 0))
+  \alterBroken Slur #'dash-definition #'( ((0 1 0.4 0.75))
+                                          ((0 0.5 0.4 0.75) (0.5 1 1 1)) )
+  d4( d' b g
+  \break
+  d d' b g)
+  \alterBroken "Staff.OttavaBracket" #'padding #'(1 3)
+  % Spaces in spanner's name are disregarded.
+  \alterBroken "Staff . OttavaBracket" #'style #'(line dashed-line)
+  \ottava #1
+  % It is possible to use procedures as arguments.
+  \alterBroken Hairpin #'stencil #`(
+    ,ly:hairpin::print
+    ,(lambda (grob)
+      (ly:stencil-rotate (ly:hairpin::print grob) -5 0 0)))
+  c\< d e
+  % Since `NoteHead' is not the name of a spanner, the following has no
+  % effect on layout.  A warning (suppressed here) is issued.
+  \alterBroken NoteHead #'color #`(,red ,blue)
+  \alterBroken Tie #'color #`(() ,blue)
+  \alterBroken Tie #'control-points #'(
+     ((1 . 3) (2 . 4) (3 . 4) (4 . 3))
+     ((3 . 3) (4 . 4) (5 . 4) (6 . 3))
+    )
+  f~
+  \break
+  f c a f\!
+  \ottava #0
+}
Index: ly/music-functions-init.ly
diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly
index  
9f7fcf8f9623a9c09fab707a0d5027be28c8bbc1..7cfe965047bd2930991dd803d2e222686aaaf821  
100644
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -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?)
Index: scm/music-functions.scm
diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index  
a1d5557b857043b7c1980e79b508608f97b06660..747acbc9be09b25e6715d0024f0b2c866b2cd7a0  
100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -1747,3 +1747,23 @@ yourself."
   "Return a list of all pitches from @var{event-chord}."
   (map (lambda (x) (ly:music-property x 'pitch))
        (event-chord-notes event-chord)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The following is used by the alterBroken function.
+
+(define-public ((value-for-spanner-piece arg) grob)
+  "Associate a piece of broken spanner @var{grob} with an element
+of list @var{arg}."
+  (let* ((orig (ly:grob-original grob))
+         (siblings (ly:spanner-broken-into orig)))
+
+   (define (helper sibs arg)
+     (if (null? arg)
+         arg
+         (if (eq? (car sibs) grob)
+             (car arg)
+             (helper (cdr sibs) (cdr arg)))))
+
+   (if (>= (length siblings) 2)
+       (helper siblings arg)
+       (car arg))))