boernel/lilypond-common-includes
10
0
Fork 0
Code Issues 10 Pull Requests Packages Projects Releases Wiki Activity

toc for authors

Browse Source
This commit is contained in:
tux 2024-12-22 23:25:49 +01:00
parent eca352b6d0
commit 15c27c271f
1 changed files with 49 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
toc_include.ly
View File

@ -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)) '())))