Am Sa., 19. Nov. 2022 um 14:48 Uhr schrieb Jean Abou Samra <[email protected]>:
>
> 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 }
}
