--- /dev/null
+\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
+}
'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?)
((process-acknowledged trans)
(make-stem-spans! ctx stems trans)
(set! stems '())))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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))))