\version "2.14.0"

#(define-markup-command (transposed-chord-root-name layout props a b) (number? number?)
  #:properties ((cause #f))
  "Print the root of the chord transposed."
  (interpret-markup layout props
    (markup (note-name->markup
             (ly:pitch-transpose (ly:event-property cause 'pitch) (ly:make-pitch 0 a b))
                                #f))))

#(define-markup-command (chord-root-name layout props) ()
  #:properties ((cause #f))
  "Print the root of the chord."
  (interpret-markup layout props
    (markup (note-name->markup (ly:event-property cause 'pitch) #f)
    )))

#(define-public (silent-chord-root-namer pitch lowercase?)
   (markup "")
)

%{
#(define-markup-command (polychord-column layout props args)
 (markup-list?)
  ;#:properties ((direction)
  ;(baseline-skip))
	
 (let* ((args-length-ls (sort (map (lambda (x)
       		(interval-length
       		   (ly:stencil-extent
       		      (interpret-markup layout props x)
       		    X)))
       		args)
       	          >))
       ; baseline-skip is hard-coded!
       ; if you change this don't forget to change 0.65
       ; in: #:translate (cons 0 (* 0.65 baseline-skip))
       (baseline-skip 1.4)
       (ln-mrkp (markup #:translate (cons 0 (* 0.65 baseline-skip))
       	         #:draw-line (cons (car args-length-ls) 0)))
       (new-args (list (car args) ln-mrkp (cadr args))))
       ; direction is hard-coded!
 (stack-lines 1 ;(if (number? direction) direction -1)
              0.0
              baseline-skip
              (interpret-markup-list layout props new-args))))
%}
              
#(define (insert-elt l1 l2 elt)
 "Inserts a new element between every element of list l1
  and outputs this as new list l2.
  While starting, l2 is supposed to be '() "
  (set! l2 (reverse (append (list elt (car l1)) l2)))
  (if (= 1 (length (cdr l1)))
    (append l2 (last-pair l1))
    (insert-elt (cdr l1) (reverse l2) elt)))

#(define-markup-command (dir-column-line layout props direction args)
  (number? markup-list?)
  (let* ((args-length-ls (sort (map (lambda (x) 
        		(interval-length 
        		   (ly:stencil-extent 
        		      (interpret-markup layout props x) 
        		    X))) 
        		args) 
        	          >))
         ; baseline-skip is hard-coded!
         (baseline-skip 0.4)
         (ln-mrkp (markup #:draw-line (cons (car args-length-ls) 0)
         	          #:vcenter
         	          #:vspace 0.2))
         (new-args (insert-elt args '() ln-mrkp)))
  (stack-lines (if (number? direction) direction -1)
               0.0
               baseline-skip
               (interpret-markup-list layout props new-args))))

polychordExceptionMusic = {
  <c e g des' f' aes'>1-\markup { \dir-column-line #1
                       { \chord-root-name \transposed-chord-root-name #1 #-1/2 } }
  <c e g d' fis' a'>1-\markup { \dir-column-line #1
                       { \chord-root-name \transposed-chord-root-name #1 #0 } }
}

%#(top-repl)

polychordExceptions = #( append
  ( sequential-music-to-chord-exceptions polychordExceptionMusic #t)
 ignatzekExceptions)

cmJazz = {
  \set chordNameExceptions = #ignatzekExceptions
  \set chordRootNamer = #note-name->markup
}

cmPoly = {
  \set chordNameExceptions = #polychordExceptions
  \set chordRootNamer = #silent-chord-root-namer
}

theMusic = \chords { 
    \cmPoly
       c1:5.9-.11.13-
       c1:5.9.11+.13
       des1:5.9.11+.13
       fis1:5.9.11+.13
    \cmJazz
       c1:5.9-.11.13-
}

\layout {
  ragged-right = ##t
}


\score {
        \new StaffGroup <<
        <<
        \context ChordNames \theMusic 
        \new Staff = "staff" \relative c' { c1 d e f g }
        >>
        <<
        \context ChordNames \theMusic
        \new Staff = "staff" \relative c' { c1 d e f g }
        >>
        >>
}