From 15c27c271fb24c2a6e95cafdca7f40fbc65d3b78 Mon Sep 17 00:00:00 2001
From: tux <tux@goldenerreiter.org>
Date: Sun, 22 Dec 2024 23:25:49 +0100
Subject: [PATCH] toc for authors

---
 toc_include.ly | 52 +++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 49 insertions(+), 3 deletions(-)

diff --git a/toc_include.ly b/toc_include.ly
index 75d798c..cb78c7b 100644
--- a/toc_include.ly
+++ b/toc_include.ly
@@ -114,7 +114,28 @@
    (set! category-index-items (lambda ()
           (append-map (lambda (kv) (reverse (hashq-ref category-index-hash (car kv) (list)))) category-names))))
 
+% code for author index
+#(define*-public (add-author-index-item! authorIDs markup-symbol text #:optional label) #f)
+#(define-public (author-index-items) #f)
 
+#(let ((author-index-hash (make-hash-table)))
+   (set! add-author-index-item!
+   (lambda* (authorIDs markup-symbol text #:optional (label (gensym "index")))
+     (for-each (lambda (authorID)
+            (let* ((authorsym (string->symbol authorID))
+                   (authorlist (hashq-ref author-index-hash authorsym
+                              (list (list label 'indexAuthorMarkup authorID)))))
+                (hashq-set! author-index-hash authorsym
+                  (cons (list label markup-symbol text) authorlist))
+                ))
+       authorIDs)
+       (make-music 'EventChord
+         'page-marker #t
+         'page-label label
+         'elements (list (make-music 'LabelEvent
+         'page-label label)))))
+   (set! author-index-items (lambda ()
+          (hash-fold (lambda (authorsym authorlist previous-author-items) (append previous-author-items (reverse authorlist))) '() author-index-hash))))
 
 
 #(define-markup-command (with-link-symbol-ref layout props symbol arg)
@@ -182,7 +203,16 @@
     \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
   }
-
+  indexAuthorMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
+    \vspace #1
+    \sans \bold \fontsize #3
+      #(make-on-the-fly-markup
+        (lambda (layout props m)
+          (interpret-markup layout props
+            (make-justify-string-markup (format-author layout (chain-assoc-get 'index:text props #f) #f))))
+        (make-null-markup))
+    \vspace #.4
+  }
 }
 
 #(define (prepare-item-markup items layout)
@@ -200,7 +230,8 @@
   ( _i "Outputs index alphabetical sorted or in categories" )
     (let ((items (case index-type
             ((alphabetical) index-items)
-            ((categories) category-index-items)))
+            ((categories) category-index-items)
+            ((authors) author-index-items)))
           (title (interpret-markup layout props title-markup)))
       (cons title
       (interpret-markup-list layout props
@@ -230,19 +261,34 @@ indexSection =
     ) varlist)))
 
 headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?)
+    (define (all-author-ids authors)
+      (let ((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)))
+        (delete-duplicates
+          (append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) (map car voiceComposerData) compositionIds bridgeIds interludeIds))
+    ))
     (let*
       (
-       (extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle altalttitle categorytitle categories)))
+       (extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle altalttitle categorytitle categories authors)))
        (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))
+       (authors (assq-ref extractedheadervars 'authors))
        (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 authors (add-author-index-item! (all-author-ids authors) '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)) '())))