\version "2.19.22"

% Scheme functions ripped from https://github.com/jpvoigt/lalily
% Thanks to Jan-Peter Voigt

#(define-public (register-markup-producer name proc) #f)
#(define-public (get-markup-producer name) #f)

#(let ((table (list)))
  (set! register-markup-producer (lambda (name proc)
                                   (set! table (assoc-set! table name proc))))
  (set! get-markup-producer (lambda (name)
                              (assoc-get name table))))

#(define-markup-command (fromproperties layout props arg)(list?)
  (let ((mup (get-markup-producer fromproperties-markup)))
       (interpret-markup layout props (mup layout props (list arg)))))

#(register-markup-producer fromproperties-markup (lambda (layout props args)
  (let ((ret (markup)))
       (for-each (lambda (sym)(let ((val (chain-assoc-get sym props)))
                              (if (and (or (string? val)(markup? val))
                                  (> (string-length (markup->string val)) 0))
                                (set! ret val))))
                 (reverse (car args)))
       ret)))

#(define-markup-command (execMarkup layout props proc)
                        (procedure?)
  (let ((m (proc layout props)))
    (cond ((ly:stencil? m) m)
          ((markup? m) (interpret-markup layout props m))
          (else (interpret-markup layout props (markup (format "~A" m)))))))

#(define-markup-command (delayed layout props mup)
                        (markup?)
  (let* ((line-part (chain-assoc-get 'line-part props 1))
         (line-width (* (ly:output-def-lookup layout 'line-width) line-part))
         (gauge-stencil (interpret-markup layout props mup)) ; (markup #:super "*" "ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜß" )))
         (x-ext (ly:stencil-extent gauge-stencil X))
         (y-ext (ly:stencil-extent gauge-stencil Y)))
        (ly:make-stencil
          `(delay-stencil-evaluation
            ,(delay (ly:stencil-expr

                     (let* ((table (ly:output-def-lookup layout 'label-page-table))
                            (cur-page 0)
                            (current-toc (markup)))
                           (set! cur-page (chain-assoc-get 'page:page-number props -1))
                           (for-each (lambda (toc)
                                             (let ((label (car toc))
                                                   (text (cdr toc)))
                                                  (let ((label-page (and (list? table) (assoc label table))))
                                                       ; I want the current toc item at the *start* of the page, not the end
                                                       ; so change >= to >
                                                       ;(if (and label-page (>= cur-page (cdr label-page)))
                                                       (if (and label-page (> cur-page (cdr label-page)))
                                                           (set! current-toc (markup->string text #f layout props))))
                                             )
                                     ) (toc-items))
                           (interpret-markup layout (cons (list (cons 'toc:current current-toc)) props) mup)
                     )
          )))
          x-ext y-ext)))

\header {
  title = "My Piece"
  composer = "Me"
  tagline = ##f
}

\paper {
  titleHeaderMarkup = \markup \execMarkup #(lambda (layout props)
                                             (let* ((mtitle (chain-assoc-get 'header:title props))
                                                    (stitle (if (markup? mtitle) (string-trim-both (markup->string mtitle)) ""))
                                                    (mtoc (chain-assoc-get 'toc:current props))
                                                    (stoc (if (markup? mtoc) (string-trim-both (markup->string mtoc)) ""))
                                                    (mlist (list)))
                                               (if (and (> (string-length stoc) 0) (not (string=? stitle stoc)))
                                                   (set! mlist `(,@mlist ,@(if (> (length mlist) 0) (list ", ")(list)) ,mtoc)))
                                               (make-line-markup mlist)))
  oddHeaderMarkup = \markup \delayed \fill-line {
    \on-the-fly #not-part-first-page \fromproperty #'header:title
    \on-the-fly #not-part-first-page \execMarkup #(lambda (layout props)
                  (ly:output-def-lookup layout 'titleHeaderMarkup
                                               (markup #:fromproperties '(toc:current))))
    \on-the-fly #print-page-number-check-first \fromproperty #'page:page-number-string
  }
  evenHeaderMarkup = \oddHeaderMarkup
}

\book {
  \tocItem \markup "Movement 1"
  \score {
    \header { piece = "Movement 1" }
    \repeat unfold 400 c'1
  }
  \tocItem \markup "Movement 2"
  \score {
    \header { piece = "Movement 2" }
    \repeat unfold 400 d'1
  }
  \tocItem \markup "Movement 3"
  \score {
    \header { piece = "Movement 3" }
    \repeat unfold 400 e'1
  }
}