%%% Extrahiert Informationen aus einem ly:music-Objekt und liefert eine alist
%%% mit String-Werten zurueck (z.B. ((time . "4/4") (key . "d minor"))).
%%% Benoetigt LilyPond >= 2.26.

%% note-name->lily-string liegt im Modul (lily display-lily).
#(use-modules (lily display-lily))

#(begin

   ;; --- Taktangabe --------------------------------------------------------

   ;; Numerator einer Taktangabe kann eine Zahl oder eine Liste sein.
   (define (numerator->string num)
     (if (list? num)
         (string-join (map number->string num) "+")
         (number->string num)))

   ;; Ein einzelner Bruch ist ein Paar (numerator . denominator), der
   ;; Numerator eine Zahl oder eine Liste (z.B. 3+3/8).
   (define (fraction->string frac)
     (string-append (numerator->string (car frac)) "/"
                    (number->string (cdr frac))))

   ;; Liefert die Taktangabe als String (z.B. "4/4", "3+3/8" oder
   ;; "3+3/8 + 2/8") oder #f. time-signature ist ein Bruch oder bei
   ;; zusammengesetzten Taktarten (\timeAbbrev, \compoundMeter) eine
   ;; Liste von Bruechen.
   (define (time-music->string m)
     (let ((ts (ly:music-property m 'time-signature)))
       (and (pair? ts)
            (if (number? (cdr ts))
                (fraction->string ts)
                (string-join (map fraction->string ts) " + ")))))

   ;; --- Tempo ---------------------------------------------------------------

   ;; Liefert die Tempoangabe als String (z.B. "4 = 130", "4. = 60-70",
   ;; "Allegro" oder "Allegro (4 = 130)") oder #f.
   (define (tempo-music->string m)
     (let* ((unit (ly:music-property m 'tempo-unit))
            (count (ly:music-property m 'metronome-count))
            (text (ly:music-property m 'text))
            (unit-s (and (ly:duration? unit)
                         (string-append
                          (number->string (expt 2 (ly:duration-log unit)))
                          (make-string (ly:duration-dot-count unit) #\.))))
            (count-s (cond ((number? count) (number->string count))
                           ((pair? count) (ly:format "~a-~a" (car count) (cdr count)))
                           (else #f)))
            (metronome-s (and unit-s count-s (string-append unit-s " = " count-s)))
            (text-s (and (markup? text) (markup->string text))))
       (cond
        ((and text-s metronome-s) (string-append text-s " (" metronome-s ")"))
        (metronome-s metronome-s)
        (text-s text-s)
        (else #f))))

   ;; --- Tonart ------------------------------------------------------------

   ;; Liefert die Tonart als String (z.B. "d minor" oder "c major") oder #f.
   ;; Vorgehen wie in LilyPonds eigenem \displayMusic (define-music-display-
   ;; methods.scm): pitch-alist nach c zuruecktransponieren und mit den
   ;; bekannten Modus-Definitionen vergleichen. note-name->lily-string liefert
   ;; den Grundton in der aktuell eingestellten Notensprache.
   (define (key-music->string m)
     (let ((tonic (ly:music-property m 'tonic))
           (alist (ly:music-property m 'pitch-alist)))
       (and (ly:pitch? tonic) (pair? alist)
            (let* ((c-alist (ly:transpose-key-alist alist (- tonic)))
                   (mode (any (lambda (mode)
                                (and (equal? (ly:parser-lookup mode) c-alist)
                                     (symbol->string mode)))
                              '(major minor))))
              (and mode
                   (string-append (symbol->string (note-name->lily-string tonic))
                                  " " mode))))))

   ;; --- Header-Metadaten ----------------------------------------------------

   ;; Header-Felder, die eigentlich Layoutsachen sind (gehoerten nach paper)
   ;; und deshalb nicht mit exportiert werden.
   (define ignored-header-fields
     '(titlesize titletopspace tagline between-poet-and-composer-markup))

   ;; categories ist im Header ein String mit Leerzeichen ("trist satz")
   ;; und wird als Liste von Woertern exportiert.
   (define (header-value key value)
     (if (and (eq? key 'categories) (string? value))
         (string-tokenize value)
         value))

   ;; Nimmt einen Bookpart entgegen (wie HEADER aus pool_bottom.ily) und
   ;; liefert dessen Header-Felder als alist, z.B.
   ;; ((title . "Ako umram") (authors . (("..." text melody))) ...).
   ;; Die Werte bleiben unveraendert, wie sie im \header definiert wurden
   ;; (Strings, Listen, Markups ...).
   (define (bookpart->header-alist bookpart)
     (let ((header (ly:book-header bookpart)))
       (if (module? header)
           (sort
            (filter-map (lambda (entry)
                          (and (variable-bound? (cdr entry))
                               (not (memq (car entry) ignored-header-fields))
                               (cons (car entry)
                                     (header-value (car entry)
                                                   (variable-ref (cdr entry))))))
                        (module-map cons header))
            (lambda (a b)
              (string<? (symbol->string (car a))
                        (symbol->string (car b)))))
           '())))

   ;; --- Lyrics --------------------------------------------------------------

   ;; Silbentext (String oder Markup) als String. Eine Tilde verbindet als
   ;; Lyric-Bindebogen zwei Woerter auf einer Note und wird zum Leerzeichen.
   (define (syllable->string text)
     (let ((s (cond ((string? text) text)
                    ((markup? text) (markup->string text))
                    (else ""))))
       (string-map (lambda (c) (if (char=? c #\~) #\space c)) s)))

   ;; Stanza-Beschriftung, wie sie gedruckt wuerde; vgl. handle-stanza-numbers
   ;; bzw. refMarkupFormatter/bridgeMarkupFormatter in
   ;; basic_format_and_style_settings.ily. text ist ein direkt per
   ;; \set stanza = "..." gesetzter Wert und gewinnt. Mit roman? werden die
   ;; Nummern roemisch formatiert (\romanStanza, z.B. fremdsprachige
   ;; Originalstrophen).
   (define (stanza-label type numbers text roman?)
     (define (number->label n)
       (if roman? (format #f "~@r" n) n))
     (define (joined-numbers)
       (string-join (map (lambda (n) (ly:format "~a" (number->label n))) numbers)
                    ", "))
     (define (formatted plain with-numbers)
       (if (null? numbers)
           (ly:parser-lookup plain)
           (ly:format (ly:parser-lookup with-numbers) (joined-numbers))))
     (cond
      (text text)
      ((eq? type 'ref) (formatted 'refString 'refStringWithNumbers))
      ((eq? type 'bridge) (formatted 'bridgeString 'bridgeStringWithNumbers))
      ((pair? numbers)
       (string-join
        (map (lambda (n)
               (format #f (ly:parser-lookup 'stanzaFormat) (number->label n)))
             numbers)
        ", "))
      (else "")))

   ;; Wandelt ein Lyrics-Music-Objekt (eine Zeile aus \addlyrics bzw. das
   ;; Argument von \chordlyrics) in eine Liste von Eintraegen der Form
   ;; (marked? nummern . ((stanza . "1.") (type . verse) (text . "Auf die ...")))
   ;; Silben werden an HyphenEvents wieder zu Woertern zusammengesetzt.
   ;; Strophengrenzen ergeben sich aus den StanzaNumber-Overrides von
   ;; #(stanza n), \ref und \bridge sowie aus \set stanza = "...".
   ;; marked? ist #f fuer Fortsetzungsfragmente: Abschnitte ohne Marker oder
   ;; mit dem Zeilenumbruch-Marker \set stanza = "-" (right-/leftHyphen).
   ;; \set stanza mit Markup-Wert (Wiederholungszeichen, "D.S." usw.) ist
   ;; reine Dekoration mitten im Vers und beginnt keine neue Strophe.
   (define (lyric-line->stanzas lyrics)
     (let ((stanzas '())    ; fertige Eintraege, rueckwaerts
           (words '())      ; fertige Woerter der aktuellen Strophe, rueckwaerts
           (word "")        ; offene Silbenkette
           (type #f)        ; 'verse / 'ref / 'bridge
           (numbers '())    ; Strophennummern
           (set-label #f)   ; direkt gesetztes \set stanza = "..."
           (roman #f)       ; \romanStanza: Nummern roemisch formatieren
           (pending-override #f)  ; \override-stanza vor dem naechsten Marker
           (override-numbers #f)) ; gedruckte Nummern der aktuellen Strophe
       (define (flush-word!)
         (unless (string-null? word)
           (set! words (cons word words))
           (set! word "")))
       (define (flush-stanza!)
         (flush-word!)
         (when (or type set-label (pair? words))
           (let ((display-numbers (or override-numbers numbers)))
             (set! stanzas
                   (cons (cons* (if (or type (and set-label (not (string=? set-label "-")))) #t #f)
                                display-numbers
                                (list (cons 'stanza (stanza-label type display-numbers set-label roman))
                                      (cons 'type (or type 'verse))
                                      (cons 'text (string-join (reverse words) " "))))
                         stanzas)))
           (set! words '())
           (set! type #f)
           (set! numbers '())
           (set! set-label #f)
           (set! override-numbers #f)))
       ;; Ein neuer Marker beendet die laufende Strophe, sobald schon Text da ist.
       (define (marker!)
         (when (or (pair? words) (not (string-null? word)))
           (flush-stanza!)))
       (define (handle-lyric-event m)
         (let ((s (syllable->string (ly:music-property m 'text)))
               (hyphen? (any (lambda (a)
                               (eq? (ly:music-property a 'name) 'HyphenEvent))
                             (ly:music-property m 'articulations '()))))
           ;; "_"-Skips (Melisma-Platzhalter) kommen als " " an und werden
           ;; ignoriert; ein an einem Trennstrich offenes Wort ("ru -- _ hig")
           ;; laeuft darueber weiter.
           (unless (string-null? (string-trim-both s))
             (set! word (string-append word s))
             (unless hyphen? (flush-word!)))))
       (define (handle-override m)
         (when (eq? (ly:music-property m 'symbol) 'StanzaNumber)
           (let ((path (ly:music-property m 'grob-property-path))
                 (value (ly:music-property m 'grob-value)))
             (cond
              ((equal? path '(details custom-stanza-type))
               (marker!)
               (set! type value)
               ;; \override-stanza wirkt (\once) auf den naechsten Marker
               (set! override-numbers pending-override)
               (set! pending-override #f))
              ((equal? path '(details custom-stanza-numbers))
               (marker!)
               (set! numbers (if (list? value) value (list value))))
              ((equal? path '(details custom-stanzanumber-override))
               (set! pending-override (if (list? value) value (list value))))
              ((equal? path '(style))
               (set! roman (eq? value 'roman)))))))
       (define (handle-set m)
         (let ((value (ly:music-property m 'value)))
           ;; Nur String-Werte; Markups (Wiederholungszeichen etc.) sind
           ;; Dekoration mitten im Vers und keine Strophengrenze.
           (when (and (eq? (ly:music-property m 'symbol) 'stanza)
                      (string? value))
             (marker!)
             (set! set-label value))))
       (define (walk m)
         (case (ly:music-property m 'name)
           ((LyricEvent) (handle-lyric-event m))
           ((OverrideProperty) (handle-override m))
           ((PropertySet) (handle-set m))
           (else
            (let ((element (ly:music-property m 'element)))
              (if (ly:music? element) (walk element))
              (for-each (lambda (e) (if (ly:music? e) (walk e)))
                        (ly:music-property m 'elements))))))
       (walk lyrics)
       (flush-stanza!)
       (merge-reprinted (reverse stanzas))))

   ;; Beim Zeilenumbruch im Notenbild wird die Strophennummer manchmal erneut
   ;; gedruckt (z.B. \firstVerseB #(stanza 1) \firstVerseC). Ein Marker
   ;; direkt nach einer Strophe mit gleicher Kennung oder deren
   ;; Nummern-Obermenge (#(stanza 2 3) nach Strophe 2) setzt diese fort,
   ;; statt eine neue Strophe zu beginnen.
   (define (merge-reprinted entries)
     (let loop ((remaining entries) (acc '()))
       (if (null? remaining)
           (reverse acc)
           (let ((entry (car remaining)))
             (if (and (pair? acc)
                      (car entry)          ; aktueller Eintrag markiert
                      (car (car acc))      ; vorheriger Eintrag markiert
                      (let* ((prev (car acc))
                             (prev-alist (cddr prev))
                             (alist (cddr entry))
                             (prev-numbers (cadr prev))
                             (prev-label (assq-ref prev-alist 'stanza)))
                        (or (and (not (string-null? prev-label))
                                 (string=? prev-label (assq-ref alist 'stanza)))
                            (and (eq? (assq-ref prev-alist 'type)
                                      (assq-ref alist 'type))
                                 (pair? prev-numbers)
                                 (every (lambda (n) (member n (cadr entry)))
                                        prev-numbers)))))
                 (begin
                   (append-fragment-text! (cddr (car acc)) (cddr entry))
                   (loop (cdr remaining) acc))
                 (loop (cdr remaining) (cons entry acc)))))))

   ;; Haengt den Text eines Fortsetzungsfragments an eine Strophe an.
   (define (append-fragment-text! target fragment)
     (let ((target-cell (assq 'text target))
           (fragment-text (assq-ref fragment 'text)))
       (unless (string-null? fragment-text)
         (set-cdr! target-cell
                   (if (string-null? (cdr target-cell))
                       fragment-text
                       (string-append (cdr target-cell) " " fragment-text))))))

   ;; Fuegt die Strophen-Eintraege mehrerer Lyric-Zeilen (Ergebnisse von
   ;; lyric-line->stanzas) zu einer flachen Strophenliste zusammen. Manche
   ;; Lieder verteilen eine Strophe auf mehrere Zeilen unter den Noten
   ;; (Fragmente mit \set stanza = "-" bzw. ohne Marker): Fortsetzungen
   ;; werden innerhalb einer Zeile an die vorhergehende markierte Strophe
   ;; angehaengt; Zeilen ganz ohne markierte Strophen positionsweise an die
   ;; markierten Strophen der letzten Zeile, die welche hatte.
   (define (merge-lyric-lines lines)
     (let ((result '())        ; fertige Strophen-alists, rueckwaerts
           (last-marked '()))  ; markierte alists der letzten markierten Zeile
       (for-each
        (lambda (line)
          (let ((line-marked (filter-map (lambda (e) (and (car e) (cddr e))) line)))
            (if (and (null? line-marked) (pair? last-marked))
                ;; Zeile nur aus Fortsetzungen: k-tes Fragment an k-te
                ;; markierte Strophe der Vorzeile, Ueberzaehlige an deren letzte.
                (let loop ((entries line) (targets last-marked))
                  (when (pair? entries)
                    (append-fragment-text! (car targets) (cddar entries))
                    (loop (cdr entries)
                          (if (null? (cdr targets)) targets (cdr targets)))))
                ;; Zeile mit markierten Strophen (oder erste Zeile ueberhaupt):
                ;; Fortsetzungen an die vorhergehende Strophe der Zeile.
                (begin
                  (let loop ((entries line)
                             (prev (if (pair? last-marked) (last last-marked) #f)))
                    (when (pair? entries)
                      (let ((marked? (caar entries))
                            (stanza-alist (cddar entries)))
                        (if (or marked? (not prev))
                            (begin
                              (set! result (cons stanza-alist result))
                              (loop (cdr entries) stanza-alist))
                            (begin
                              (append-fragment-text! prev stanza-alist)
                              (loop (cdr entries) prev))))))
                  (when (pair? line-marked)
                    (set! last-marked line-marked))))))
        lines)
       (reverse result)))

   ;; Gruppiert alle LyricCombineMusic-Objekte im music-Baum nach ihrer
   ;; Stimme (associated-context, das \addlyrics/\lyricsto zuweisen).
   ;; Liefert eine Liste von Gruppen (je eine Liste von Lyrics-Music-
   ;; Objekten) in der Reihenfolge, in der die Stimmen zuerst auftauchen.
   (define (voice-groups music)
     (let* ((combines (extract-named-music music 'LyricCombineMusic))
            (contexts (delete-duplicates
                       (map (lambda (c) (ly:music-property c 'associated-context))
                            combines))))
       (map (lambda (ctx)
              (map (lambda (c) (ly:music-property c 'element))
                   (filter (lambda (c)
                             (equal? (ly:music-property c 'associated-context) ctx))
                           combines)))
            contexts)))

   ;; Liefert die Strophen aller Stimmen unter den Noten, die selbst echte
   ;; Strophen/Refrains/Bridges tragen (mindestens einen markierten
   ;; Abschnitt haben, vgl. lyric-line->stanzas) -- filtert damit rein
   ;; dekorative Gegen- oder Echostimmen heraus (z.B. wiederholte
   ;; Lautmalerei ohne eigene Strophennummer). "Die erste Stimme im
   ;; Dokument" ist dafuer kein verlaessliches Kriterium: welche Stimme
   ;; die Hauptmelodie mit dem vollstaendigen Strophentext singt, wechselt
   ;; von Lied zu Lied (mal Stimme 1, mal 2, je nach Satz).
   ;; Qualifizierende Stimmen werden zusammengefuehrt (verschiedene
   ;; Sprachfassungen tragen z.B. beide eigene Strophen); dabei bildet die
   ;; Stimme mit den meisten eigenen Strophen ('verse, nicht Ref/Bridge)
   ;; das Rueckgrat, in das die anderen einsortiert werden -- sonst wuerde
   ;; ein von mehreren Stimmen gemeinsam gesungener Refrain, der im
   ;; Dokument vor der eigentlichen Strophe auftaucht, deren Platz vor der
   ;; Strophe 1 belegen.
   (define (main-voice-lyrics music)
     (define (verse-count stanzas)
       (count (lambda (e) (eq? (assq-ref e 'type) 'verse)) stanzas))
     (define (any-marked? lines) (any (lambda (line) (any car line)) lines))
     (let* ((groups (map (lambda (group) (map lyric-line->stanzas group))
                         (voice-groups music)))
            (with-marks (filter any-marked? groups))
            ;; Der Ausschluss unmarkierter Stimmen lohnt nur, wenn es
            ;; ueberhaupt eine ALTERNATIVE gibt: hat KEINE Stimme einen
            ;; echten Strophenmarker, gibt es kein "Rueckgrat" zum
            ;; Einsortieren -- dann wie frueher nur die erste Stimme nehmen
            ;; (sonst wuerden z.B. mehrere Satzstimmen mit identischem,
            ;; unmarkiertem Text ihren Kehrreim mehrfach liefern, weil sich
            ;; unmarkierte Eintraege ohne Strophennummer nicht als Duplikat
            ;; erkennen lassen). Nur EINE Stimme insgesamt ist ein
            ;; Sonderfall davon (erste = einzige).
            (qualifying (cond
                         ((pair? with-marks) with-marks)
                         ((pair? groups) (list (car groups)))
                         (else '())))
            (merged-per-group (map merge-lyric-lines qualifying))
            (ranked (sort (iota (length merged-per-group))
                          (lambda (a b) (> (verse-count (list-ref merged-per-group a))
                                           (verse-count (list-ref merged-per-group b)))))))
       (fold (lambda (i acc) (add-missing-stanzas acc (list-ref merged-per-group i)))
             '() ranked)))

   ;; --- Textseiten-Strophen aus dem Render-Collector ------------------------

   ;; Liest die Strophen der Textseiten aus dem per-Song-Store (chordpro.ily),
   ;; den der ChordPro_score_collector beim Rendern der \chordlyrics-Scores
   ;; fuellt. Dort ist Tag-Filterung, \override-stanza usw. bereits von
   ;; LilyPond selbst entschieden -- unsichtbare Verse tauchen gar nicht
   ;; erst auf. Die Dokumentreihenfolge liefert
   ;; chordpro-song-ordered-verse-indices (die Interpretation laeuft
   ;; rueckwaerts und bei mehrspaltigen group-verses verschraenkt).
   ;; Liefert Eintraege wie lyric-line->stanzas:
   ;; ((stanza . "2.") (type . verse) (text . "Die Haeuser ..."))
   (define (collector-song->stanzas song)
     ;; Silben eines Verses in Sammelreihenfolge; Eintrag: (moment text hyphen? idx)
     (define (verse-syllables idx)
       (reverse (filter (lambda (s) (= (cadddr s) idx))
                        (chordpro-song-syllables song))))
     ;; Gedruckte Labels koennen Wiederholungszeichen tragen ("2.𝄆") --
     ;; die gehoeren nicht ins Label.
     (define (clean-label s)
       (string-trim-both
        (string-delete (lambda (c) (memv c '(#\𝄆 #\𝄇))) s)))
     ;; Silben zu Woertern: Trennstriche verbinden, "_"-Extender (kommen als
     ;; Whitespace an) werden ueberlaufen, ohne das offene Wort zu schliessen.
     (define (syllables->text syls)
       (let loop ((rest syls) (word "") (words '()))
         (if (null? rest)
             (string-join
              (reverse (if (string-null? word) words (cons word words)))
              " ")
             (let* ((s (syllable->string (cadr (car rest))))
                    (hyphen? (caddr (car rest))))
               (if (string-null? (string-trim-both s))
                   (loop (cdr rest) word words)
                   (if hyphen?
                       (loop (cdr rest) (string-append word s) words)
                       (loop (cdr rest) ""
                             (cons (string-append word s) words))))))))
     (filter-map
      (lambda (idx)
        (let ((syls (verse-syllables idx))
              (entry (assoc idx (chordpro-song-stanza-numbers song))))
          (and (pair? syls)
               (list (cons 'stanza (clean-label
                                    (or (and entry (cadr entry)) "")))
                     (cons 'type (or (and entry (caddr entry)) 'verse))
                     (cons 'text (syllables->text syls))))))
      (chordpro-song-ordered-verse-indices song)))

   ;; Dieselbe Strophe? Gleiche Kennung allein reicht nicht: zweisprachige
   ;; Lieder nutzen dieselben Nummern fuer Uebersetzung und Original. Die
   ;; Texte muessen sich auch aehneln (mindestens die Haelfte der Woerter
   ;; der kuerzeren Fassung kommt in der laengeren vor).
   (define (same-stanza-text? a b)
     (define (word-list s)
       (map string-downcase (string-tokenize s char-set:letter)))
     (let* ((wa (word-list a))
            (wb (word-list b))
            (shorter (if (<= (length wa) (length wb)) wa wb))
            (longer  (if (<= (length wa) (length wb)) wb wa)))
       (or (null? shorter)
           (>= (count (lambda (w) (member w longer)) shorter)
               (/ (length shorter) 2)))))

   ;; Wie merge-stanza-lists, aber bei Konflikt gewinnt BASE statt der
   ;; einzumischenden Liste: fuer das Zusammenfuehren mehrerer Hauptstimmen-
   ;; Kandidaten (main-voice-lyrics), wo die 'reichste' Stimme (meiste
   ;; eigene Strophen) die kanonische Fassung liefert und andere Stimmen
   ;; nur FEHLENDE Strophen ergaenzen duerfen -- z.B. wenn Sopran und Alt
   ;; beide "1." tragen, der Alt aber eine gekuerzte Textvariante singt
   ;; (vgl. Sieh_des_Herbstes_Geisteshelle: infotext "Strophenteile in
   ;; Klammern sind die Textvarianten im Alt").
   (define (add-missing-stanzas base additional)
     (fold
      (lambda (entry acc)
        (let* ((key (assq-ref entry 'stanza))
               (found (and (not (string-null? key))
                          (not (string=? key "-"))
                          (find (lambda (e) (and (equal? (assq-ref e 'stanza) key)
                                                 (same-stanza-text?
                                                  (assq-ref e 'text)
                                                  (assq-ref entry 'text))))
                                acc))))
          (if found acc (append acc (list entry)))))
      base
      additional))

   ;; Fuegt Musik- und Textseiten-Strophen zusammen: gleiche Strophen nur
   ;; einmal, wobei die Fassung aus den Textseiten die unter den Noten
   ;; ersetzt (dort steht meist die vollstaendige Fassung).
   (define (merge-stanza-lists music-stanzas text-stanzas)
     (let loop ((merged music-stanzas) (remaining text-stanzas))
       (if (null? remaining)
           merged
           (let* ((entry (car remaining))
                  (key (assq-ref entry 'stanza))
                  (found (and (not (string-null? key))
                              (not (string=? key "-"))
                              (find (lambda (e)
                                      (and (equal? (assq-ref e 'stanza) key)
                                           (same-stanza-text?
                                            (assq-ref e 'text)
                                            (assq-ref entry 'text))))
                                    merged))))
             (loop (if found
                       (map (lambda (e) (if (eq? e found) entry e)) merged)
                       (append merged (list entry)))
                   (cdr remaining))))))

   ;; Extrahiert alle Strophen/Refrain/Bridge-Texte eines Liedes: die Strophen
   ;; unter den Noten aus music (die Hauptstimme(n), siehe main-voice-lyrics),
   ;; die Textstrophen aus dem Render-Collector-Store des Liedes (song, darf
   ;; #f sein).
   (define (extract-lyrics music song)
     (merge-stanza-lists
      (main-voice-lyrics music)
      (if song (collector-song->stanzas song) '())))

   ;; --- Hauptfunktion -----------------------------------------------------

   ;; Liefert das erste Music-Objekt mit gegebenem Namen (oder #f).
   (define (first-named-music music music-name)
     (let ((matches (extract-named-music music music-name)))
       (and (pair? matches) (car matches))))

   ;; Nimmt ly:music entgegen und liefert eine alist mit String-Werten.
   (define (music->data-alist music)
     (let* ((time-m  (first-named-music
                      music '(TimeSignatureMusic ReferenceTimeSignatureMusic)))
            (key-m   (first-named-music music 'KeyChangeEvent))
            (tempo-m (first-named-music music 'TempoChangeEvent))
            (time-s  (and time-m  (time-music->string time-m)))
            (key-s   (and key-m   (key-music->string key-m)))
            (tempo-s (and tempo-m (tempo-music->string tempo-m))))
       (append
        (if time-s  (list (cons 'time time-s)) '())
        (if key-s   (list (cons 'key key-s)) '())
        (if tempo-s (list (cons 'tempo tempo-s)) '()))))

    ;; song ist der per-Song-Store-Eintrag aus chordpro.ily (oder #f, wenn
    ;; keine Textseiten gerendert wurden) -- er liefert die Textseiten-
    ;; Strophen. Darf erst NACH dem Rendern der Textseiten aufgerufen
    ;; werden (delayed stencil), vorher ist der Store leer. song-id ist
    ;; der Liedname (Einzellied: Ausgabename; Buch: der bei \includeSong
    ;; angegebene Dateiname) und landet unter dem Key song_id.
    (define (extract-song-data header music song song-id)
      (let ((header-alist (bookpart->header-alist header))
            (music-alist (music->data-alist music))
            (lyrics-list (extract-lyrics music song)))
        (append header-alist
                (list (cons 'song_id song-id)
                      (cons 'musical music-alist)
                      (cons 'lyrics lyrics-list)))))

    ;; Unsichtbarer Stencil fuer die Einzellied-YAML: schreibt <key>.yml
    ;; per delay-stencil-evaluation erst bei der Ausgabe, wenn der
    ;; Render-Collector alle Textseiten-Strophen gesammelt hat. header und
    ;; music werden beim Anhaengen (Parse-Zeit in layout_bottom) gebunden.
    (define (yaml-delayed-song-write key header music)
      (ly:make-stencil
       `(delay-stencil-evaluation
         ,(delay (begin
                   (scm->yml-file (string-append key ".yml")
                                  (extract-song-data header music
                                                     (hash-ref chordpro-song-store key)
                                                     key))
                   empty-stencil))))))