\version "2.18.2" 


#(define (note-column::main-extent grob)
"Return extent of the noteheads in the 'main column', (i.e. excluding any
suspended noteheads), or extent of the rest (if there are no heads)."
  (let* ((note-heads (ly:grob-object grob 'note-heads))
         (stem (ly:grob-object grob 'stem))
         (rest (ly:grob-object grob 'rest)))
    (cond ((ly:grob-array? note-heads)
           (let (;; get the cdr from all note-heads-extents, where the car
                 ;; is zero
                 (n-h-right-coords
                   (filter-map
                     (lambda (n-h)
                       (let ((ext (ly:grob-extent n-h grob X)))
                          (and (= (car ext) 0) (cdr ext))))
                     (ly:grob-array->list note-heads))))
             ;; better be paranoid, find the max of n-h-right-coords and 
             ;; return a pair with (cons 0 <max>)
             (cons 0.0 (reduce max 0 n-h-right-coords))))
          ((ly:grob? rest)
           (ly:grob-extent rest grob X))
          ;; better be paranoid
          (else '(0 . 0)))))

#(define (adjust-piano-pedal-bracket val)
  (lambda (grob)
    ;; grob is supposed to be PianoPedalBracket.
    ;; Returns a number-pair to set shorten-pair.
    ;; This pair is calculated warranting no gap between consecutive
    ;; PianoPedalBrackets.
    ;; If `val' is #f the extent of left and right bounding
    ;; NoteColumns are calculated. Half of those lengths are taken then.
    ;; (Only the NoteColumn's main extent is taken, disregarding suspended
    ;; NoteHeads)
     (let* ((orig (ly:grob-original grob))
            (siblings (if (ly:grob? orig)
                          (ly:spanner-broken-into orig) '()))
            (with-text? (ly:grob? (ly:grob-object grob 'pedal-text)))
            (left-val #f)
            (right-val #f))
            
       (if val
           (begin
             (set! left-val val)
             (set! right-val (- val)))
           (let* ((left-bound (ly:spanner-bound grob LEFT))
                  (left-bound-elts-array (ly:grob-object left-bound 'elements))
                  (left-bound-elts-list 
                    (if (ly:grob-array? left-bound-elts-array)
                        (ly:grob-array->list left-bound-elts-array)
                        '()))
                  (left-bound-nc-list
                    (filter
                      (lambda (g)
                        (grob::has-interface g 'note-column-interface))
                      left-bound-elts-list))
                  (left-bound-note-column
                    (if (pair? left-bound-nc-list)
                        (car left-bound-nc-list)
                        #f))
                  (left-val-default
                    (if left-bound-note-column
                        (/
                           (interval-length 
                             (note-column::main-extent left-bound-note-column))
                           2)
                        0))
                  (right-bound (ly:spanner-bound grob RIGHT))
                  (right-bound-elts-array 
                    (ly:grob-object right-bound 'elements))
                  (right-bound-elts-list 
                    (if (ly:grob-array? right-bound-elts-array)
                        (ly:grob-array->list right-bound-elts-array)
                        '()))
                  (right-bound-nc-list
                    (filter
                      (lambda (g)
                        (grob::has-interface g 'note-column-interface))
                      right-bound-elts-list))
                  (right-bound-note-column
                    (if (pair? right-bound-nc-list)
                        (car right-bound-nc-list)
                        #f))
                  (right-val-default
                    (if right-bound-note-column
                        (/ 
                           (interval-length 
                             (note-column::main-extent right-bound-note-column))
                           -2)
                        0)))
                  (set! left-val left-val-default)
                  (set! right-val right-val-default)))
            
       (if (pair? siblings) 
           (cond
             ((equal? grob (car siblings))
               (if with-text?
                   (cons 0 0)
                   (cons left-val 0)))
             ((equal? grob (last siblings))
               (cons 0 right-val))
             (else
               (cons 0 0)))
           (if with-text?
               (cons 0 right-val)
               (cons left-val right-val))))))

adjustPianoPedalBracket =
#(define-music-function (parser location amount mus)((number? #f) ly:music?)
"Adjusts the printed extent of @code{PianoPedalBracket}s.
The optional @var{amount} specifies how much they are extended.
If @var{amount} remains unset half of the extent of the bounding NoteColumns
are used.
Limitation: Doesn't work with @code{\\once}. 
            For one-time usage set @code{'shorten-pair} manually.
"
#{
  \override Staff.PianoPedalBracket.shorten-pair = 
    #(adjust-piano-pedal-bracket amount)
  $mus
#})
    
<<
  \new Staff
    \relative {
      <>^"default:"
      \set Staff.pedalSustainStyle =#'mixed
      c'1\sustainOn d
      <cis d>1 \sustainOff\sustainOn 
      \break
      c1
      \break
      d\sustainOff\sustainOn d\sustainOff e\sustainOn e f\sustainOff f
    }
    
  \new Staff
    \relative {
      <>^"\\adjustPianoPedalBracket without further argument:"
      \set Staff.pedalSustainStyle =#'mixed
      \adjustPianoPedalBracket
      c'1\sustainOn d
      <cis d>1 \sustainOff\sustainOn 
      \break
      c1
      \break
      d\sustainOff\sustainOn d\sustainOff e\sustainOn e f\sustainOff f
    }
    
  \new Staff
    {
      <>^"\\adjustPianoPedalBracket with numeric argument:"
      \set Staff.pedalSustainStyle =#'mixed
      \adjustPianoPedalBracket 5
      s1\sustainOn s
      s \sustainOff\sustainOn 
      \break
      s
      \break
      s\sustainOff\sustainOn s\sustainOff s\sustainOn s s\sustainOff s
    }
>>