\version "2.19.65"

#(define (set-arpeggio-position idx)
;; Sets Arpeggio.positions taken from the chord's note-heads ending the Slur
;; `idx' selects the Slur-bound from the note-heads of the bounding right
;; NoteColumn
  (lambda (grob)
    (if (grob::has-interface grob 'slur-interface)
        (let* ((right-bound (ly:spanner-bound grob RIGHT))
               (right-note-column
                 (if (grob::has-interface right-bound 'note-column-interface)
                     right-bound
                     (ly:grob-parent right-bound X)))
               (left-bound (ly:spanner-bound grob LEFT))
               (left-note-column (ly:grob-parent left-bound X))
               (staff-space
                 (ly:output-def-lookup (ly:grob-layout grob) 'staff-space))
               (note-heads (ly:grob-object right-note-column 'note-heads))
               (staff-pos-ls
                 (if (ly:grob-array? note-heads)
                     (sort
                       (map
                         (lambda (nh)
                           (ly:grob-property nh 'staff-position))
                         (ly:grob-array->list note-heads))
                        <)
                     #f))
               (cond-elts (ly:grob-object left-bound 'conditional-elements))
               (arp-ls
                 (if (ly:grob-array? cond-elts)
                     (filter
                       (lambda (arp)
                         (grob::has-interface arp 'arpeggio-interface))
                       (ly:grob-array->list cond-elts))
                     '()))
               (arp (if (pair? arp-ls) (car arp-ls) #f))
               (arp-pos
                 (if staff-pos-ls
                     (interval-widen
                       (cons
                         (/ (car staff-pos-ls) 2)
                         (/ (last staff-pos-ls) 2))
                       (/ staff-space 2))
                     #f)))
          (if (and (ly:grob-array? note-heads)
                   (> (ly:grob-array-length note-heads) idx))
              (ly:spanner-set-bound!
                grob RIGHT (list-ref (ly:grob-array->list note-heads) idx))
              (ly:warning
                "Referenced note-head does not exist in ~a, idx ~a too high?
Ignoring."
                note-heads
                idx)
              )
          (if (and arp arp-pos)
              (ly:grob-set-property! arp 'positions arp-pos))
        #f))))

setArpeggioPosition =
#(define-music-function (val)(index?)
#{
  \once \override Slur.before-line-breaking = #(set-arpeggio-position val)
#})


startArpeggioAcciaccaturaMusic =  {
  <>\startGraceSlur\arpeggio
  \temporary \override Flag.stroke-style = #"grace"
}

stopArpeggioAcciaccaturaMusic =  {
  \revert Flag.stroke-style
  <>\stopGraceSlur
}

#(defmacro-public def-my-grace-function (start stop . docstring)
  "Helper macro for defining grace music"
  `(define-music-function (idx music) ((index? 0) ly:music?)
     ,@docstring
     (make-music
       'GraceMusic
       'element
         (make-music
           'SequentialMusic
           'elements
             (list
               #{
                  \setArpeggioPosition $idx
                  $(ly:music-deep-copy ,start)
               #}
               music
               (ly:music-deep-copy ,stop))))))

arpeggioAcciaccatura =
#(def-my-grace-function
   startArpeggioAcciaccaturaMusic
   stopArpeggioAcciaccaturaMusic
   (_i "Create an acciaccatura from the following music expression.
The Slur-end is bound to the note-head specified by an optional argument, which
should be an index. If not present the Slur is bound to the first typed
note-event of the chord."))

<<
  \new Staff {
    \key ees \major

    \override PhrasingSlur.positions = #'(2.5 . 2.2)
    \phrasingSlurUp

    <bes d' f'>4\(
    <bes des' ees' g'>
    %% probably adjust the Slur a little:
    \once \override Slur.minimum-length = 2
    \shape #'((0 . 0) (-0.2 . -0.2) (-0.2 . -0.3) (-0.2 . -0.4)) Slur
    \arpeggioAcciaccatura 2 bes'8
    <c' es' aes'>4
    <bes e' g'>\fermata\)

    <aes c' f'>\(
    <g c' ees'>
    %% probably adjust the Slur a little:
    \once \override Slur.minimum-length = 2
    \shape #'((0 . 0) (-0.2 . -0.2) (-0.2 . -0.3) (-0.2 . -0.4)) Slur
    \arpeggioAcciaccatura 2 g'8
    <aes c' f'>4
    <g c' ees'>\fermata\)
  }

  \new Staff {
    \clef bass
    \key es \major
    bes,4 es as, c,\fermata |
    <f, c>
    <c, c>
    <f, c>
    <c, c>\fermata
  }
>>