\version "2.14.2"

% http://lists.gnu.org/archive/html/lilypond-user/2009-01/msg00588.html
% http://lists.gnu.org/archive/html/lilypond-user/2009-01/msg00628.html 

#(define (has-duration? music) 
(ly:duration? (ly:music-property music 'duration))) 

#(define (not-has-duration? music) 
(not (has-duration? music))) 

keepsOnlyFirstNote = #(define-music-function (parser location music) (ly:music?) 
(music-map 
  (lambda (evt) 
   (if (eq? 'EventChord (ly:music-property evt 'name)) 
      (let ((elts (ly:music-property evt 'elements))) 
       (if (has-duration? (car elts)) 
            (ly:music-set-property! evt 'elements (cons 
                 (car elts) 
                 (filter not-has-duration? (cdr elts))))))) 
  evt) 
music)) 

deleteFirstNote = #(define-music-function (parser location music) (ly:music?) 
(music-map 
  (lambda (evt) 
   (if (eq? 'EventChord (ly:music-property evt 'name)) 
      (let ((elts (ly:music-property evt 'elements))) 
           (if (has-duration? (car elts)) 
                (ly:music-set-property! evt 'elements  (cdr elts))))) 
  evt) 
music)) 

% http://old.nabble.com/Nice-workaround-for-simultaneous-rehearsal-marks-%E2%80%93-thanks-Neil!-td32212763.html
% defined by Neil Puttock

#(define (multi-mark-engraver ctx)
   (let ((texts '())
         (final-texts '())
         (events '()))

     `((start-translation-timestep
        . ,(lambda (trans)
             (set! final-texts '())))

       (listeners
        (mark-event
         . ,(lambda (trans ev)
              (set! events (cons ev events)))))

       (acknowledgers
        (break-alignment-interface
         . ,(lambda (trans grob source)
              (for-each (lambda (mark)
                          (set! (ly:grob-parent mark X) grob))
                        texts))))

       (process-music
        . ,(lambda (trans)
             (for-each
              (lambda (ev)
                (let* ((mark-grob
                        (ly:engraver-make-grob trans 'RehearsalMark ev))
                       (label (ly:event-property ev 'label))
                       (formatter (ly:context-property ctx 'markFormatter)))

                  (if (and (procedure? formatter)
                           (not (markup? label)))
                      (begin
                       (if (not (number? label))
                           (set! label
                                 (ly:context-property ctx 'rehearsalMark)))

                       (if (and (integer? label)
                                (exact? label))
                           (set! (ly:context-property ctx 'rehearsalMark)
                                 (1+ label)))

                       (if (number? label)
                           (set! label (apply formatter (list label ctx)))
                           (ly:warning "rehearsalMark must have integer value"))))

                  (if (markup? label)
                      (begin
                       (set! (ly:grob-property mark-grob 'text) label)
                       (let ((dir (ly:event-property ev 'direction)))
                         (and (ly:dir? dir)
                              (set! (ly:grob-property mark-grob 'direction)
                                    dir))))
                      (ly:warning "mark label must be a markup object"))

                  (set! texts (cons mark-grob texts))))
              (reverse events))))

       (stop-translation-timestep
        . ,(lambda (trans)
             (if (pair? texts)
                 (let ((staves (ly:context-property ctx 'stavesFound))
                       (priority-index 0))
                   (for-each (lambda (grob)
                               (let ((my-priority (ly:grob-property grob 'outside-staff-priority 1500)))
                                 (for-each (lambda (stave)

                                 (ly:pointer-group-interface::add-grob grob 'side-support-elements
                                               stave))
                                           staves)
                                 (set! (ly:grob-property grob 'outside-staff-priority) (+ my-priority priority-index))
                                 (set! priority-index (1+ priority-index))
                                 (set! final-texts (cons grob final-texts))))
                             (reverse texts))
                     (set! texts '())
                     (set! events '())))))

        (finalize
         . ,(lambda (trans)
              (and (pair? final-texts)
                   (for-each (lambda (grob)
                               (set! (ly:grob-property grob 'break-visibility)
                                     end-of-line-visible))
                             final-texts)))))))
                             
markDown =
#(define-music-function (parser location text) (markup?)
   (make-music 'MarkEvent
               'direction DOWN
               'label text))

myMark =
#(define-music-function (parser location text) (markup?)
  (make-music 'MarkEvent
              'label text))

toCoda = {
 \tweak #'self-alignment-X #RIGHT
 \tweak #'break-visibility #begin-of-line-invisible
 \myMark \markup  { to \hspace #1.25 \raise #1.25  \musicglyph #"scripts.coda" }
}

smiley = {
 \tweak #'color #red
 \tweak #'break-visibility #begin-of-line-invisible
 \markDown \markup \rotate #-90 { ";-)" }
}

chordAlign =
#(define-music-function (parser location dir)(number?)
#{
        #(define (chordNameCallback grob)
	"
	LEFT = -1
	RIGHT = 1
	CENTER = 0
	"
          (let* ((ch (ly:text-interface::print grob)))
          	(ly:stencil-aligned-to ch X $dir)))
   	
        %\once 
        \override ChordNames.ChordName #'stencil = #chordNameCallback
#})
\paper {
%  annotate-spacing = ##t
}

Changes = \chordmode { \chordAlign #-0.3 r4 g:m r4 f8 d8:m7 ~ d1:m7 r4 g:m r4 f8 d8:m7 ~ d1:m7}
Melody  = \relative c'' { 
        g4 c a f ~ 
        \mark\default \markDown \markup { \bold "1" }
        f1 \break  
        \mark\default \toCoda
        g4 c a f ~ 
        \mark\default \markDown \markup { \bold "3" }
        f1	   
        \mark\default \smiley
}



\score {
        <<
        \new RhythmicStaff \with { 
        	\override VerticalAxisGroup #'staff-staff-spacing =		
 		      #'((basic-distance . 1)
 		         (minimum-distance . 1)
 		         (padding . 1))
 	\accepts "ChordNames"
        } 
        <<
        \new Voice \chords { \Changes }
        \new Voice { \keepsOnlyFirstNote \Changes }
        >>
          
        \new Staff {
                \key f \major
                \clef treble
                \time 4/4
                \Melody  
        }
 >>
 \layout {
   indent=0
            \context {
            	    \Score
            	      \remove "Mark_engraver"
            	      \consists #multi-mark-engraver
            	      \consists "Tweak_engraver"
            }
            \context {
            	    \ChordNames
            	      \override ChordName #'Y-offset = #4
            	      \override ChordName #'font-size = #'-1
            	      noChordSymbol = ##f
            	      chordChanges = ##t
            }
            \context {
            	    \RhythmicStaff
     	      \override StaffSymbol #'staff-space = #(magstep -3)
     	      \override StaffSymbol #'line-count = #0
     	      \override BarLine #'stencil = ##f
     	      \override TimeSignature #'transparent = ##t
     	      \override NoteHead #'style = #'slash 
     	      fontSize = #-7
     	      \override Stem #'direction = #UP % = \stemUp 
            }
            
 } % layout
} % score