Am Sa., 19. Nov. 2022 um 14:48 Uhr schrieb Jean Abou Samra <j...@abou-samra.fr>: > > Le 19/11/2022 à 14:43, Thomas Morley a écrit : > > Though, I can't use a modified version of the new code setting > > `toc-items' because dong so in an own ly-file causes: > > fatal error: call-after-session used after session start > > > This comes from > > (call-after-session (lambda () > (hash-clear! toc-hashtab) > (set! toc-alist '()) > (hash-clear! toc-name-id-hashtab))) > > This clears the TOC data structures after processing each > .ly file, to ensure there are no leaks from a .ly file to > the next if processing several files with the same lilypond > invocation. > > call-after-session can only be used in LilyPond's internal > .ly files, not in user files. > > If you don't care about that, just delete it. > > Best, > Jean > > Hi Jean,
thanks for the hint. Attached my current (ugly) workaround. Thanks, Harm
\version "2.23.80" %% TODO: this should be per-book, issue #4227 #(let (;; Maps TOC item IDs (symbols) to alists (toc-hashtab (make-hash-table)) ;; Same, in alist form. This is what we eventually want to return, but a ;; hash table avoids quadratic algorithms while constructing the TOC tree. (toc-alist '()) ;; Map names, i.e. terminal symbols of the paths ;; (\tocItem foo.bar.baz ... has the name 'baz) to ;; TOC IDs. (toc-name-id-hashtab (make-hash-table))) ;; NB Commenting next lines may cause bleed-over into next session, while ;; doing: lilypond file-1.ly file-2.ly ;; Though otherwise we cannpt use this coding ;; ;; (call-after-session (lambda () ;; (hash-clear! toc-hashtab) ;; (set! toc-alist '()) ;; (hash-clear! toc-name-id-hashtab))) (set! add-toc-item! (lambda* (markup-symbol text #:optional raw-path) (let* ((id (gensym "toc")) (path (cond ((symbol? raw-path) (list raw-path)) ;; Without a raw-path, we add an entry at the toplevel, which ;; is the same as a one-element raw-path. ((or (not raw-path) (null? raw-path)) (list id)) ((list? raw-path) raw-path) (else (begin (ly:warning (_i "Invalid toc label: ~a") raw-path)) (list id)))) (level ;; Find which existing TOC entry, if any, to attach this entry to. ;; The principle is that the first element of path is interpreted specially: ;; it can refer to a previously defined nested node, as with ;; \tocItem foo.bar "x" ;; \tocItem bar.baz "y" ;; This attaches bar as a subtree of foo, which can be handy in ;; large nested TOCs. If there are several possibilities (foo.bar ;; and baz.bar), we choose the one that added last. This is ;; achieved by simply overwriting any existing entry in ;; toc-name-id-hashtab when doing the hashq-set!. (match path ((single) (hashq-set! toc-name-id-hashtab single id) 0) ((head . tail) (let* ((node-id (hashq-ref toc-name-id-hashtab head)) (entry (and node-id (hashq-ref toc-hashtab node-id)))) (let loop ((path path) ;; entry corresponds to the entry for the first element ;; in the path. path still contains its name so a warning ;; can be emitted if entry is #f. (entry entry) (level (and entry (1+ (assq-ref entry 'level))))) (if entry (let ((children (assq-ref entry 'children))) (match path ((head name) ;; The last component is a newly created node. (hashq-set! children name id) (hashq-set! toc-name-id-hashtab name id) level) ((head . (and remaining (child . rest))) (loop remaining (let ((child-id (hashq-ref children child))) (and child-id (hashq-ref toc-hashtab child-id))) (1+ level))))) (begin (ly:warning (G_ "TOC node ~a not defined") (car path)) ;; Insert the node on the toplevel. (let ((final-name (last path))) (hashq-set! toc-name-id-hashtab final-name id)) 0))))))) (alist `((text . ,text) (name . ,(car path)) (toc-markup . ,markup-symbol) (children . ,(make-hash-table)) (level . ,level)))) ;; Register the new entry. (hashq-set! toc-hashtab id alist) (set! toc-alist (acons id alist toc-alist)) (label id)))) (set! toc-items (lambda () (reverse toc-alist)))) %% Due to issue 4227 %% https://gitlab.com/lilypond/lilypond/-/issues/4227 %% we change `table-of-contents`. %% For now we abuse the 'name entry of every toc-item, if it equals %% the newly provided `toc-name` property we proceed. The default %% `toc-name` results in the same behaviour as before. %% Otherwise return #f, i.e. this toc-item will be filtered out. #(define-markup-list-command (table-of-contents layout props) () #:properties ((baseline-skip) (toc-name 'all)) ( _i "Outputs the table of contents, using the paper variable @code{tocTitleMarkup} for its title, then the list of lines built using the @code{tocItem} music function. Usage: @code{\\markuplist \\table-of-contents}" ) (let ((titleMarkup (ly:output-def-lookup layout 'tocTitleMarkup)) (indentMarkup (ly:output-def-lookup layout 'tocIndentMarkup)) (toplevelFormatter (ly:output-def-lookup layout 'tocFormatMarkup)) (toc-alist (toc-items))) (ly:output-def-set-variable! layout 'label-alist-table (append (ly:output-def-lookup layout 'label-alist-table) toc-alist)) (cons (interpret-markup layout props titleMarkup) (space-lines baseline-skip (filter-map (lambda (toc-item) (let ((alist (cdr toc-item))) (if (or (eq? (assoc-get 'name alist) toc-name) (eq? toc-name 'all)) (let* ((label (car toc-item)) (toc-markup (assoc-get 'toc-markup alist)) (text (assoc-get 'text alist)) (level (assoc-get 'level alist))) (interpret-markup layout (cons (list (cons 'toc:page (markup #:with-link label #:page-ref label "XXX" "?")) (cons 'toc:text (markup #:with-link label text)) (cons 'toc:label label) (cons 'toc:level level) (cons 'toc:toplevel-formatter toplevelFormatter) (cons 'toc:indent (make-line-markup (make-list level indentMarkup)))) props) (ly:output-def-lookup layout toc-markup))) #f))) toc-alist))))) \book { \markuplist \override-lines #'(toc-name . foo) \table-of-contents \tocItem foo \markup "bookI" { r1 \tocItem foo \markup "bookIb" r2 r } } \book { \markuplist \override #'(toc-name . buzz) \table-of-contents \tocItem buzz \markup \italic "bookII" { r1 \tocItem buzz \markup \italic "bookIIb" r2 r } }