extract meta data from lilypond compilation

* write that as yaml file next to the other outputs
* extract lyrics
* makes chordpro export work in songbooks
* more metadata for chordpro export

private_includes/base/all.ily

@@ -20,7 +20,8 @@
       "scm" file-name-separator-string filename
     )))))
     (scm-load "resolve_inherits.scm")
-    (scm-load "yaml_parser.scm")))
+    (scm-load "yaml_parser.scm")
+    (scm-load "yaml_writer.scm")))
 
 #(define (song-includes-data-path filename)
   (string-join
@@ -39,6 +40,7 @@
 \include "title_with_category_images.ily"
 \include "chord_settings.ily"
 \include "chordpro.ily"
+\include "data_extractor.ily"
 \include "transposition.ily"
 \include "markup_tag_groups_hack.ily"
 \include "verses_with_chords.ily"

private_includes/base/chordpro.ily

@@ -5,6 +5,199 @@
 #(use-modules (ice-9 format))
 #(use-modules (srfi srfi-1))
 
+%% Per-Song-Store
+%% ==============
+%% Der gesamte Sammel-Zustand liegt in einer Struktur pro Lied, gekeyt ueber
+%% den Liednamen (Buch: songfilename aus \setsongfilename bzw. includeSong;
+%% Einzellied: ly:parser-output-name). So koennen mehrere Lieder in einem
+%% Durchlauf (Liederbuch) getrennt gesammelt und geschrieben werden.
+%%
+%% Bewusst KEIN srfi-9-Record: Im Buch wird diese Datei pro Lied erneut
+%% evaluiert (jedes Lied inkludiert base_config -> all.ily), und srfi-9-
+%% Typen sind generativ -- alte Instanzen wuerden mit neu definierten
+%% Accessoren kollidieren. Hashtabelle + Prozedur-Accessoren sind gegen
+%% Re-Evaluation robust; der Store selbst ueberlebt sie per defined?-Idiom.
+
+#(define chordpro-song-store
+  (if (defined? 'chordpro-song-store) chordpro-song-store (make-hash-table)))
+
+#(define (chordpro-make-song key)
+  (let ((song (make-hash-table)))
+    (hashq-set! song 'key key)
+    ;; Alle Sammel-Listen werden in umgekehrter Reihenfolge aufgebaut (cons)
+    (hashq-set! song 'syllables '())
+    (hashq-set! song 'chords '())
+    (hashq-set! song 'breaks '())
+    (hashq-set! song 'stanza-numbers '())
+    ;; Format: (moment verse-idx text direction) fuer Inline-Marker wie repStart/repStop
+    (hashq-set! song 'inline-texts '())
+    ;; Zaehlt mit jedem \chordlyrics-Score des Lieds hoch
+    (hashq-set! song 'verse-index 0)
+    ;; Dokumentreihenfolge pro Vers: (idx seq pos sub). Die Interpretation
+    ;; der Textseiten laeuft in umgekehrter Dokumentreihenfolge, bei
+    ;; mehrspaltigen \group-verses zusaetzlich verschraenkt -- seq/pos
+    ;; stellen die Quellreihenfolge wieder her (siehe
+    ;; chordpro-song-ordered-verse-indices), sub ordnet Sub-Verse aus
+    ;; Marker-Splits hinter ihren Elternvers.
+    (hashq-set! song 'verse-order '())
+    ;; Akkorde, die {define:}-Direktiven brauchen
+    (hashq-set! song 'minor-chords '())
+    (hashq-set! song 'b-chords '())
+    (hashq-set! song 'h-chords '())
+    (hashq-set! song 'accidental-chords '())
+    (hashq-set! song 'title #f)
+    (hashq-set! song 'authors #f)
+    ;; Weitere ChordPro-Metadaten-Direktiven, aus dem Header/der Musik des
+    ;; Liedes befuellt (siehe chordpro-register-song-metadata) -- alle #f,
+    ;; wenn nicht ermittelbar, dann wird die jeweilige Direktive weggelassen.
+    (hashq-set! song 'copyright #f)
+    (hashq-set! song 'year #f)
+    (hashq-set! song 'key-signature #f)
+    (hashq-set! song 'time #f)
+    (hashq-set! song 'tempo #f)
+    ;; Schreibschutz: jedes Lied wird nur einmal geschrieben
+    (hashq-set! song 'written #f)
+    song))
+
+#(define (chordpro-song-key s) (hashq-ref s 'key))
+#(define (chordpro-song-syllables s) (hashq-ref s 'syllables))
+#(define (set-chordpro-song-syllables! s v) (hashq-set! s 'syllables v))
+#(define (chordpro-song-chords s) (hashq-ref s 'chords))
+#(define (set-chordpro-song-chords! s v) (hashq-set! s 'chords v))
+#(define (chordpro-song-breaks s) (hashq-ref s 'breaks))
+#(define (set-chordpro-song-breaks! s v) (hashq-set! s 'breaks v))
+#(define (chordpro-song-stanza-numbers s) (hashq-ref s 'stanza-numbers))
+#(define (set-chordpro-song-stanza-numbers! s v) (hashq-set! s 'stanza-numbers v))
+#(define (chordpro-song-inline-texts s) (hashq-ref s 'inline-texts))
+#(define (set-chordpro-song-inline-texts! s v) (hashq-set! s 'inline-texts v))
+#(define (chordpro-song-verse-index s) (hashq-ref s 'verse-index))
+#(define (set-chordpro-song-verse-index! s v) (hashq-set! s 'verse-index v))
+#(define (chordpro-song-verse-order s) (hashq-ref s 'verse-order))
+#(define (set-chordpro-song-verse-order! s v) (hashq-set! s 'verse-order v))
+#(define (chordpro-song-minor-chords s) (hashq-ref s 'minor-chords))
+#(define (set-chordpro-song-minor-chords! s v) (hashq-set! s 'minor-chords v))
+#(define (chordpro-song-b-chords s) (hashq-ref s 'b-chords))
+#(define (set-chordpro-song-b-chords! s v) (hashq-set! s 'b-chords v))
+#(define (chordpro-song-h-chords s) (hashq-ref s 'h-chords))
+#(define (set-chordpro-song-h-chords! s v) (hashq-set! s 'h-chords v))
+#(define (chordpro-song-accidental-chords s) (hashq-ref s 'accidental-chords))
+#(define (set-chordpro-song-accidental-chords! s v) (hashq-set! s 'accidental-chords v))
+#(define (chordpro-song-title s) (hashq-ref s 'title))
+#(define (set-chordpro-song-title! s v) (hashq-set! s 'title v))
+#(define (chordpro-song-authors s) (hashq-ref s 'authors))
+#(define (set-chordpro-song-authors! s v) (hashq-set! s 'authors v))
+#(define (chordpro-song-copyright s) (hashq-ref s 'copyright))
+#(define (set-chordpro-song-copyright! s v) (hashq-set! s 'copyright v))
+#(define (chordpro-song-year s) (hashq-ref s 'year))
+#(define (set-chordpro-song-year! s v) (hashq-set! s 'year v))
+#(define (chordpro-song-key-signature s) (hashq-ref s 'key-signature))
+#(define (set-chordpro-song-key-signature! s v) (hashq-set! s 'key-signature v))
+#(define (chordpro-song-time s) (hashq-ref s 'time))
+#(define (set-chordpro-song-time! s v) (hashq-set! s 'time v))
+#(define (chordpro-song-tempo s) (hashq-ref s 'tempo))
+#(define (set-chordpro-song-tempo! s v) (hashq-set! s 'tempo v))
+#(define (chordpro-song-written s) (hashq-ref s 'written))
+#(define (set-chordpro-song-written! s v) (hashq-set! s 'written v))
+
+#(define (chordpro-get-song key)
+  "Store-Eintrag zu key holen, bei Bedarf frisch anlegen."
+  (or (hash-ref chordpro-song-store key)
+      (let ((song (chordpro-make-song key)))
+        (hash-set! chordpro-song-store key song)
+        song)))
+
+%% Einzellied-Fallback fuer den Song-Key; layout_bottom setzt ihn auf
+%% (ly:parser-output-name). Im Buch kommt der Key stattdessen aus den
+%% Markup-Props (\setsongfilename), weil der geklonte Parser nur den
+%% Buchnamen kennt.
+#(define chordpro-default-song-key #f)
+
+#(define (chordpro-resolve-song-key props)
+  "Song-Key aus Markup-Props (Buch) oder dem Einzellied-Fallback."
+  (let ((from-props (and props (chain-assoc-get 'songfilename props #f))))
+    (cond
+      ((and (string? from-props) (not (string-null? from-props))) from-props)
+      (chordpro-default-song-key)
+      (else "output"))))
+
+%% Lied, in dessen Store der Collector-Engraver gerade schreibt. Wird von
+%% \chordlyrics vor der (synchronen) Score-Interpretation gesetzt.
+#(define chordpro-active-song-key #f)
+
+%% Props des laufenden \chordlyrics-Aufrufs -- der Collector loest damit
+%% Markup-Silben (\updown u.ae.) auf, deren \tag-Sichtbarkeit an
+%% tags-to-keep/tags-to-remove aus umgebenden \keep-with-tag haengt.
+#(define chordpro-active-props #f)
+
+%% Dokumentreihenfolge: \group-verses nimmt sich pro Aufruf eine
+%% Sequenznummer und stempelt seine Verse mit (seq . pos) in die Props;
+%% \chordlyrics ausserhalb einer Gruppe nimmt sich selbst eine Nummer.
+%% Da die Interpretation in umgekehrter Dokumentreihenfolge laeuft,
+%% ergibt seq absteigend + pos aufsteigend die Quellreihenfolge.
+#(define chordpro-doc-seq-counter
+  (if (defined? 'chordpro-doc-seq-counter) chordpro-doc-seq-counter 0))
+#(define chordpro-active-doc-order #f)
+
+%% Verse-Indizes eines Lieds in Dokumentreihenfolge (fuer Writer/Export).
+#(define (chordpro-song-ordered-verse-indices song)
+  (let* ((order-alist (chordpro-song-verse-order song))
+         (order-of (lambda (idx) (or (assv idx order-alist) (list idx 0 0 0)))))
+    (sort (iota (chordpro-song-verse-index song))
+          (lambda (a b)
+            (let ((oa (order-of a)) (ob (order-of b)))
+              ;; seq absteigend, pos aufsteigend, sub aufsteigend,
+              ;; Fallback: idx absteigend
+              (cond
+               ((not (= (cadr oa) (cadr ob))) (> (cadr oa) (cadr ob)))
+               ((not (= (caddr oa) (caddr ob))) (< (caddr oa) (caddr ob)))
+               ((not (= (cadddr oa) (cadddr ob))) (< (cadddr oa) (cadddr ob)))
+               (else (> a b))))))))
+
+%% Titel/Autoren aus basicSongInfo in den Store uebernehmen. Einzellied:
+%% layout_bottom nach dem Parsen; Buch: includeSong direkt nach dem Parsen
+%% des Lieds (basicSongInfo haelt dann genau dieses Lied).
+%% Musikalische Metadaten (Takt/Tonart/Tempo) kommen aus music->data-alist
+%% (data_extractor.ily) -- dieselbe Extraktion wie fuer den YAML-Export,
+%% nur zusaetzlich fuer ChordPro in dessen Notation umgewandelt.
+#(define (chordpro-register-song-metadata key)
+  (when (defined? 'basicSongInfo)
+    (let* ((header-alist (ly:module->alist basicSongInfo))
+           (title (assoc-ref header-alist 'title))
+           (authors (assoc-ref header-alist 'authors))
+           (copyright (assoc-ref header-alist 'copyright))
+           (year (or (assoc-ref header-alist 'year_text)
+                     (assoc-ref header-alist 'year_melody)))
+           (music-alist (and (defined? 'MUSIC) (ly:music? MUSIC) (music->data-alist MUSIC)))
+           (song (chordpro-get-song key)))
+      (when title
+        (set-chordpro-song-title! song
+          (cond ((markup? title) (markup->string title))
+                ((string? title) title)
+                (else #f))))
+      (when authors
+        (set-chordpro-song-authors! song authors))
+      (when (and (string? copyright) (not (string-null? copyright)))
+        (set-chordpro-song-copyright! song copyright))
+      (when (and (string? year) (not (string-null? year)))
+        (set-chordpro-song-year! song year))
+      (when music-alist
+        (let ((key-str (assoc-ref music-alist 'key))
+              (time-str (assoc-ref music-alist 'time))
+              (tempo-str (assoc-ref music-alist 'tempo)))
+          (when key-str
+            (set-chordpro-song-key-signature! song (lilypond-key->chordpro-key key-str)))
+          (when time-str
+            (set-chordpro-song-time! song time-str))
+          (when tempo-str
+            (let ((bpm (chordpro-tempo-number tempo-str)))
+              (when bpm (set-chordpro-song-tempo! song bpm)))))))))
+
+%% Configuration (set by layout_bottom.ily or song file)
+%% Aktivierbar wie yaml-export-enabled durch Definieren der Variable vor
+%% dem Laden der Includes.
+#(define chordpro-export-enabled
+  (if (defined? 'chordpro-export-enabled) chordpro-export-enabled #f))
+
 %% Helper function to convert German minor chord notation to standard major form
 %% Used for generating {define:} directives
 #(define (german-minor-to-major-form chord-str)
@@ -96,8 +289,8 @@
          (else chord-str)))))
 
 %% Helper function to track minor/B/H/accidental chords and return original
-#(define (track-and-return-chord chord-str)
+#(define (track-and-return-chord song chord-str)
-  "Track chords that need {define:} directives and return original."
+  "Track chords that need {define:} directives (per song) and return original."
   (if (or (not (string? chord-str)) (string-null? chord-str))
       chord-str
       (let* ((first-char (string-ref chord-str 0))
@@ -106,33 +299,26 @@
                           ""))
              (has-is (string-prefix? "is" rest-str))
              (has-es (string-prefix? "es" rest-str))
-             (has-accidental (or has-is has-es)))
+             (has-accidental (or has-is has-es))
+             (add-unique! (lambda (getter setter!)
+                            (unless (member chord-str (getter song))
+                              (setter! song (cons chord-str (getter song)))))))
         (cond
          ;; H/h chords (German H = English B)
-         ((char=? first-char #\H)
+         ((or (char=? first-char #\H) (char=? first-char #\h))
-          (unless (member chord-str chordpro-h-chords-used)
+          (add-unique! chordpro-song-h-chords set-chordpro-song-h-chords!))
-            (set! chordpro-h-chords-used (cons chord-str chordpro-h-chords-used))))
-         ((char=? first-char #\h)
-          (unless (member chord-str chordpro-h-chords-used)
-            (set! chordpro-h-chords-used (cons chord-str chordpro-h-chords-used))))
 
          ;; B/b chords (German B = English Bb)
-         ((char=? first-char #\B)
+         ((or (char=? first-char #\B) (char=? first-char #\b))
-          (unless (member chord-str chordpro-b-chords-used)
+          (add-unique! chordpro-song-b-chords set-chordpro-song-b-chords!))
-            (set! chordpro-b-chords-used (cons chord-str chordpro-b-chords-used))))
-         ((char=? first-char #\b)
-          (unless (member chord-str chordpro-b-chords-used)
-            (set! chordpro-b-chords-used (cons chord-str chordpro-b-chords-used))))
 
          ;; Chords with accidentals (is/es)
          (has-accidental
-          (unless (member chord-str chordpro-accidental-chords-used)
+          (add-unique! chordpro-song-accidental-chords set-chordpro-song-accidental-chords!))
-            (set! chordpro-accidental-chords-used (cons chord-str chordpro-accidental-chords-used))))
 
          ;; Other lowercase chords (minor without B/H/accidentals)
          ((char-lower-case? first-char)
-          (unless (member chord-str chordpro-minor-chords-used)
+          (add-unique! chordpro-song-minor-chords set-chordpro-song-minor-chords!)))
-            (set! chordpro-minor-chords-used (cons chord-str chordpro-minor-chords-used)))))
 
         ;; Always return original
         chord-str)))
@@ -197,35 +383,6 @@
         ;; Single chord: return as is
         clean-str)))
 
-%% Global state - shared across all engraver instances!
-#(define chordpro-syllables-collected '())
-#(define chordpro-chords-collected '())
-#(define chordpro-breaks-collected '())
-#(define chordpro-stanza-numbers '())
-%% Format: (moment verse-idx text direction) for inline text markers like repStart/repStop
-#(define chordpro-inline-texts-collected '())
-%%Track break moments to detect verse changes
-#(define chordpro-seen-break-moments '())
-%% Increments with each verse (each chordlyrics call)
-#(define chordpro-current-verse-index 0)
-%% Collected minor chords (lowercase German chords) for {define:} directives
-#(define chordpro-minor-chords-used '())
-%% Collected B chords (German B = English Bb) for {define:} directives
-#(define chordpro-b-chords-used '())
-%% Collected H chords (German H = English B) for {define:} directives
-#(define chordpro-h-chords-used '())
-%% Collected chords with accidentals (is/es) for {define:} directives
-#(define chordpro-accidental-chords-used '())
-
-%% Configuration and metadata (set by layout_bottom.ily or song file)
-#(define chordpro-export-enabled #f)
-#(define chordpro-current-filename "output")
-#(define chordpro-header-title "Untitled")
-#(define chordpro-header-authors #f)
-
-%% Write flag (ensures we only write once, not for each finalize call)
-#(define chordpro-file-written #f)
-
 %% Helper function to format stanza label for ChordPro
 #(define (format-chordpro-stanza-label stanza-type stanza-numbers)
   "Generate ChordPro label based on stanza type and optional numbers"
@@ -247,55 +404,68 @@
 %% Single engraver in Score context
 #(define ChordPro_score_collector
    (lambda (context)
-     (let ((pending-syllable #f)
+     (let ((song #f)
-           (this-verse-index #f))
+           (pending-syllable #f)
+           (this-verse-index #f)
+           (doc-seq 0)
+           (doc-pos 0)
+           (sub-counter 0))
+       ;; pending-syllable: (moment text verse-idx)
+       (define (save-pending! has-hyphen)
+         (when pending-syllable
+           (set-chordpro-song-syllables! song
+             (cons (list (car pending-syllable) (cadr pending-syllable) has-hyphen (caddr pending-syllable))
+                   (chordpro-song-syllables song)))
+           (set! pending-syllable #f)))
+       (define (record-verse-order! idx)
+         (set-chordpro-song-verse-order! song
+           (cons (list idx doc-seq doc-pos sub-counter)
+                 (chordpro-song-verse-order song))))
        (make-engraver
         ;; Initialize - called when engraver is created (once per \chordlyrics)
         ((initialize engraver)
-         ;; Each \chordlyrics call creates a new Score, so this marks a new verse
+         ;; \chordlyrics hat den aktiven Song-Key vor der Interpretation gesetzt;
-         (when (> chordpro-current-verse-index 0)
+         ;; jeder \chordlyrics-Score ist ein Vers dieses Lieds.
-           ;; Reset break tracking for new verse
+         (set! song (chordpro-get-song (or chordpro-active-song-key "output")))
-           (set! chordpro-seen-break-moments '()))
+         (set! this-verse-index (chordpro-song-verse-index song))
-         ;; Store the verse index for this instance
+         (set-chordpro-song-verse-index! song (+ this-verse-index 1))
-         (set! this-verse-index chordpro-current-verse-index)
+         (let ((order (or chordpro-active-doc-order (cons 0 0))))
-         ;; Increment global index for next verse
+           (set! doc-seq (car order))
-         (set! chordpro-current-verse-index (+ chordpro-current-verse-index 1)))
+           (set! doc-pos (cdr order)))
+         (record-verse-order! this-verse-index))
 
         ;; Event listeners
         (listeners
          ;; LyricEvent from Lyrics context
          ((lyric-event engraver event)
-          (let ((text (ly:event-property event 'text))
+          (let* ((raw-text (ly:event-property event 'text))
+                 ;; Markup-Silben (z.B. \updown) mit den Props des
+                 ;; chordlyrics-Aufrufs zu Strings aufloesen -- erst dabei
+                 ;; entscheidet sich die \tag-Sichtbarkeit.
+                 (text (cond
+                        ((string? raw-text) raw-text)
+                        ((markup? raw-text)
+                         (markup->string raw-text
+                                         #:props (or chordpro-active-props '())))
+                        (else #f)))
                  (moment (ly:context-current-moment context)))
             (when (string? text)
-              ;; On first lyric event for this engraver instance, capture the verse index
-              (when (not this-verse-index)
-                (set! this-verse-index chordpro-current-verse-index)
-                (set! chordpro-current-verse-index (+ chordpro-current-verse-index 1)))
-
               ;; Save previous syllable if any (it had no hyphen)
-              (when pending-syllable
+              (save-pending! #f)
-                (set! chordpro-syllables-collected
-                      (cons (list (car pending-syllable) (cadr pending-syllable) #f (caddr pending-syllable))
-                            chordpro-syllables-collected)))
               ;; Store new syllable as pending (with THIS instance's verse index)
               (set! pending-syllable (list moment text this-verse-index)))))
 
          ;; HyphenEvent from Lyrics context
          ((hyphen-event engraver event)
-          (when pending-syllable
+          (save-pending! #t))
-            (set! chordpro-syllables-collected
-                  (cons (list (car pending-syllable) (cadr pending-syllable) #t (caddr pending-syllable))
-                        chordpro-syllables-collected))
-            (set! pending-syllable #f)))
 
          ;; BreakEvent - store break moment
          ((break-event engraver event)
           (let ((moment (ly:context-current-moment context)))
 
             ;; Store break with this instance's verse index
-            (set! chordpro-breaks-collected
+            (set-chordpro-song-breaks! song
-                  (cons (cons moment this-verse-index) chordpro-breaks-collected)))))
+                  (cons (cons moment this-verse-index) (chordpro-song-breaks song))))))
 
         ;; Acknowledge grobs from child contexts
         (acknowledgers
@@ -304,7 +474,10 @@
           (let* ((details (ly:grob-property grob 'details '()))
                  (custom-realstanza (ly:assoc-get 'custom-realstanza details #f))
                  (stanza-type (ly:assoc-get 'custom-stanza-type details 'verse))
-                 (stanza-numbers (ly:assoc-get 'custom-stanza-numbers details '()))
+                 ;; \override-stanza ueberschreibt die GEDRUCKTEN Nummern
+                 ;; (z.B. "Ref. 4:" statt "Ref. 1, 4:") -- die zaehlen.
+                 (stanza-numbers (or (ly:assoc-get 'custom-stanzanumber-override details #f)
+                                     (ly:assoc-get 'custom-stanza-numbers details '())))
                  ;; Check for custom inline text (e.g., repStart/repStop with direction)
                  (custom-inline-text (ly:assoc-get 'custom-inline-text details #f))
                  (custom-inline-direction (ly:assoc-get 'custom-inline-direction details CENTER))
@@ -327,53 +500,115 @@
                                      (if stanza-markup
                                          (format #f "~a" stanza-markup)
                                          #f))))
-                 (existing (assoc this-verse-index chordpro-stanza-numbers))
+                 (existing (assoc this-verse-index (chordpro-song-stanza-numbers song)))
                  (moment (ly:context-current-moment (ly:translator-context source-engraver)))
                  (direction (ly:grob-property grob 'direction CENTER)))
 
             ;; If custom-inline-text is set, always collect it as inline text (regardless of realstanza)
             ;; This allows repStart/repStop to be collected even when combined with real stanza numbers
             (when custom-inline-text
-              (set! chordpro-inline-texts-collected
+              (set-chordpro-song-inline-texts! song
                     (cons (list moment this-verse-index custom-inline-text custom-inline-direction)
-                          chordpro-inline-texts-collected)))
+                          (chordpro-song-inline-texts song))))
 
             ;; If this is NOT a real stanza marker (custom-realstanza not set or ##f),
             ;; collect it as inline text with direction info
             (when (and (not custom-realstanza) (not custom-inline-text))
+              (if (and (string? stanza-markup) (not existing))
+                  ;; Ein direktes \set stanza = "..." (String, kein Markup)
+                  ;; am Versanfang ist ein echtes Label (z.B. "2.b"), keine
+                  ;; Dekoration -- als weiches Stanza-Label uebernehmen
+                  ;; (realstanza #f), nicht in den Verskoerper.
+                  (set-chordpro-song-stanza-numbers! song
+                        (cons (list this-verse-index stanza-markup 'verse #f)
+                              (chordpro-song-stanza-numbers song)))
                   (when stanza-text  ; Only if there's text to display
-                (set! chordpro-inline-texts-collected
+                    (set-chordpro-song-inline-texts! song
                           (cons (list moment this-verse-index stanza-text direction)
-                            chordpro-inline-texts-collected))))
+                                (chordpro-song-inline-texts song))))))
 
             ;; Store or update stanza info for this verse (only if it's a real stanza marker)
-            ;; Entry format: (verse-idx stanza-text stanza-type realstanza-flag)
+            ;; Entry format: (verse-idx stanza-text stanza-type realstanza-flag numbers)
             (when custom-realstanza
-              (if existing
+              (let* ((existing-text (and existing (cadr existing)))
-                ;; Update existing entry with type and text if available
+                     (existing-type (and existing (caddr existing)))
-                ;; IMPORTANT: Don't overwrite realstanza=##t markers and their text
+                     (existing-realstanza (and existing (> (length existing) 3) (cadddr existing)))
-                (let* ((existing-text (cadr existing))
+                     (existing-numbers (or (and existing (> (length existing) 4) (list-ref existing 4)) '()))
-                       (existing-type (caddr existing))
+                     ;; Reprint desselben Markers (Strophennummer am Zeilen-
-                       (existing-realstanza (if (> (length existing) 3) (cadddr existing) #f)))
+                     ;; umbruch erneut gedruckt, ggf. als Nummern-Obermenge
-                  (set! chordpro-stanza-numbers
+                     ;; wie #(stanza 2 3) nach Strophe 2) setzt den Vers
+                     ;; fort; vgl. merge-reprinted im data_extractor.
+                     (same-marker?
+                      (and existing-realstanza
+                           (or (and (string? existing-text) (string? stanza-text)
+                                    (string=? existing-text stanza-text))
+                               (and (eq? existing-type stanza-type)
+                                    (pair? existing-numbers)
+                                    (every (lambda (n) (member n stanza-numbers))
+                                           existing-numbers))))))
+                (cond
+                 ;; Kein Eintrag: neu anlegen
+                 ((not existing)
+                  (set-chordpro-song-stanza-numbers! song
+                        (cons (list this-verse-index stanza-text stanza-type custom-realstanza stanza-numbers)
+                              (chordpro-song-stanza-numbers song))))
+                 ;; Weicher Eintrag (\set stanza) oder Reprint: aktualisieren,
+                 ;; Text echter Marker nicht ueberschreiben
+                 ((or (not existing-realstanza) same-marker?)
+                  (set-chordpro-song-stanza-numbers! song
                         (map (lambda (entry)
                                (if (= (car entry) this-verse-index)
                                    (list (car entry)
-                                        ;; If existing entry is a real stanza, don't overwrite text
-                                        ;; Otherwise, use new text if available
                                         (if existing-realstanza
                                             existing-text
                                             (or stanza-text existing-text))
-                                        ;; Update type only if custom-realstanza is set
+                                        stanza-type
-                                        (if custom-realstanza stanza-type existing-type)
+                                        #t
-                                        ;; Preserve ##t realstanza flag
+                                        (if existing-realstanza existing-numbers stanza-numbers))
-                                        (or existing-realstanza custom-realstanza))
                                    entry))
-                             chordpro-stanza-numbers)))
+                             (chordpro-song-stanza-numbers song))))
-                ;; Create new entry with type, text, and realstanza flag
+                 ;; ANDERER echter Marker im selben \chordlyrics (z.B.
-                (set! chordpro-stanza-numbers
+                 ;; Refrain nach der Strophe): neuen logischen Vers beginnen.
-                      (cons (list this-verse-index stanza-text stanza-type custom-realstanza)
+                 ;; Alles ab hier (inkl. einer im selben Timestep schon
-                            chordpro-stanza-numbers)))))) ; closes set!, if, when, stanza-number-interface
+                 ;; angefallenen Silbe) gehoert zum neuen Vers.
+                 (else
+                  (let ((old-idx this-verse-index)
+                        (split-idx (chordpro-song-verse-index song)))
+                    (set-chordpro-song-verse-index! song (+ split-idx 1))
+                    (set! sub-counter (+ sub-counter 1))
+                    (set! this-verse-index split-idx)
+                    (record-verse-order! split-idx)
+                    ;; Die erste Silbe des neuen Abschnitts faellt in
+                    ;; denselben Timestep wie der Marker und wurde ggf.
+                    ;; schon gesammelt (pending oder -- bei Trennstrich --
+                    ;; bereits gespeichert): dem neuen Vers zuschlagen.
+                    (when (and pending-syllable
+                               (ly:moment=? (car pending-syllable) moment))
+                      (set! pending-syllable
+                            (list moment (cadr pending-syllable) split-idx)))
+                    (let retag ((rest (chordpro-song-syllables song)) (acc '()))
+                      (if (and (pair? rest)
+                               (= (cadddr (car rest)) old-idx)
+                               (ly:moment=? (car (car rest)) moment))
+                          (retag (cdr rest)
+                                 (cons (list (car (car rest)) (cadr (car rest))
+                                             (caddr (car rest)) split-idx)
+                                       acc))
+                          (set-chordpro-song-syllables! song
+                                                        (append (reverse acc) rest))))
+                    (let retag ((rest (chordpro-song-chords song)) (acc '()))
+                      (if (and (pair? rest)
+                               (= (caddr (car rest)) old-idx)
+                               (ly:moment=? (car (car rest)) moment))
+                          (retag (cdr rest)
+                                 (cons (list (car (car rest)) (cadr (car rest))
+                                             split-idx (cadddr (car rest)))
+                                       acc))
+                          (set-chordpro-song-chords! song
+                                                     (append (reverse acc) rest))))
+                    (set-chordpro-song-stanza-numbers! song
+                          (cons (list split-idx stanza-text stanza-type custom-realstanza stanza-numbers)
+                                (chordpro-song-stanza-numbers song)))))))))) ; closes stanza-number-interface
 
          ;; ChordName grobs from ChordNames context
          ;; Store grob reference - visibility will be recorded by ChordPro_chord_visibility_recorder
@@ -387,8 +622,8 @@
                  (chord-name-final
                    (if (and alt-main-name alt-alt-name)
                        ;; This is an altChord - use the pre-extracted names
-                       (let ((main (track-and-return-chord alt-main-name))
+                       (let ((main (track-and-return-chord song alt-main-name))
-                             (alt (track-and-return-chord alt-alt-name)))
+                             (alt (track-and-return-chord song alt-alt-name)))
                          ;; Check if main is empty - if so, only output alt in parens
                          (if (string-null? main)
                              (string-append "[(" alt ")]")  ; Only alt chord: [(D7)]
@@ -409,11 +644,11 @@
                                     (second-part (if (and open-pos close-pos)
                                                     (substring rest (+ open-pos 1) close-pos)
                                                     ""))
-                                    (first-converted (track-and-return-chord first-part))
+                                    (first-converted (track-and-return-chord song first-part))
-                                    (second-converted (track-and-return-chord second-part)))
+                                    (second-converted (track-and-return-chord song second-part)))
                                (string-append first-converted "][(" second-converted ")"))
                              ;; Single chord: just track and return original
-                             (track-and-return-chord chord-names-str))))))
+                             (track-and-return-chord song chord-names-str))))))
             ;; Store grob reference along with chord data (unless empty)
             ;; Format: (moment chord-name verse-index grob)
             ;; Filter out completely empty chords, but convert ][(X) to [(X)]
@@ -432,8 +667,8 @@
                       ;; Normal chord
                       (else chord-name-final))))
               (when processed-chord-name
-                (set! chordpro-chords-collected
+                (set-chordpro-song-chords! song
-                      (cons (list moment processed-chord-name this-verse-index grob) chordpro-chords-collected))))))
+                      (cons (list moment processed-chord-name this-verse-index grob) (chordpro-song-chords song)))))))
 
          ;; LyricText grobs to get stanza number
          ((lyric-syllable-interface engraver grob source-engraver)
@@ -448,7 +683,7 @@
             (when stanza-value
               ;; Only update existing stanza entries (don't create new ones)
               ;; New entries should only be created by stanza-number-interface
-              (let* ((existing (assoc this-verse-index chordpro-stanza-numbers))
+              (let* ((existing (assoc this-verse-index (chordpro-song-stanza-numbers song)))
                      (existing-text (if existing (cadr existing) #f))
                      (stanza-text (if (markup? stanza-value)
                                      (markup->string stanza-value)
@@ -459,7 +694,7 @@
                           (string? stanza-text)
                           (not (string-null? stanza-text)))
                   ;; Update existing entry with text (keep type and realstanza flag)
-                  (set! chordpro-stanza-numbers
+                  (set-chordpro-song-stanza-numbers! song
                         (map (lambda (entry)
                                (if (= (car entry) this-verse-index)
                                    (list (car entry)
@@ -467,92 +702,70 @@
                                         (caddr entry)   ; Keep stanza-type
                                         (if (> (length entry) 3) (cadddr entry) #f)) ; Keep realstanza-flag if exists
                                    entry))
-                             chordpro-stanza-numbers))))))) ; schließt lyric-syllable-interface
+                             (chordpro-song-stanza-numbers song)))))))) ; schließt lyric-syllable-interface
         ) ; schließt acknowledgers
         ;; End of timestep
         ((stop-translation-timestep engraver)
-         (when pending-syllable
+         (save-pending! #f))
-           (set! chordpro-syllables-collected
-                 (cons (list (car pending-syllable) (cadr pending-syllable) #f (caddr pending-syllable))
-                       chordpro-syllables-collected))
-           (set! pending-syllable #f)))
 
-        ;; Finalize - just write debug, don't filter chords yet
+        ;; Finalize - just save leftovers, don't filter chords yet
-        ;; (Filtering happens in chordpro-write-from-engraver-data where grob properties are final)
+        ;; (Filtering happens in chordpro-write-song where grob properties are final)
         ((finalize engraver)
          ;; Save any remaining pending syllable
-         (when pending-syllable
+         (save-pending! #f))))))
-           (set! chordpro-syllables-collected
-                 (cons (list (car pending-syllable) (cadr pending-syllable) #f (caddr pending-syllable))
-                       chordpro-syllables-collected))
-           (set! pending-syllable #f))
-       )))))
 
 %% Helper functions to format and write ChordPro
-#(define (chordpro-write-from-engraver-data num-verses)
+#(define (chordpro-format-song song)
-  "Write ChordPro file from collected engraver data"
+  "Format one song's collected engraver data as a ChordPro string."
-  (let* ((filename (if (defined? 'chordpro-current-filename)
+  (let* ((num-verses (chordpro-song-verse-index song))
-                       chordpro-current-filename
-                       "output"))
-         (output-file (string-append filename ".cho"))
          ;; Reverse all lists (they were collected in reverse order)
-         (syllables (reverse chordpro-syllables-collected))
+         (syllables (reverse (chordpro-song-syllables song)))
-         (chords (reverse chordpro-chords-collected))
+         (chords (reverse (chordpro-song-chords song)))
-         (breaks (reverse chordpro-breaks-collected)))
+         (breaks (reverse (chordpro-song-breaks song)))
+         (stanza-numbers (chordpro-song-stanza-numbers song))
+         (inline-texts (chordpro-song-inline-texts song))
+         (write-defines (lambda (chord-list convert)
+                          (for-each
+                            (lambda (chord)
+                              (display (format #f "{define: ~a copy ~a}\n" chord (convert chord))))
+                            (reverse chord-list)))))
 
-    (with-output-to-file output-file
+    (with-output-to-string
       (lambda ()
         ;; Write metadata
-        (display (format #f "{title: ~a}\n"
+        (display (format #f "{title: ~a}\n" (or (chordpro-song-title song) "Untitled")))
-                        (if (defined? 'chordpro-header-title)
+        (when (chordpro-song-authors song)
-                            chordpro-header-title
+          (for-each (lambda (name) (display (format #f "{artist: ~a}\n" name)))
-                            "Untitled")))
+                    (chordpro-all-author-names (chordpro-song-authors song)))
-        (when (and (defined? 'chordpro-header-authors) chordpro-header-authors)
+          (for-each (lambda (name) (display (format #f "{composer: ~a}\n" name)))
-          (display (format #f "{artist: ~a}\n"
+                    (chordpro-authors-by-role 'melody (chordpro-song-authors song)))
-                          (format-chordpro-authors chordpro-header-authors))))
+          (for-each (lambda (name) (display (format #f "{lyricist: ~a}\n" name)))
+                    (chordpro-authors-by-role 'text (chordpro-song-authors song))))
+        (when (chordpro-song-copyright song)
+          (display (format #f "{copyright: ~a}\n" (chordpro-song-copyright song))))
+        (when (chordpro-song-year song)
+          (display (format #f "{year: ~a}\n" (chordpro-song-year song))))
+        (when (chordpro-song-key-signature song)
+          (display (format #f "{key: ~a}\n" (chordpro-song-key-signature song))))
+        (when (chordpro-song-time song)
+          (display (format #f "{time: ~a}\n" (chordpro-song-time song))))
+        (when (chordpro-song-tempo song)
+          (display (format #f "{tempo: ~a}\n" (chordpro-song-tempo song))))
 
-        ;; Write {define:} directives for all used minor chords
+        ;; {define:} directives: minor chords (lowercase German), B/b (German B =
-        (unless (null? chordpro-minor-chords-used)
+        ;; English Bb), H/h (German H = English B), accidentals (is/es -> #/b)
-          (newline)
+        (unless (null? (chordpro-song-minor-chords song))
-          (for-each
+          (newline))
-            (lambda (minor-chord)
+        (write-defines (chordpro-song-minor-chords song) german-minor-to-major-form)
-              ;; Convert minor chord to major form for the definition
+        (write-defines (chordpro-song-b-chords song) german-b-to-bb-form)
-              (let ((major-form (german-minor-to-major-form minor-chord)))
+        (write-defines (chordpro-song-h-chords song) german-h-to-b-form)
-                (display (format #f "{define: ~a copy ~a}\n" minor-chord major-form))))
+        (write-defines (chordpro-song-accidental-chords song) german-accidentals-to-international)
-            (reverse chordpro-minor-chords-used)))
-
-        ;; Write {define:} directives for all used B chords (German B = English Bb)
-        (unless (null? chordpro-b-chords-used)
-          (for-each
-            (lambda (b-chord)
-              ;; Convert B/b to Bb/Bbm form for the definition
-              (let ((bb-form (german-b-to-bb-form b-chord)))
-                (display (format #f "{define: ~a copy ~a}\n" b-chord bb-form))))
-            (reverse chordpro-b-chords-used)))
-
-        ;; Write {define:} directives for all used H chords (German H = English B)
-        (unless (null? chordpro-h-chords-used)
-          (for-each
-            (lambda (h-chord)
-              ;; Convert H/h to B/Bm form for the definition
-              (let ((b-form (german-h-to-b-form h-chord)))
-                (display (format #f "{define: ~a copy ~a}\n" h-chord b-form))))
-            (reverse chordpro-h-chords-used)))
-
-        ;; Write {define:} directives for chords with accidentals (is/es -> #/b)
-        (unless (null? chordpro-accidental-chords-used)
-          (for-each
-            (lambda (accidental-chord)
-              ;; Convert German accidentals to international format
-              (let ((intl-form (german-accidentals-to-international accidental-chord)))
-                (display (format #f "{define: ~a copy ~a}\n" accidental-chord intl-form))))
-            (reverse chordpro-accidental-chords-used)))
 
         (newline)
 
-        ;; Write each verse in reverse order (they were collected backwards)
+        ;; Verse in Dokumentreihenfolge schreiben
-        (let loop ((verse-idx (- num-verses 1)))
+        (for-each
-          (when (>= verse-idx 0)
+          (lambda (verse-idx)
             ;; Get syllables, chords and breaks for this verse
             (let* ((verse-syllables (filter (lambda (s) (= (cadddr s) verse-idx)) syllables))
                    (verse-chords-raw (filter (lambda (c)
@@ -576,9 +789,9 @@
                                                            (cons (list (car chord) chord-name (caddr chord)) result)))))))
                    (verse-breaks (filter (lambda (b) (= (cdr b) verse-idx)) breaks))
                    (verse-inline-texts (filter (lambda (r) (= (cadr r) verse-idx))
-                                               (reverse chordpro-inline-texts-collected)))
+                                               (reverse inline-texts)))
                    ;; Get stanza info (number, type, and realstanza flag) for this verse
-                   (stanza-entry (find (lambda (s) (= (car s) verse-idx)) chordpro-stanza-numbers))
+                   (stanza-entry (find (lambda (s) (= (car s) verse-idx)) stanza-numbers))
                    (stanza-num (if stanza-entry (cadr stanza-entry) #f))
                    (stanza-type (if stanza-entry (caddr stanza-entry) 'verse))
                    (realstanza (if stanza-entry (cadddr stanza-entry) #f))
@@ -607,11 +820,15 @@
                       (when (and stanza-num (not (string-null? stanza-num)))
                         (display (format #f "# ~a\n" stanza-num)))
                       (display (format-verse-as-chordpro verse-syllables verse-chords verse-breaks verse-inline-texts))
-                      (display "\n\n"))))
+                      (display "\n\n"))))))
+          (chordpro-song-ordered-verse-indices song))))))
 
-            (loop (- verse-idx 1)))))))
+%% Schreibt ein Lied als eigene <key>.cho-Datei (Einzellied-/Pro-Song-Modus).
-
+#(define (chordpro-write-song song)
-    ))
+  "Write one song's ChordPro file from its collected engraver data"
+  (let ((output-file (string-append (chordpro-song-key song) ".cho")))
+    (with-output-to-file output-file
+      (lambda () (display (chordpro-format-song song))))))
 
 #(define (format-verse-as-chordpro syllables chords breaks inline-texts)
   "Format one verse as ChordPro text with line breaks.
@@ -963,35 +1180,96 @@
   "Add two moments"
   (ly:moment-sub m1 (ly:moment-sub (ly:make-moment 0) m2)))
 
-#(define (format-chordpro-authors authors)
+%% Lieferbarer Name eines Autors-Keys (z.B. "HansLeip") aus AUTHOR_DATA
-  "Format authors list for ChordPro"
+%% (Feld "name", z.B. "Hans Leip"); ohne Eintrag der rohe Key als Fallback,
-  (cond
+%% analog zu format-author in footer_with_songinfo.ily -- aber ohne dessen
-    ((list? authors)
+%% Praefixe/Jahresangaben, die fuer ChordPro-Metadaten nicht passen.
-     (string-join
+#(define (chordpro-author-display-name author-id)
+  (let ((data (and (defined? 'AUTHOR_DATA) (assoc-ref AUTHOR_DATA author-id))))
+    (or (and data (assoc-ref data "name")) author-id)))
+
+%% Formatierte Namen aller Autoren (unabhaengig von ihrer Rolle) als Liste
+%% -- fuer je eine eigene {artist:}-Zeile. ChordPro will mehrere Werte
+%% nicht kommagetrennt in einer Direktive, sondern als mehrfache Direktive
+%% (https://www.chordpro.org/chordpro/directives-artist/: "Multiple
+%% artists can be specified using multiple directives.").
+#(define (chordpro-all-author-names authors)
+  (if (list? authors)
       (filter (lambda (s) (not (string-null? s)))
               (map (lambda (author-info)
                      (cond
-                        ((pair? author-info) (car author-info))
+                       ((pair? author-info) (chordpro-author-display-name (car author-info)))
-                        ((string? author-info) author-info)
+                       ((string? author-info) (chordpro-author-display-name author-info))
                        (else "")))
                    authors))
-       ", "))
+      '()))
-    (else "")))
+
+%% Formatierte Namen aller Autoren mit dieser Rolle (z.B. 'melody fuer
+%% {composer:}, 'text fuer {lyricist:}) als Liste, aus demselben Grund wie
+%% chordpro-all-author-names eine Liste statt ein komma-getrennter String.
+%% authors ist die rohe Liste aus dem Header, z.B.
+%% (("HansLeip" text melody) ("alf" melody)).
+#(define (chordpro-authors-by-role role authors)
+  (if (list? authors)
+      (filter-map (lambda (author-info)
+                    (and (pair? author-info)
+                         (member role (cdr author-info))
+                         (chordpro-author-display-name (car author-info))))
+                  authors)
+      '()))
+
+%% Wandelt eine LilyPond-Tonart wie "d minor"/"es major" (Ausgabe von
+%% key-music->string in data_extractor.ily) in ChordPro-Tonart-Notation um
+%% (z.B. "Dm", "Eb"). Nutzt dieselbe internationale Notenlogik wie die
+%% {define:}-Direktiven, aber auf die BARE Note angewendet statt auf einen
+%% vollen Akkordnamen -- Dur/Moll steht hier als eigenes Wort, nicht als
+%% Gross-/Kleinschreibung wie bei Akkorden aus \chordmode.
+#(define (lilypond-key->chordpro-key key-string)
+  (let* ((parts (string-split key-string #\space))
+         (note (car parts))
+         (minor? (string=? (cadr parts) "minor"))
+         (first-char (string-ref note 0))
+         (rest (if (> (string-length note) 1) (substring note 1) "")))
+    (string-append
+      (cond
+        ((char=? first-char #\h) "B")                    ; deutsches H = engl. B
+        ((and (char=? first-char #\b) (string-null? rest)) "Bb") ; deutsches b = engl. Bb
+        (else (string (char-upcase first-char))))
+      (cond
+        ((string=? rest "is") "#")                       ; fis/cis/... = Kreuz
+        ((member note '("es" "as")) "b")                  ; unregelmaessig: es=Eb, as=Ab
+        ((string=? rest "es") "b")                        ; des/ges/ces = regulaeres -es
+        (else ""))
+      (if minor? "m" ""))))
+
+%% Extrahiert die BPM-Zahl aus einem tempo-music->string-Ergebnis wie
+%% "4 = 130" oder "Allegro (4 = 130)"; #f bei reinem Text-Tempo ("Allegro",
+%% kein Metronomwert) oder wenn tempo-string selbst #f ist. Bei Bereichen
+%% ("4. = 60-70") wird die erste Zahl genommen.
+#(define (chordpro-tempo-number tempo-string)
+  (and tempo-string
+       (let ((match (ly:regex-exec (ly:make-regex "=\\s*([0-9]+)") tempo-string)))
+         (and match (ly:regex-match-substring match 1)))))
 
 %% Define markup command for delayed ChordPro write BEFORE modifying TEXT_PAGES
 %% Uses delay-stencil-evaluation to write after all engraver data is collected
 #(define-markup-command (chordpro-delayed-write layout props)
   ()
   #:category other
-  "Invisible markup that writes ChordPro file during stencil evaluation (after all engraver data is collected)"
+  "Invisible markup that writes one song's ChordPro file during stencil
-  ;; We use a delayed stencil to ensure all engraver data is available
+evaluation (after all engraver data is collected). The song is identified at
+interpretation time: in books via the songfilename markup prop
+(\\setsongfilename), standalone via the chordpro-default-song-key fallback."
+  (let ((key (chordpro-resolve-song-key props)))
     (ly:make-stencil
       `(delay-stencil-evaluation
         ,(delay (begin
           (when (and (defined? 'chordpro-export-enabled)
-                   chordpro-export-enabled
+                     chordpro-export-enabled)
-                   (not chordpro-file-written)
+            (let ((song (hash-ref chordpro-song-store key)))
-                   (> chordpro-current-verse-index 0))
+              (when (and song
-          (chordpro-write-from-engraver-data chordpro-current-verse-index)
+                         (not (chordpro-song-written song))
-          (set! chordpro-file-written #t))
+                         (> (chordpro-song-verse-index song) 0))
-        empty-stencil)))))
+                (chordpro-write-song song)
+                (set-chordpro-song-written! song #t))))
+          empty-stencil))))))

private_includes/base/data_extractor.ily

@@ -0,0 +1,550 @@
+%%% 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))))))

private_includes/base/scm/yaml_parser.scm

@@ -1,154 +1,259 @@
-(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1))
+(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 receive) (srfi srfi-1))
+
+;; YAML-Parser: liest eine Teilmenge von YAML (Block-Syntax, keine
+;; Flow-Collections, keine Block-Skalare) in verschachtelte
+;; alist/list-Strukturen. Gegenstück zu yaml_writer.scm.
+;;
+;; Ergebnisformat:
+;;  - Mapping -> alist mit String-Keys, Reihenfolge wie in der Datei
+;;  - Liste   -> Liste (auch als "- key: value"-Inline-Mappings)
+;;  - Skalare -> String, Zahl, #t/#f, '() (null / {} / [])
+;;
+;; Skalar-Interpretation:
+;;  - unquoted und 'single-quoted' Werte werden interpretiert
+;;    (Zahl, true/false/null). Das Interpretieren von single-quoted
+;;    Werten ist Kompatibilitätsverhalten zum alten Parser:
+;;    authors.yml notiert Zahlen als '1898'.
+;;  - "double-quoted" Werte bleiben immer Strings; \\, \" und \n
+;;    werden entescaped (so schreibt sie der yaml_writer).
+;;  - Kommentare (#) werden nur außerhalb von Quotes entfernt und nur,
+;;    wenn ihnen ein Leerzeichen oder der Zeilenanfang vorausgeht.
 
-;; Hauptparsingfunktion
 (define (yml-file->scm filename)
 
-  ;; Utility: Zeile einlesen
+  ;; --- Zeilen einlesen ------------------------------------------------
-  (define (read-lines filename)
+
+  ;; Anzahl führender Leerzeichen
+  (define (line-indent line)
+    (let loop ((i 0))
+      (if (and (< i (string-length line))
+               (char=? (string-ref line i) #\space))
+          (loop (+ i 1))
+          i)))
+
+  ;; Liefert Items (indent . inhalt); Leerzeilen, reine Kommentarzeilen
+  ;; und Dokumentmarker (--- / ...) werden übersprungen.
+  (define (read-items filename)
     (call-with-input-file filename
       (lambda (port)
-        (let loop ((lines '()))
+        (let loop ((items '()))
           (let ((line (read-line port)))
             (if (eof-object? line)
-                (reverse lines)
+                (reverse items)
-                (let ((clean (string-trim line)))
+                (let* ((line (if (string-suffix? "\r" line)
-                  (if (or (string=? clean "---") (string-null? clean))
+                                 (string-drop-right line 1)
-                      (loop lines) ;; Ignoriere "---" oder leere Zeile
+                                 line))
-                      (loop (cons line lines))))))))))
+                       (content (string-trim-both line)))
+                  (if (or (string-null? content)
+                          (string-prefix? "#" content)
+                          (string=? content "---")
+                          (string=? content "..."))
+                      (loop items)
+                      (loop (cons (cons (line-indent line) content)
+                                  items))))))))))
 
-  ;; Einrückung bestimmen (Anzahl Leerzeichen am Anfang)
+  (define (item-indent item) (car item))
-  (define (line-indent line)
+  (define (item-content item) (cdr item))
-    (let ((match (string-match "^ *" line)))
-      (if match
-          (match:end match)  ; Anzahl der Leerzeichen = Position nach Leerzeichen
-          0)))               ; Falls kein Match → 0
 
-  ;; Kommentar entfernen
+  ;; --- Skalare ----------------------------------------------------------
-  (define (strip-comment line)
-    (let ((m (string-match "#.*" line)))
-      (if m
-          (string-trim-right (string-take line (match:start m)))
-          line)))
 
-  ;; Hilfsfunktion: Whitespace entfernen
+  ;; Position des schließenden Double-Quotes ab start (oder #f);
-  (define (clean-line line)
+  ;; Backslash escaped das Folgezeichen.
-    (string-trim (strip-comment line)))
+  (define (closing-double-quote s start)
+    (let loop ((i start))
+      (cond ((>= i (string-length s)) #f)
+            ((char=? (string-ref s i) #\\) (loop (+ i 2)))
+            ((char=? (string-ref s i) #\") i)
+            (else (loop (+ i 1))))))
 
-  ;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)?
+  ;; Position des schließenden Single-Quotes ab start (oder #f);
-  (define (blank-or-comment? line)
+  ;; '' ist ein escaptes Quote.
-    (string-null? (clean-line line)))
+  (define (closing-single-quote s start)
+    (let loop ((i start))
+      (cond ((>= i (string-length s)) #f)
+            ((char=? (string-ref s i) #\')
+             (if (and (< (+ i 1) (string-length s))
+                      (char=? (string-ref s (+ i 1)) #\'))
+                 (loop (+ i 2))
+                 i))
+            (else (loop (+ i 1))))))
 
-  ;; Skalare Werte interpretieren
+  ;; \\ -> \, \" -> ", \n -> Zeilenumbruch
-  (define (parse-scalar str)
+  (define (unescape-double s)
-    (define (strip-quotes s)
+    (let loop ((chars (string->list s)) (acc '()))
+      (cond ((null? chars) (list->string (reverse acc)))
+            ((and (char=? (car chars) #\\) (pair? (cdr chars)))
+             (loop (cddr chars)
+                   (cons (if (char=? (cadr chars) #\n)
+                             #\newline
+                             (cadr chars))
+                         acc)))
+            (else (loop (cdr chars) (cons (car chars) acc))))))
+
+  ;; '' -> '
+  (define (unescape-single s)
+    (regexp-substitute/global #f "''" s 'pre "'" 'post))
+
+  ;; Kommentar in einem unquoted Wert entfernen:
+  ;; # zählt nur am Anfang oder nach Leerzeichen
+  (define (strip-plain-comment s)
+    (let loop ((i 0))
+      (cond ((>= i (string-length s)) s)
+            ((and (char=? (string-ref s i) #\#)
+                  (or (zero? i)
+                      (char-whitespace? (string-ref s (- i 1)))))
+             (string-take s i))
+            (else (loop (+ i 1))))))
+
+  ;; Unquoted/single-quoted Werte interpretieren
+  (define (interpret-plain s)
     (cond
-       ((and (string-prefix? "\"" s) (string-suffix? "\"" s))
+     ((member s '("{}" "[]" "null")) '())
-        (string-drop-right (string-drop s 1) 1))
-       ((and (string-prefix? "'" s) (string-suffix? "'" s))
-        (string-drop-right (string-drop s 1) 1))
-       (else s)))
-    (let ((s (strip-quotes (string-trim str))))
-      (cond
-       ((string=? s "{}") '())  ;; leere Map
-       ((string=? s "[]") '())  ;; leere Liste
-       ((string-match "^[0-9]+$" s) (string->number s))
      ((string=? s "true") #t)
      ((string=? s "false") #f)
-       ((string=? s "null") '())
+     ((string-match "^-?[0-9]+(\\.[0-9]+)?$" s) (string->number s))
-       (else s))))
+     (else s)))
 
-
+  ;; Skalar parsen; Rest hinter einem schließenden Quote wird ignoriert
-  ;; Hilfsfunktion: Zeilen mit gleicher oder höherer Einrückung sammeln
+  ;; (darf nur ein Kommentar sein)
-  (define (take-indented lines min-indent)
+  (define (parse-scalar str)
-    (let loop ((ls lines) (acc '()))
+    (let ((s (string-trim-both str)))
-      (if (null? ls)
-          (reverse acc)
-          (let ((line (car ls)))
-            (if (or (blank-or-comment? line)
-                    (>= (line-indent line) min-indent))
-                (loop (cdr ls) (cons line acc))
-                (reverse acc))))))
-
-  ;; Hilfsfunktion: N Zeilen überspringen
-  (define (drop lst n)
-    (let loop ((l lst) (i n))
-      (if (or (zero? i) (null? l))
-          l
-          (loop (cdr l) (- i 1)))))
-
-  ;; Listenparsing: Liest Zeilen mit `-` als Listeneinträge
-  (define (parse-list lines current-indent)
-    (let loop ((ls lines) (result '()))
-      (if (null? ls)
-          (reverse result)
-          (let* ((line (clean-line (car ls))))
-            (if (string-match "^-" line)
-                (let* ((indent (line-indent (car ls)))
-                       (item-str (string-trim (string-drop line 1)))
-                       (next-lines (cdr ls)))
-                  (if (or (null? next-lines)
-                          (> (line-indent (car next-lines)) indent))
-                      ;; Verschachtelter Inhalt
-                      (let* ((sub (take-indented next-lines (+ indent 2)))
-                             (parsed (if (null? sub)
-                                         (parse-scalar item-str)
-                                         (parse-lines sub (+ indent 2))))
-                             (remaining (drop next-lines (length sub))))
-                        (loop remaining (cons parsed result)))
-                      ;; Einfacher Skalar
-                      (loop next-lines (cons (parse-scalar item-str) result))))
-                ;; Nicht mehr Teil der Liste
-                (reverse result))))))
-
-  ;; Hauptparser für Key-Value oder Listen
-  (define (parse-lines lines current-indent)
-    (let loop ((ls lines) (result '()))
-      (if (null? ls)
-          (reverse result)
-          (let* ((raw-line (car ls))
-                 (line (clean-line raw-line)))
       (cond
-             ;; Kommentar oder leere Zeile
+       ((string-null? s) "")
-             ((blank-or-comment? raw-line)
+       ((char=? (string-ref s 0) #\")
-              (loop (cdr ls) result))
+        (let ((end (closing-double-quote s 1)))
-
+          (if end
-             ;; Liste
+              (unescape-double (substring s 1 end))
-             ((string-match "^- " line)
+              (string-trim-right (strip-plain-comment s)))))
-              (let ((list-lines (take-indented ls current-indent)))
+       ((char=? (string-ref s 0) #\')
-                (let ((parsed-list (parse-list list-lines current-indent)))
+        (let ((end (closing-single-quote s 1)))
-                  (loop (drop ls (length list-lines))
+          (if end
-                        (cons parsed-list result)))))
+              (interpret-plain (unescape-single (substring s 1 end)))
-
+              (string-trim-right (strip-plain-comment s)))))
-             ;; Key: Value
-             ((string-match "^[^:]+:" line)
-              (let* ((kv (string-split line #\:))
-                     (key (string-trim (car kv)))
-                     (value-str (string-trim (string-join (cdr kv) ":")))
-                     (next-lines (cdr ls)))
-                (if (string-null? value-str)
-                    ;; Wert auf nachfolgender Einrückungsebene
-                    (let* ((sub (take-indented next-lines (+ current-indent 2)))
-                           (parsed (parse-lines sub (+ current-indent 2)))
-                           (remaining (drop next-lines (length sub))))
-                      (loop remaining
-                            (cons (cons key parsed) result)))
-                    ;; Einfacher Key:Value
-                    (loop next-lines
-                          (cons (cons key (parse-scalar value-str)) result)))))
-
-             ;; Fehlerhafte Zeile
        (else
-               ;; Vermeide Fehlermeldung für Leerzeilen oder leere Objekte
+        (interpret-plain (string-trim-right (strip-plain-comment s)))))))
-               (if (or (string-null? (string-trim line))
+
-                       (member line '("{}" "[]")))
+  ;; --- Struktur ----------------------------------------------------------
-                   (loop (cdr ls) result)
+
+  ;; Erste Key-Trennstelle: ":" am Zeilenende oder gefolgt von Leerzeichen.
+  ;; Beginnt die Zeile mit einem gequoteten Key (oder Skalar), zaehlt ein
+  ;; ":" innerhalb der Quotes nicht als Trennstelle.
+  (define (key-split-index s)
+    (let ((start (if (string-null? s)
+                     0
+                     (case (string-ref s 0)
+                       ((#\") (let ((end (closing-double-quote s 1)))
+                                (if end (+ end 1) 0)))
+                       ((#\') (let ((end (closing-single-quote s 1)))
+                                (if end (+ end 1) 0)))
+                       (else 0)))))
+      (let loop ((i start))
+        (cond ((>= i (string-length s)) #f)
+              ((and (char=? (string-ref s i) #\:)
+                    (or (= i (- (string-length s) 1))
+                        (char=? (string-ref s (+ i 1)) #\space)))
+               i)
+              (else (loop (+ i 1)))))))
+
+  ;; Key interpretieren: gequotete Keys werden entquotet (Strings bleiben
+  ;; Strings), unquoted Keys bleiben unveraendert
+  (define (parse-key s)
+    (let ((k (string-trim-both s)))
+      (cond
+       ((string-null? k) k)
+       ((char=? (string-ref k 0) #\")
+        (let ((end (closing-double-quote k 1)))
+          (if end (unescape-double (substring k 1 end)) k)))
+       ((char=? (string-ref k 0) #\')
+        (let ((end (closing-single-quote k 1)))
+          (if end (unescape-single (substring k 1 end)) k)))
+       (else k))))
+
+  (define (dash-line? content)
+    (or (string=? content "-") (string-prefix? "- " content)))
+
+  ;; Wert-String hinter "key:" bzw. "-": reiner Kommentar zählt als leer
+  (define (effective-value str)
+    (let ((s (string-trim-both str)))
+      (if (string-prefix? "#" s) "" s)))
+
+  ;; Einen Block von Items parsen; das erste Item bestimmt die Blockart
+  (define (parse-block items)
+    (cond
+     ((null? items) '())
+     ((dash-line? (item-content (car items))) (parse-list items))
+     ;; einzelne Zeile ohne Key: Skalar (z.B. eine Datei, die nur {} enthält)
+     ((and (null? (cdr items))
+           (not (key-split-index (item-content (car items)))))
+      (parse-scalar (item-content (car items))))
+     (else (parse-map items))))
+
+  ;; Mapping: alle Items auf map-indent sind Keys, tiefer eingerückte
+  ;; Items gehören zum jeweils vorangehenden Key
+  (define (parse-map items)
+    (let ((map-indent (item-indent (car items))))
+      (let loop ((items items) (result '()))
+        (if (null? items)
+            (reverse result)
+            (let* ((content (item-content (car items)))
+                   (split (key-split-index content)))
+              (if (not split)
                   (begin
                     (format (current-error-port)
-                             "Syntaxfehler: Ungültige Zeile: ~a\n" raw-line)
+                            "YAML-Syntaxfehler: Ungültige Zeile: ~a\n" content)
-                     (loop (cdr ls) result))))
+                    (loop (cdr items) result))
-             )))))
+                  (let ((key (parse-key (string-take content split)))
+                        (value-str (effective-value
+                                    (string-drop content (+ split 1)))))
+                    (if (string-null? value-str)
+                        ;; Wert steht im eingerückten Block darunter
+                        (receive (children rest)
+                            (span (lambda (it) (> (item-indent it) map-indent))
+                                  (cdr items))
+                          (loop rest
+                                (cons (cons key (parse-block children))
+                                      result)))
+                        (loop (cdr items)
+                              (cons (cons key (parse-scalar value-str))
+                                    result))))))))))
 
-  (let ((lines (read-lines filename)))
+  ;; Liste: "- wert", "- key: value" (Inline-Mapping) oder "-" mit
-    (parse-lines lines 0)))
+  ;; eingerücktem Block darunter
+  (define (parse-list items)
+    (let ((list-indent (item-indent (car items))))
+      (let loop ((items items) (result '()))
+        (if (null? items)
+            (reverse result)
+            (let ((content (item-content (car items))))
+              (if (not (dash-line? content))
+                  (begin
+                    (format (current-error-port)
+                            "YAML-Syntaxfehler: Ungültiges Listenelement: ~a\n"
+                            content)
+                    (loop (cdr items) result))
+                  (receive (children rest)
+                      (span (lambda (it) (> (item-indent it) list-indent))
+                            (cdr items))
+                    (let* ((after-dash (string-drop content 1))
+                           (inline (effective-value after-dash)))
+                      (cond
+                       ((and (string-null? inline) (null? children))
+                        (loop rest (cons '() result)))
+                       ((string-null? inline)
+                        (loop rest (cons (parse-block children) result)))
+                       (else
+                        ;; Inline-Inhalt: als synthetisches Item mit der
+                        ;; Spalte des Inhalts vor die Kinder stellen, so
+                        ;; funktioniert auch "- key: value" mit weiteren
+                        ;; Keys auf den Folgezeilen
+                        (let* ((offset (- (string-length content)
+                                          (string-length
+                                           (string-trim after-dash))))
+                               (synth (cons (+ list-indent offset) inline)))
+                          (loop rest
+                                (cons (parse-block (cons synth children))
+                                      result)))))))))))))
+
+  (parse-block (read-items filename)))
 
 (define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))

private_includes/base/scm/yaml_writer.scm

@@ -0,0 +1,162 @@
+(use-modules (ice-9 regex) (srfi srfi-1))
+
+;; YAML-Writer: Gegenstück zu yaml_parser.scm.
+;; Schreibt verschachtelte alist/list-Strukturen als YAML, so dass
+;; yml-file->scm sie wieder einlesen kann.
+;;
+;; Datenmodell (wie vom Parser erzeugt):
+;;  - Mapping: Liste von Paaren (key . value), key als String oder Symbol
+;;  - Liste:   Liste von beliebigen Werten
+;;  - Skalare: String, Zahl, #t/#f, '() (leer/null, wird als [] geschrieben)
+;;
+;; Andere Werte werden vorab automatisch umgewandelt: Markups zu Strings,
+;; alles Unbekannte über ~a formatiert (siehe yml-sanitize).
+
+;; Steuert, ob layout_bottom.ily die Header-Daten des Liedes als
+;; YAML-Datei exportiert; aktivierbar per (set! yaml-export-enabled #t)
+;; oder durch Definieren der Variable vor dem Laden der Includes.
+(define yaml-export-enabled
+  (if (defined? 'yaml-export-enabled) yaml-export-enabled #f))
+
+;; Beliebige Werte in YAML-taugliche Daten umwandeln.
+;; (Benötigt die LilyPond-Umgebung für markup? und markup->string.)
+(define (yml-sanitize v)
+  (cond
+   ((or (string? v) (number? v) (boolean? v) (symbol? v) (null? v)) v)
+   ((markup? v) (markup->string v))
+   ((list? v) (map yml-sanitize v))
+   ((pair? v) (cons (yml-sanitize (car v)) (yml-sanitize (cdr v))))
+   (else (format #f "~a" v))))
+
+(define (scm->yml-string data)
+
+  ;; Ist data ein Mapping (alist)? Nicht-leere Liste, deren Elemente
+  ;; alle Paare mit String- oder Symbol-Key sind.
+  ;; Achtung: eine Liste von Listen, deren erste Elemente Strings sind,
+  ;; ist davon nicht unterscheidbar und wird als Mapping interpretiert.
+  (define (mapping? data)
+    (and (pair? data)
+         (list? data)
+         (every (lambda (entry)
+                  (and (pair? entry)
+                       (or (string? (car entry))
+                           (symbol? (car entry)))))
+                data)))
+
+  (define (scalar? v)
+    (or (string? v) (symbol? v) (number? v) (boolean? v) (null? v)))
+
+  (define (key->string k)
+    (if (symbol? k) (symbol->string k) k))
+
+  ;; Muss der String gequotet werden, damit er beim Einlesen wieder
+  ;; als derselbe String erkannt wird?
+  (define (needs-quotes? s)
+    (or (string-null? s)
+        (member s '("true" "false" "null" "{}" "[]"))
+        (string->number s)                       ;; zahlartig ("1981", "1.", "-5") würde zur Zahl
+        (string-index s #\#)                     ;; würde als Kommentar abgeschnitten
+        (string-index s #\:)                     ;; würde als Key: Value gelesen
+        (string-index s #\newline)               ;; mehrzeilig
+        (string-index s #\")
+        (string-prefix? "-" s)                   ;; würde als Listenelement gelesen
+        (string-prefix? "'" s)
+        (not (string=? s (string-trim-both s))))) ;; führende/folgende Leerzeichen
+
+  ;; Doppelt gequoteter YAML-String; Backslash, Anführungszeichen und
+  ;; Zeilenumbrüche werden escaped, damit alles auf einer Zeile bleibt.
+  (define (quote-string s)
+    (string-append
+     "\""
+     (string-concatenate
+      (map (lambda (c)
+             (cond
+              ((char=? c #\\) "\\\\")
+              ((char=? c #\") "\\\"")
+              ((char=? c #\newline) "\\n")
+              (else (string c))))
+           (string->list s)))
+     "\""))
+
+  (define (scalar->string v)
+    (cond
+     ((eq? v #t) "true")
+     ((eq? v #f) "false")
+     ((null? v) "[]")
+     ((number? v) (number->string v))
+     ((symbol? v) (scalar->string (symbol->string v)))
+     ((string? v) (if (needs-quotes? v) (quote-string v) v))
+     (else (error "scm->yml-string: nicht unterstützter Wert" v))))
+
+  (define (indent-string n) (make-string n #\space))
+
+  ;; Key ggf. quoten (leere oder zahlartige Keys, Sonderzeichen)
+  (define (key->yml-string k)
+    (let ((s (key->string k)))
+      (if (needs-quotes? s) (quote-string s) s)))
+
+  ;; Doppelte Keys sind in YAML nicht erlaubt: Werte gleicher Keys werden
+  ;; zu einer Liste zusammengefasst, z.B. authors mit (voice 2) (voice 3)
+  ;; -> voice: [2, 3].
+  (define (merge-duplicate-keys data)
+    (define (value->list v)
+      (if (and (list? v) (not (mapping? v))) v (list v)))
+    (let loop ((entries data) (result '()))
+      (if (null? entries)
+          (reverse result)
+          (let* ((entry (car entries))
+                 (existing (find (lambda (e) (equal? (car e) (car entry)))
+                                 result)))
+            (if existing
+                (begin
+                  (set-cdr! existing (append (value->list (cdr existing))
+                                             (value->list (cdr entry))))
+                  (loop (cdr entries) result))
+                (loop (cdr entries)
+                      (cons (cons (car entry) (cdr entry)) result)))))))
+
+  ;; Mapping schreiben: "key: skalar" oder "key:" mit eingerücktem Inhalt
+  (define (write-mapping data indent port)
+    (for-each
+     (lambda (entry)
+       (let ((key (key->yml-string (car entry)))
+             (value (cdr entry)))
+         (if (scalar? value)
+             (format port "~a~a: ~a\n"
+                     (indent-string indent) key (scalar->string value))
+             (begin
+               (format port "~a~a:\n" (indent-string indent) key)
+               (write-node value (+ indent 2) port)))))
+     (merge-duplicate-keys data)))
+
+  ;; Liste schreiben: "- skalar" oder "-" mit eingerücktem Inhalt
+  ;; (Verschachtelter Inhalt darf NICHT auf der "-"-Zeile beginnen,
+  ;; weil parse-list den Inhalt der "-"-Zeile verwirft, sobald
+  ;; eingerückte Folgezeilen existieren.)
+  (define (write-list data indent port)
+    (for-each
+     (lambda (item)
+       (if (scalar? item)
+           (format port "~a- ~a\n"
+                   (indent-string indent) (scalar->string item))
+           (begin
+             (format port "~a-\n" (indent-string indent))
+             (write-node item (+ indent 2) port))))
+     data))
+
+  (define (write-node data indent port)
+    (cond
+     ((mapping? data) (write-mapping data indent port))
+     ((and (list? data) (not (null? data))) (write-list data indent port))
+     (else (format port "~a~a\n" (indent-string indent) (scalar->string data)))))
+
+  (call-with-output-string
+   (lambda (port) (write-node (yml-sanitize data) 0 port))))
+
+;; Daten als YAML-Datei schreiben
+(define (scm->yml-file filename data)
+  (call-with-output-file filename
+    (lambda (port)
+      (display "---\n" port)
+      (display (scm->yml-string data) port))))
+

private_includes/base/verses_with_chords.ily

@@ -182,7 +182,19 @@
      ((if reverses fold fold-right) (lambda (element filled-list)
               (cons element (if (null? filled-list) '() (cons markup-between filled-list))))
         '() elements))
-   (let* ((column-item-count (ceiling (/ (length versegroup) verse-cols)))
+   ;; Dokumentposition fuer den ChordPro-/Data-Collector: jede Gruppe nimmt
+   ;; sich eine Sequenznummer, jeder Vers traegt seine Position innerhalb
+   ;; der Gruppe in den Props -- die Spalten-Verteilung unten verschraenkt
+   ;; sonst die Interpretationsreihenfolge.
+   (set! chordpro-doc-seq-counter (1+ chordpro-doc-seq-counter))
+   (let* ((doc-seq chordpro-doc-seq-counter)
+          (versegroup (index-map
+                       (lambda (index item)
+                         (make-override-markup
+                          (cons 'chordpro-doc-order (cons doc-seq index))
+                          item))
+                       versegroup))
+          (column-item-count (ceiling (/ (length versegroup) verse-cols)))
           (column-data (make-list verse-cols)))
     (let columnize-list ((index 0) (items versegroup))
       (if (not (null? items))
@@ -341,6 +353,20 @@ Chord_lyrics_spacing_engraver =
                  (transposition (cons #f #f))
                  (verselayout generalLayout))
   "Vers mit Akkorden"
+  ;; Dem ChordPro-Collector sagen, zu welchem Lied dieser Vers gehoert
+  ;; (Buch: songfilename aus den Props via \setsongfilename; Einzellied:
+  ;; Fallback-Key aus layout_bottom). Die Score-Interpretation darunter
+  ;; laeuft synchron, der Engraver liest den Key in initialize. Die Props
+  ;; braucht er zum Aufloesen von Markup-Silben (tags-to-keep).
+  (set! chordpro-active-song-key (chordpro-resolve-song-key props))
+  (set! chordpro-active-props props)
+  ;; Dokumentposition: von \group-verses gestempelt; ausserhalb einer
+  ;; Gruppe nimmt sich der Vers selbst eine Sequenznummer.
+  (set! chordpro-active-doc-order
+    (or (chain-assoc-get 'chordpro-doc-order props #f)
+        (begin
+          (set! chordpro-doc-seq-counter (1+ chordpro-doc-seq-counter))
+          (cons chordpro-doc-seq-counter 0))))
   (interpret-markup layout props
     #{
       \markup {

private_includes/book/book_include.ily

@@ -65,6 +65,26 @@ additionalPageNumbers =
   display-pages-list
 )
 
+% Fuer Zusatzseiten: Label der ersten Seite des zusammenhaengenden
+% Zusatzseiten-Blocks, zu dem label gehoert (bestimmt den Buchstaben-Suffix a, b, ...).
+#(define (earliest-additional-label label)
+  (let find-earliest-additional-label
+       ((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list)))
+       (if (cdadr rest-additional-page-switch-label-list)
+           (find-earliest-additional-label (cdr rest-additional-page-switch-label-list))
+           (caar rest-additional-page-switch-label-list))))
+
+% Sichtbare Seitenzahl der Seite mit diesem Label: normalerweise eine Zahl,
+% auf Zusatzseiten ein String mit Buchstaben-Suffix (z.B. "12a"); gleiche
+% Logik wie custom-page-number unten.
+#(define (visible-page-value layout label)
+  (let ((display-page (assq-ref (build-display-pages-list layout) label)))
+    (if (assq-ref additional-page-switch-label-list label)
+        (ly:format "~a~a" display-page
+          (string (integer->char (+ 97 (- (real-page-number layout label)
+                                          (real-page-number layout (earliest-additional-label label)))))))
+        display-page)))
+
 % TODO:
 % Eigentlich können wir das direkt in oddFooderMarkup und evenFooterMarkup aufrufen
 % vermutlich sogar ohne den delay kram. Wir sollten außerdem einfach nur die property
@@ -97,12 +117,7 @@ width may require additional tweaking.)"
                           (if (assq-ref additional-page-switch-label-list label)
                               (make-concat-markup (list (number-format number-type display-page)
                                 (make-char-markup (+ 97 (- real-current-page (real-page-number layout
-                                  (let find-earliest-additional-label
+                                  (earliest-additional-label label)))))))
-                                       ((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list)))
-                                       (if (cdadr rest-additional-page-switch-label-list)
-                                           (find-earliest-additional-label (cdr rest-additional-page-switch-label-list))
-                                           (caar rest-additional-page-switch-label-list)))
-                                ))))))
                               (number-format number-type (+ display-page (- real-current-page (real-page-number layout label))))
                           ))
                         (page-stencil (interpret-markup layout props page-markup))
@@ -118,6 +133,75 @@ width may require additional tweaking.)"
      (make-filled-box-stencil x-ext y-ext))))
 
 
+%% Schreibt die Daten aller Lieder des Buchs (extract-song-data, siehe
+%% data_extractor.ily) als YAML-Datei: oberster Key contents, darunter eine
+%% Liste mit den Lied-Daten, jeweils angereichert um den Key page mit der
+%% sichtbaren Seitenzahl des Liedanfangs. Einbinden wie \write-toc-csv in
+%% einem Markup des Buchs; wie dort passiert das Schreiben ueber ein
+%% delayed stencil, weil die Label->Seiten-Tabelle erst beim Ausgeben des
+%% Buchs feststeht. Der Dateiname ist der Ausgabename des Buchs
+%% (\bookOutputName, sonst der .ly-Basisname) mit angehaengtem .yml --
+%% landet also wie das PDF relativ zum Arbeitsverzeichnis.
+#(define-markup-command (write-book-yaml layout props) ()
+  (let ((filename (string-append (ly:parser-output-name) ".yml")))
+  (ly:make-stencil
+    `(delay-stencil-evaluation
+      ,(delay
+        (begin
+          (scm->yml-file filename
+            (list (cons 'contents
+              (map (lambda (song)
+                     (let ((songvars (cdr song)))
+                       (cons (cons 'page (visible-page-value layout (assq-ref songvars 'label)))
+                             (extract-song-data (assq-ref songvars 'header)
+                                                (assq-ref songvars 'music)
+                                                ;; Textseiten-Strophen aus dem Render-
+                                                ;; Collector-Store (Key = Liedname); beim
+                                                ;; Ausgeben des Buchs sind alle Textseiten
+                                                ;; bereits interpretiert.
+                                                (hash-ref chordpro-song-store
+                                                          (symbol->string (car song)))
+                                                (symbol->string (car song))))))
+                   (reverse (alist-delete 'markupPage
+                              (alist-delete 'imagePage
+                                (alist-delete 'emptyPage song-list))))))))
+          empty-stencil))))))
+
+%% Schreibt den ChordPro-Export aller Lieder des Buchs (in Dokument-
+%% reihenfolge) als EINE Datei statt als Einzeldateien pro Lied. Lieder
+%% werden mit der ChordPro-Direktive {new_song} getrennt; vor dem ersten
+%% Lied ist sie nicht noetig, sie gilt am Dateianfang implizit (siehe
+%% https://www.chordpro.org/chordpro/directives-new_song/). Einbinden wie
+%% \write-book-yaml an beliebiger Stelle im Buch -- unabhaengig von
+%% chordpro-export-enabled (das steuert nur den Pro-Song-Export), beide
+%% Befehle koennen auch gleichzeitig genutzt werden. Wie bei
+%% \write-book-yaml passiert das Schreiben ueber ein delayed stencil,
+%% weil der Render-Collector-Store erst beim Ausgeben des Buchs
+%% vollstaendig gefuellt ist. Der Dateiname ist wie bei \write-book-yaml
+%% der Ausgabename des Buchs mit angehaengtem .cho.
+#(define-markup-command (write-book-chordpro layout props) ()
+  (let ((filename (string-append (ly:parser-output-name) ".cho")))
+  (ly:make-stencil
+    `(delay-stencil-evaluation
+      ,(delay
+        (begin
+          (with-output-to-file filename
+            (lambda ()
+              (let loop ((songs (filter
+                                  (lambda (song) (> (chordpro-song-verse-index song) 0))
+                                  (filter-map
+                                    (lambda (song) (hash-ref chordpro-song-store
+                                                             (symbol->string (car song))))
+                                    (reverse (alist-delete 'markupPage
+                                               (alist-delete 'imagePage
+                                                 (alist-delete 'emptyPage song-list)))))))
+                         (first? #t))
+                (when (pair? songs)
+                  (unless first? (display "{new_song}\n"))
+                  (display (chordpro-format-song (car songs)))
+                  (loop (cdr songs) #f)))))
+          empty-stencil))))))
+
 includeSong =
 #(define-void-function (filename) (string?)
      #{
@@ -125,6 +209,15 @@ includeSong =
      #}
     (ly:parser-parse-string (ly:parser-clone)
       (ly:format "\\include \"~a/~a/~a.ly\"" songPath filename filename))
+    ;; ChordPro: Titel/Autoren dieses Lieds im Render-Collector-Store
+    ;; registrieren -- basicSongInfo haelt direkt nach dem Include genau
+    ;; dieses Lied. Der Key ist der Liedname; die Collector-Daten (Verse,
+    ;; Akkorde) kommen spaeter beim Rendern ueber \setsongfilename unter
+    ;; demselben Key dazu. Unabhaengig von chordpro-export-enabled, damit
+    ;; sowohl der Pro-Song-Export (der die Flag braucht) als auch
+    ;; \write-book-chordpro (das nur explizit aufgerufen werden muss) auf
+    ;; vollstaendige Metadaten zugreifen koennen.
+    (chordpro-register-song-metadata filename)
     (let ((label (gensym "index")))
       (set! additional-page-switch-label-list
         (acons label additional-page-numbers additional-page-switch-label-list))

private_includes/book/toc_include.ily

@@ -370,6 +370,9 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
 #(define csv-write sxml->csv)
 
 #(define-markup-command (write-toc-csv layout props) ()
+  ;; Dateiname wie bei \write-book-yaml/\write-book-chordpro: der
+  ;; Ausgabename des Buchs mit angehaengtem .csv statt fest "toc.csv".
+  (define csv-filename (string-append (ly:parser-output-name) ".csv"))
   (define (csv-escape field)
     (if (string-null? field)
         field
@@ -453,7 +456,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
                   (format-info-paragraphs (headervar-or-empty 'pronunciation))
               ))))
             (alist-delete 'markupPage (alist-delete 'imagePage (alist-delete 'emptyPage song-list))))))
-    (call-with-output-file "toc.csv"
+    (call-with-output-file csv-filename
       (lambda (port)
        (csv-write (cons '(
         "filename"

public_includes/layout_bottom.ily

@@ -72,25 +72,40 @@ TEXT = \markuplist {
     (if paper (set! $defaultpaper paper))
   )
 
-  ;; ChordPro export: Store filename and extract metadata from basicSongInfo FIRST
+  ;; Meta-Daten des Liedes als YAML neben die Ausgabedatei schreiben
-  (when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled)
+  ;; (<ly:parser-output-name>.yml, landet wie das PDF relativ zum
-    ;; Use ly:parser-output-name which returns the output basename
+  ;; Arbeitsverzeichnis). Die Textseiten-Strophen kommen aus dem
-    ;; This will write relative to current working directory (same as PDF)
+  ;; Render-Collector (chordpro.ily), deshalb wird erst bei der Ausgabe
-    (let ((output-name (ly:parser-output-name)))
+  ;; geschrieben: unsichtbarer delayed Stencil an der letzten Textseite.
-      (set! chordpro-current-filename output-name))
+  ;; Ohne (nicht-leere) Textseiten gibt es keine Collector-Daten und die
+  ;; yml wird sofort geschrieben.
+  (when (and (defined? 'yaml-export-enabled) yaml-export-enabled)
+    ;; Collector-Daten auch ohne ChordPro-Flag unter dem Ausgabenamen sammeln
+    (set! chordpro-default-song-key (ly:parser-output-name))
+    (if (any pair? TEXT_PAGES)
+      (let* ((last-index (- (length TEXT_PAGES) 1))
+             (last-page (list-ref TEXT_PAGES last-index))
+             (trigger-stencil (yaml-delayed-song-write
+                               (ly:parser-output-name) HEADER MUSIC))
+             (modified-last-page #{
+               \markuplist {
+                 #last-page
+                 \stencil #trigger-stencil
+               }
+             #}))
+        (set! TEXT_PAGES
+          (append (list-head TEXT_PAGES last-index)
+                  (list modified-last-page))))
+      (scm->yml-file
+        (string-append (ly:parser-output-name) ".yml")
+        (extract-song-data HEADER MUSIC #f (ly:parser-output-name)))))
 
-    ;; Try to extract metadata from basicSongInfo \header block
+  ;; ChordPro export (Einzellied): Song-Key ist der Ausgabename (die .cho
-    (when (defined? 'basicSongInfo)
+  ;; landet wie das PDF relativ zum Arbeitsverzeichnis); Titel/Autoren
-      (let* ((header-alist (ly:module->alist basicSongInfo))
+  ;; kommen aus basicSongInfo in den per-Song-Store.
-             (title (assoc-ref header-alist 'title))
+  (when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled)
-             (authors (assoc-ref header-alist 'authors)))
+    (set! chordpro-default-song-key (ly:parser-output-name))
-        (when title
+    (chordpro-register-song-metadata chordpro-default-song-key))
-          (set! chordpro-header-title
-                (if (markup? title)
-                    (markup->string title)
-                    (if (string? title) title "Untitled"))))
-        (when authors
-          (set! chordpro-header-authors authors)))))
 
   (add-score #{
     \score {