% embed all category images in postscript once
#(define-markup-list-command (embed-category-images layout props)()
   (map (lambda (category)
     (interpret-markup layout props
       (markup #:epsfileembed (category-image-path (symbol->string (car category))))))
       category-names))

% print a markup-list in columns
#(define-markup-list-command (columnlayout layout props cols margin heightpair lines) (integer? number? pair? markup-list?)
   (let create-col-page ((line-width (- (/ (chain-assoc-get 'line-width props
                          (ly:output-def-lookup layout 'line-width))
                           cols) margin ))
                         (cols cols)
                         (height (car heightpair))
                         (restlines lines))
     (cons
     (interpret-markup layout props
       (make-fill-line-markup
        (map (lambda (foo)
         (make-general-align-markup Y UP (make-override-markup '(baseline-skip . 1) (make-column-markup
          (let add-to-col ((lines restlines) (height-left height))
            (set! restlines lines)
            (if (null? lines)
              '()
              (let* ((line-to-stencil (lambda (line) (interpret-markup layout (cons (list (cons 'line-width line-width) (cons 'baseline-skip 1)) props) (markup line))))
                     (stencil-height (lambda (stencil) (interval-length (ly:stencil-extent stencil Y))))
                     (linestencil (line-to-stencil (car lines)))
                     (current-line-height (stencil-height linestencil))
                     (new-height-left (- height-left current-line-height))
                     (next-line-height (if (null? (cdr lines)) current-line-height (stencil-height (line-to-stencil (cadr lines)))))
                     (no-space-for-next-line (and (< next-line-height current-line-height) (< new-height-left next-line-height)))
                     )
                (if (or (< new-height-left 0) no-space-for-next-line)
                  '()
                  (cons (markup #:stencil linestencil) (add-to-col (cdr lines) new-height-left))))))))))
          (make-list cols))))
     (if (null? restlines)
         (list)
       (create-col-page line-width cols (cdr heightpair) restlines)))))

%%%%%%%%%%%%%%%%%%%%%%%
%%%Funktionen für Inhaltsverzeichnis
% geklaut von da:
% http://lsr.dsi.unimi.it/LSR/Snippet?id=763

% Usage:
% - define and index item with \indexItem $sortstring $markup
% - use \indexSection $sortstring $markup to divide the index into several sections
% - display the alphabetical index with \markuplines \index

% code ist mostly taken from ./ly/toc-init.ly and just renamed and slightly modfied

%% defined later, in a closure
#(define*-public (add-index-item! markup-symbol text sorttext #:optional label) #f)
#(define-public (index-items) #f)

#(let ((index-item-list (list)))
   (set! add-index-item!
   (lambda* (markup-symbol text sorttext #:optional (label (gensym "index")))
       (set! index-item-list
       ;; We insert index items sorted from the beginning on and do
       ;; not sort them later - this saves pretty much computing time
       (insert-alphabetical-sorted! (list label markup-symbol text
        ;; this crazy hack is necessary because lilypond depends on guile 1.8 atm
        ;; and so the cool unicode conversion functions cannot be used
          (ly:string-substitute " " ""
          (ly:string-substitute "…" ""
          (ly:string-substitute "Č" "C"
          (ly:string-substitute "Đ" "D"
          (ly:string-substitute "Т" "T"
          (ly:string-substitute "Ä" "Ae"
          (ly:string-substitute "ä" "ae"
          (ly:string-substitute "Ö" "O"
          (ly:string-substitute "ö" "oe"
          (ly:string-substitute "Ü" "U"
          (ly:string-substitute "ü" "ue" sorttext))))))))))))
        index-item-list))
       (make-music 'EventChord
         'page-marker #t
         'page-label label
         'elements (list (make-music 'LabelEvent
         'page-label label)))))
   (set! index-items (lambda ()
         index-item-list)))

#(define (insert-alphabetical-sorted! iitem ilist)
  (if (null? ilist)
      (list iitem)
      (if (string-ci<? (cadddr iitem) (cadddr (car ilist)))
          (cons iitem ilist)
          (cons (car ilist) (insert-alphabetical-sorted! iitem (cdr ilist))))))

% code for category index
#(define*-public (add-category-index-item! categories markup-symbol text #:optional label) #f)
#(define-public (category-index-items) #f)

#(let ((category-index-hash (make-hash-table)))
   (set! add-category-index-item!
   (lambda* (categories markup-symbol text #:optional (label (gensym "index")))
     (for-each (lambda (category)
            (let* ((catsym (string->symbol category))
                   (catlist (hashq-ref category-index-hash catsym
                              (list (list label 'indexCategoryMarkup category)))))
              (if (assq catsym category-names)
                (hashq-set! category-index-hash catsym
                  (cons (list label markup-symbol text) catlist))
                (ly:error "song: <~a> category ~a is not defined!" (markup->string text) category))))
       categories)
       (make-music 'EventChord
         'page-marker #t
         'page-label label
         'elements (list (make-music 'LabelEvent
         'page-label label)))))
   (set! category-index-items (lambda ()
          (append-map (lambda (kv) (reverse (hashq-ref category-index-hash (car kv) (list)))) category-names))))




#(define-markup-command (with-link-symbol-ref layout props symbol arg)
   (symbol? markup?)
   "call with-link with the label referenced by symbol"
   (let ((label (chain-assoc-get symbol props)))
     (interpret-markup layout props
     (markup #:with-link label arg))))

#(define-markup-command (category-image-symbol-ref layout props size symbol)
   (number? symbol?)
   "call category-image with the category referenced by symbol"
   (let ((category (chain-assoc-get symbol props)))
     (interpret-markup layout props
     (markup #:category-image size category))))

#(define-markup-command (category-name-symbol-ref layout props symbol)
   (symbol?)
   "get the name of a category referenced by symbol"
   (let* ((category (chain-assoc-get symbol props))
          (catname (assq (string->symbol category) category-names)))
     (interpret-markup layout props
     (markup #:override (cons 'baseline-skip 3.5) (if catname (make-left-column-markup (string-split (cadr catname) #\newline)) category)))))

#(define-markup-command (index-item-with-pattern layout props)()
     (let (
            (text (chain-assoc-get 'index:text props))
            (page (chain-assoc-get 'index:page props))
            (width (-
                     (chain-assoc-get 'line-width props)
                     (interval-length (ly:stencil-extent (interpret-markup layout props "XXXX") X))))
            )
     (interpret-markup layout props
       (make-column-markup
         (let ((revlist
                (if (markup? text)
                    (list text)
                    (reverse (map (lambda (stil) (markup #:stencil stil))
                      (wordwrap-string-internal-markup-list layout
                        (cons (if (chain-assoc-get 'alternative text)
                                (list (cons 'line-width width) (cons 'font-shape 'italic))
                                (list (cons 'line-width width))) props) #f
                        (chain-assoc-get 'rawtext text))))))
               (target-size-markup
                 (make-column-markup
                   (list
                    (make-simple-markup "Agj")
                    (make-vspace-markup 0.2))))
               )
               (reverse (map (lambda (m)
                               (make-size-box-to-box-markup #f #t m target-size-markup))
                          (cons
                           (make-with-link-symbol-ref-markup 'index:label (make-fill-with-pattern-markup 1 RIGHT "." (car revlist) page))
                           (cdr revlist)))))))))

\paper {
  indexItemMarkup = \markup {
    \index-item-with-pattern
  }
  indexSectionMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
    \sans \bold \fontsize #3 \fromproperty #'index:text
    \null
  }
  indexCategoryMarkup = \markup \override #'(baseline-skip . 1.5) \column {
    \fill-line { \line { \vcenter \category-image-symbol-ref #7 #'index:text \hspace #3 \vcenter \sans \bold \fontsize #3 \category-name-symbol-ref #'index:text } \null }
    \vspace #.4
  }

}

#(define (prepare-item-markup items layout)
   (map (lambda (index-item)
         (let ((label (car index-item))
               (index-markup (cadr index-item))
               (text (caddr index-item)))
           (markup #:override (cons 'index:label label)
             #:override (cons 'index:page (markup #:custom-page-number label -1))
             #:override (cons 'index:text text)
             (ly:output-def-lookup layout index-markup))))
       (items)))

#(define-markup-list-command (index-in-columns-with-title layout props index-type title-markup) (symbol? markup?)
  ( _i "Outputs index alphabetical sorted or in categories" )
    (let ((items (case index-type
            ((alphabetical) index-items)
            ((categories) category-index-items)))
          (title (interpret-markup layout props title-markup)))
      (cons title
      (interpret-markup-list layout props
        (make-columnlayout-markup-list songTocColumns 2
          (let ((h (- (ly:output-def-lookup layout 'paper-height) 12)))
            (cons (- h (interval-length (ly:stencil-extent title Y))) h))
          (prepare-item-markup items layout))))))

indexItem =
#(define-music-function (parser location sorttext text) (string? markup?)
   "Add a line to the alphabetical index, using the @code{indexItemMarkup} paper variable markup."
   (add-index-item! 'indexItemMarkup text sorttext))

indexSection =
#(define-music-function (parser location sorttext text) (string? markup?)
   "Add a section line to the alphabetical index, using @code{indexSectionMarkup} paper variable markup. This can be used to divide the alphabetical index into different sections, for example one section for each first letter."
   (add-index-item! 'indexSectionMarkup text sorttext))

#(define (extract-and-check-vars-from-header bookheader varlist)
  (let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0)))
         (extract-var-and-check (lambda (headervar)
           (let* ((variableref (assoc-ref headervars headervar))
                  (extracted (if variableref (variable-ref variableref) #f)))
              (if (and extracted (not (and (string? extracted) (string-null? extracted)))) extracted #f)))))
    (map (lambda (varsymbol)
      (cons varsymbol (extract-var-and-check varsymbol))
    ) varlist)))

headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?)
    (let*
      (
       (extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle altalttitle categorytitle categories)))
       (title (assq-ref extractedheadervars 'title))
       (starttext (assq-ref extractedheadervars 'starttext))
       (alttitle (assq-ref extractedheadervars 'alttitle))
       (altalttitle (assq-ref extractedheadervars 'altalttitle))
       (categorytitle (assq-ref extractedheadervars 'categorytitle))
       (categories (assq-ref extractedheadervars 'categories))
       (add-to-toc! (lambda (toctitle tocmarkup)
                      (add-index-item! 'indexItemMarkup tocmarkup toctitle label)))
       )
           (if categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (cons (list (cons 'rawtext (if categorytitle categorytitle title))) '()) label))
           (if starttext (add-to-toc! starttext (cons (list (cons 'rawtext starttext) (cons 'alternative #t)) '())))
           (if alttitle (add-to-toc! alttitle (cons (list (cons 'rawtext alttitle) (cons 'alternative #t)) '())))
           (if altalttitle (add-to-toc! altalttitle (cons (list (cons 'rawtext altalttitle) (cons 'alternative #t)) '())))
           (if title (add-to-toc! title (cons (list (cons 'rawtext title)) '())) #{ #})
    ))


%% https://github.com/NalaGinrut/guile-csv/blob/master/csv/csv.scm

#(define* (sxml->csv sxml port #:key (delimiter #\,))
  (let* ((d (string delimiter))
         (csv (map (lambda (l) (string-join l d)) sxml)))
    (for-each (lambda (l)
                (format port "~a~%" l))
              csv)))

#(define csv-write sxml->csv)

#(define-markup-command (write-toc-csv layout props) ()
  (define (csv-escape field)
    (if (string-null? field)
        field
        (string-append
          "\""
          (ly:string-substitute "\n" "\\n"
            (ly:string-substitute "\"" "\\\"" field))
          "\"")))
  (define (format-authors authorIds)
    (string-join (map (lambda (authorId) (format-author layout authorId #f)) authorIds) ", "))
  (define cr-regex (ly:make-regex "\r"))
  (define crlf-regex (ly:make-regex "\r\n"))
  (define para-sep-regex (ly:make-regex "\n[ \t\n]*\n[ \t\n]*"))
  (define whitespace-regex (ly:make-regex "[ \t\n]+"))
  (define leading-whitespace-regex (ly:make-regex "^[ \t\n]+"))
  (define trailing-whitespace-regex (ly:make-regex "[ \t\n]+$"))
  (define (cleanup-whitespaces str)
    (ly:regex-replace leading-whitespace-regex
      (ly:regex-replace trailing-whitespace-regex
        (ly:regex-replace whitespace-regex str " ")
        "")
      ""))
  (define (format-info-paragraphs text)
    (let* ((para-strings (ly:regex-split
                        para-sep-regex
                        (ly:regex-replace
                         cr-regex
                         (ly:regex-replace crlf-regex text "\n")
                         "\n")))
         (para-lines (map cleanup-whitespaces para-strings)))
    (string-join para-lines "\n")))
  (define (generate-toc-csv labelPageTable)
    (let ((song-lines (map (lambda (song)
            (let* ((filename (symbol->string (car song)))
                   (songvars (cdr song))
                   (page-number (number->string (assoc-get (assq-ref songvars 'label) labelPageTable)))
                   (extractedheadervars (extract-and-check-vars-from-header (assq-ref songvars 'header)
                      '(title starttext alttitle altalttitle categorytitle categories authors year_text year_melody year_translation year_composition infotext translation pronunciation copyright source)))
                   (headervar-or-empty (lambda (varsym)
                     (let ((extracted (assq-ref extractedheadervars varsym)))
                       (if extracted extracted ""))))
                   (authors (assq-ref extractedheadervars 'authors))
                   (poetIds (find-author-ids-by 'text authors))
                   (translatorIds (find-author-ids-by 'translation authors))
                   (versePoetData (find-author-id-with-part-numbers 'verse authors))
                   (composerIds (find-author-ids-by 'melody authors))
                   (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
                   (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
                   (compositionIds (find-author-ids-by 'composition authors))
                   (bridgeIds (find-author-ids-by 'bridge authors))
                   (interludeIds (find-author-ids-by 'interlude authors)))
              (map csv-escape
                (list
                  filename
                  page-number
                  (headervar-or-empty 'title)
                  (headervar-or-empty 'starttext)
                  (headervar-or-empty 'alttitle)
                  (headervar-or-empty 'altalttitle)
                  (headervar-or-empty 'categorytitle)
                  (headervar-or-empty 'categories)
                  (format-authors (append poetIds (map car versePoetData)))
                  (format-authors translatorIds)
                  (format-authors (append composerIds compositionIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
                  (headervar-or-empty 'year_text)
                  (headervar-or-empty 'year_melody)
                  (headervar-or-empty 'year_translation)
                  (headervar-or-empty 'year_composition)
                  (headervar-or-empty 'copyright)
                  (headervar-or-empty 'source)
                  (format-info-paragraphs (headervar-or-empty 'infotext))
                  (format-info-paragraphs (headervar-or-empty 'translation))
                  (format-info-paragraphs (headervar-or-empty 'pronunciation))
              ))))
            (alist-delete 'imagePage (alist-delete 'emptyPage song-list)))))
    (call-with-output-file "toc.csv"
      (lambda (port)
       (csv-write (cons '(
        "filename"
        "page-number"
        "title"
        "starttext"
        "alttitle"
        "altalttitle"
        "categorytitle"
        "categories"
        "poets"
        "translators"
        "composers"
        "year_text"
        "year_melody"
        "year_translation"
        "year_composition"
        "copyright"
        "source"
        "infotext"
        "translation"
        "pronunciation"
        ) song-lines) port))
  )))
  ; we use a delayed stencil to have all the page references available
  (ly:make-stencil
    `(delay-stencil-evaluation
      ,(delay (let* ((table (ly:output-def-lookup layout 'label-page-table)))
        (generate-toc-csv (if (list? table) table '()))
        empty-stencil)))))