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

Refactor toc code

Browse Source
This commit is contained in:
tux
2025-06-15 12:06:27 +02:00
parent 7a65d056d6
commit a288248da3
1 changed files with 36 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
toc_include.ly
View File

@ -167,22 +167,24 @@
(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)()
#:properties ((index:text "")
(index:alternative #f)
(index:page #f)
(line-width))
(let* (
(text (chain-assoc-get 'index:text props))
(page (chain-assoc-get 'index:page props))
(width (-
(chain-assoc-get 'line-width props)
line-width
(interval-length (ly:stencil-extent (interpret-markup layout props "XXXX") X))))
(lines-reversed
(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))))))
(last-line-with-dots (make-fill-with-pattern-markup 1 RIGHT "." (car lines-reversed) page))
(reverse (map (lambda (stil) (markup #:stencil stil))
(wordwrap-string-internal-markup-list layout
(prepend-alist-chain 'line-width width
(if index:alternative
(prepend-alist-chain 'font-shape 'italic props)
props))
#f
index:text))))
(last-line-with-dots (make-fill-with-pattern-markup 1 RIGHT "." (car lines-reversed) index:page))
(lines-without-dots (cdr lines-reversed))
(target-line-size-markup
(make-column-markup
@ -204,7 +206,7 @@
\paper {
indexItemMarkup = \markup {
\index-item-with-pattern
\sans \index-item-with-pattern
}
indexSectionMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
\sans \bold \fontsize #3 \fromproperty #'index:text
@ -228,12 +230,17 @@
#(define (prepare-item-markup items layout)
(map (lambda (index-item)
(let ((label (car index-item))
(index-markup (cadr index-item))
(text (caddr index-item)))
(let* ((label (car index-item))
(index-markup (cadr index-item))
(textoptions (caddr index-item))
(text (chain-assoc-get 'rawtext textoptions))
(alternative (chain-assoc-get 'alternative textoptions))
(songnumber (chain-assoc-get 'songnumber textoptions)))
(markup #:override (cons 'index:label label)
#:override (cons 'index:page (markup #:custom-page-number label -1))
#:override (cons 'index:text text)
#:override (cons 'index:alternative alternative)
#:override (cons 'index:songnumber songnumber)
(ly:output-def-lookup layout index-markup))))
(items)))
@ -254,12 +261,12 @@
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))
(add-index-item! 'indexItemMarkup (prepend-alist-chain 'rawtext 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))
(add-index-item! 'indexSectionMarkup (prepend-alist-chain 'rawtext text '()) sorttext))
#(define (extract-and-check-vars-from-header bookheader varlist)
(let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0)))
@ -288,26 +295,28 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
))
(let*
(
(extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors)))
(extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors songnumber)))
(title (assq-ref extractedheadervars 'title))
(starttext (assq-ref extractedheadervars 'starttext))
(alttitle (assq-ref extractedheadervars 'alttitle))
(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)))
(songnumber (assq-ref extractedheadervars 'songnumber))
(textoptions (lambda (text alternative) `(((rawtext . ,text) (alternative . ,alternative) (songnumber . ,songnumber)))))
(add-to-toc! (lambda (toctitle alternative)
(add-index-item! 'indexItemMarkup (textoptions toctitle alternative) 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 categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
(if authors (add-author-index-item! (all-author-ids authors) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
(if starttext (add-to-toc! starttext #t))
(if alttitle
(if (list? alttitle)
(for-each (lambda (alt)
(add-to-toc! alt (cons (list (cons 'rawtext alt) (cons 'alternative #t)) '())))
(add-to-toc! alt #t))
alttitle)
(add-to-toc! alttitle (cons (list (cons 'rawtext alttitle) (cons 'alternative #t)) '()))))
(if title (add-to-toc! title (cons (list (cons 'rawtext title)) '())) #{ #})
(add-to-toc! alttitle #t)))
(if title (add-to-toc! title #f) #{ #})
))