Notenbund/lilypond-common-includes
15
1
Fork 0
Code Issues 28 Pull Requests 1 Packages Projects Releases Wiki Activity
Files
data-extractor
lilypond-common-includes/private_includes/base/chordpro.ily
T
tux 286779fdac 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
2026-07-12 23:11:36 +02:00

1581 lines
88 KiB
LilyPond
Raw Permalink Blame History

%% ChordPro Export Engraver
%% =========================
%% Single engraver in Score context that collects all data
#(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)))
%% Score-Context-Objekt (eq?) -> Song-Key. Vom Buch per \applyContext DIREKT
%% IN DER MUSIK befuellt (siehe book_include.ily), damit ChordPro_music_collector
%% den richtigen Song-Key hat, auch wenn LilyPond die \score-Bloecke mehrerer
%% Lieder gesammelt/verzoegert interpretiert (dann waere ein globales
%% chordpro-active-song-key zum Interpretationszeitpunkt schon auf ein
%% ANDERES Lied gesetzt). Bewusst eine eigene Hashtabelle statt einer
%% LilyPond-Context-Property (\applyContext -> ly:context-set-property!):
%% LilyPond verwirft Werte fuer nicht deklarierte Properties stillschweigend
%% ("the property ... does not exist"), eine hashq-Tabelle keyed auf das
%% Kontext-Objekt selbst umgeht das.
#(define chordpro-context-song-keys
(if (defined? 'chordpro-context-song-keys) chordpro-context-song-keys (make-hash-table)))
%% Handverlesene Griffbilder fuer Akkorde, die zwar korrekt (international)
%% benannt sind, aber in ChordPros Standard-Config keinen Fingersatz haben
%% (seltene Umkehrungen/Bassnoten oder komplexe Akzidenzien-Akkorde --
%% "Unknown chord to copy", Diagramm fehlt sonst). Key = internationaler
%% Name (die rechte Seite von {define: ... copy ...}), Value = (base-fret .
%% (fret fret fret fret fret fret)) tief nach hoch, 'x fuer stumme Saite.
%% Von Nutzer bestaetigt, siehe [[chordpro-music-collector-context-bug]].
#(define chordpro-custom-chord-diagrams
'(("Em/B" . (1 . (x 2 2 0 0 0)))
("Gm/D" . (1 . (x x 0 3 3 3)))
("G/G#" . (1 . (4 2 0 0 0 3)))
("Amb7b5" . (1 . (x 0 1 2 1 2)))
("Bmb13" . (1 . (x 2 4 4 3 3)))
("Bbb5" . (1 . (x 1 2 3 2 0)))))
#(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: Liste von (original .
;; international) -- ein Eintrag deckt Akkord-Teil UND/ODER /Basston ab,
;; je nachdem was von beiden von der deutschen Notation abweicht.
(hashq-set! song 'chord-defines '())
(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)
;; Aus der Musik (unter den Noten) nachgeholte Strophen, siehe
;; ChordPro_music_collector -- unabhaengig von den \chordlyrics-
;; Textseiten gesammelt, fuellt beim Schreiben nur deren Luecken.
;; music-candidates: Liste von ((syllables . (moment text hyphen?)*)
;; (stanza . label) (type . 'verse/'ref/'bridge))
;; je ein Eintrag pro Lyrics-Kontext-Instanz mit echtem Strophenmarker.
;; music-chords/-breaks: fuers ganze Lied gemeinsam (alle Strophen
;; unter den Noten teilen sich dieselbe Melodie/Zeitachse).
(hashq-set! song 'music-candidates '())
(hashq-set! song 'music-chords '())
(hashq-set! song 'music-breaks '())
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-chord-defines s) (hashq-ref s 'chord-defines))
#(define (set-chordpro-song-chord-defines! s v) (hashq-set! s 'chord-defines 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-song-music-candidates s) (hashq-ref s 'music-candidates))
#(define (set-chordpro-song-music-candidates! s v) (hashq-set! s 'music-candidates v))
#(define (chordpro-song-music-chords s) (hashq-ref s 'music-chords))
#(define (set-chordpro-song-music-chords! s v) (hashq-set! s 'music-chords v))
#(define (chordpro-song-music-breaks s) (hashq-ref s 'music-breaks))
#(define (set-chordpro-song-music-breaks! s v) (hashq-set! s 'music-breaks 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))))))))
%% Liest Variablen aus einem Lied-Header (\bookpart{\header{...}}) aus --
%% dieselbe Logik wie extract-and-check-vars-from-header (toc_include.ily),
%% hier separat definiert, weil toc_include.ily nur im Buchkontext
%% (book_top.ily) geladen wird, chordpro.ily aber auch im Einzellied-Pfad.
#(define (chordpro-extract-header-vars header varlist)
(let* ((headervars (hash-map->list cons (struct-ref (ly:book-header header) 0)))
(extract-var (lambda (varname)
(let* ((varref (assoc-ref headervars varname))
(value (if varref (variable-ref varref) #f)))
(if (and value (not (and (string? value) (string-null? value))))
value #f)))))
(map (lambda (varname) (cons varname (extract-var varname))) varlist)))
%% Titel/Autoren aus dem Lied-Header (dem \bookpart{\header{...}} dieses
%% konkreten Lieds, NICHT der globalen basicSongInfo-Variable) in den Store
%% uebernehmen. Einzellied: layout_bottom nach dem Parsen; Buch: includeSong
%% direkt nach dem Parsen des Lieds. Bewusst NICHT ueber die Variable
%% basicSongInfo: die definieren viele Lieder (die aeltere, direkte
%% HEADER = \bookpart{\header{...}}-Konvention ohne eigenes
%% basicSongInfo) gar nicht selbst, wuerden im Buch dann aber (Buch =
%% eine Parser-Sitzung fuer alle Lieder) die basicSongInfo-Werte des
%% ZULETZT verarbeiteten Lieds erben, das eine definiert hat --
%% Titel/Autoren eines FREMDEN Lieds im eigenen ChordPro-Eintrag.
%% (Bug real beobachtet: "Aennchen von Tharau" bekam Titel/Autoren von
%% "Die Taube" zugewiesen, weil Ade_mein_Lieb_(Die_Taube) davor basic-
%% SongInfo definiert hatte und Aennchen_von_Tharau.ly es nicht tut.)
%% 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; MUSIC ist
%% (anders als basicSongInfo) IMMER frisch pro Lied gesetzt, kein Risiko.
#(define (chordpro-register-song-metadata key header)
(let* ((header-vars (chordpro-extract-header-vars header
'(title authors copyright year_text year_melody)))
(title (assoc-ref header-vars 'title))
(authors (assoc-ref header-vars 'authors))
(copyright (assoc-ref header-vars 'copyright))
(year (or (assoc-ref header-vars 'year_text)
(assoc-ref header-vars '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))
%% Zusaetzlich zu den \chordlyrics-Textseiten auch die Strophen unter den
%% Noten (MUSIC-Teil) einsammeln -- fuellt Luecken wie eine nur dort
%% stehende erste Strophe oder einen nur dort stehenden Refrain (siehe
%% ChordPro_music_collector). Eigene Flag, unabhaengig von
%% chordpro-export-enabled: wer nur die \chordlyrics-Strophen will (z.B.
%% bewusst nur "Zusatzstrophen"), laesst sie einfach aus.
#(define chordpro-include-music-lyrics
(if (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics #f))
%% Helper function to convert German accidentals to international format
#(define (german-accidentals-to-international chord-str)
"Convert German 'is' to '#' and 'es' to 'b' (e.g., 'fis' -> 'F#', 'as' -> 'Ab')"
(if (or (not (string? chord-str)) (string-null? chord-str))
chord-str
(let* ((first-char (string-ref chord-str 0))
(rest-str (if (> (string-length chord-str) 1)
(substring chord-str 1)
""))
;; Check for 'is' (sharp) or 'es' (flat)
(has-is (string-prefix? "is" rest-str))
(has-es (string-prefix? "es" rest-str))
;; Convert root note
(root-upper (string (char-upcase first-char)))
;; Process accidentals and rest
(processed-rest
(cond
(has-is ; fis -> F#, cis -> C#
(string-append "#" (substring rest-str 2)))
(has-es ; as -> Ab, es -> Eb
(string-append "b" (substring rest-str 2)))
(else rest-str))))
;; Special case: if it's a minor chord (lowercase), add 'm' after accidental
(if (char-lower-case? first-char)
;; Minor: add 'm' after accidental
(if (or has-is has-es)
(string-append root-upper (substring processed-rest 0 1) "m" (substring processed-rest 1))
(string-append root-upper "m" processed-rest))
;; Major: just return converted
(string-append root-upper processed-rest)))))
%% Helper function to convert B/b chords to Bb/Bbm form for {define:} directives
#(define (german-b-to-bb-form chord-str)
"Convert B/b chords to Bb/Bbm format (e.g., 'B7' -> 'Bb7', 'b' -> 'Bbm', 'b7' -> 'Bbm7')"
(if (or (not (string? chord-str)) (string-null? chord-str))
chord-str
(let ((first-char (string-ref chord-str 0)))
(cond
;; Uppercase B -> Bb + rest
((char=? first-char #\B)
(string-append "Bb" (substring chord-str 1)))
;; Lowercase b -> Bbm + rest (it's b-minor)
((char=? first-char #\b)
(let ((rest-str (if (> (string-length chord-str) 1)
(substring chord-str 1)
"")))
(string-append "Bbm" rest-str)))
(else chord-str)))))
%% Helper function to convert H/h chords to B/Bm form for {define:} directives
#(define (german-h-to-b-form chord-str)
"Convert H/h chords to B/Bm format (e.g., 'H7' -> 'B7', 'h' -> 'Bm', 'h7' -> 'Bm7')"
(if (or (not (string? chord-str)) (string-null? chord-str))
chord-str
(let ((first-char (string-ref chord-str 0)))
(cond
;; Uppercase H -> B + rest
((char=? first-char #\H)
(string-append "B" (substring chord-str 1)))
;; Lowercase h -> Bm + rest (it's h-minor)
((char=? first-char #\h)
(let ((rest-str (if (> (string-length chord-str) 1)
(substring chord-str 1)
"")))
(string-append "Bm" rest-str)))
(else chord-str)))))
%% Konvertiert EINEN Akkord-Teil (Wurzel + Akkordform, OHNE /Basston) von
%% deutscher zu internationaler Notation -- Dispatch je nach Wurzelton.
%% german-accidentals-to-international deckt uebrigens auch Moll-Akkorde
%% und akzidenzien-freie Akkorde ab (deckt alles außer H/B), daher reicht
%% hier ein 3-Wege-Dispatch statt vier getrennter Funktionen.
#(define (chordpro-convert-chord-root chord-part)
(if (or (not (string? chord-part)) (string-null? chord-part))
chord-part
(let ((first-char (string-ref chord-part 0)))
(cond
((or (char=? first-char #\H) (char=? first-char #\h))
(german-h-to-b-form chord-part))
((or (char=? first-char #\B) (char=? first-char #\b))
(german-b-to-bb-form chord-part))
(else
(german-accidentals-to-international chord-part))))))
%% Wie chordpro-convert-chord-root, aber slash-chord-faehig: ein evtl.
%% vorhandener /Basston (z.B. "H/Dis" -> Akkord "H", Basston "Dis") ist
%% IMMER eine blanke Note (keine Akkordform, kein Moll) -- wird trotzdem
%% ueber denselben Dispatch konvertiert, der behandelt eine blanke
%% Note wie einen Akkord ohne Erweiterung korrekt (z.B. "Dis" -> "D#",
%% "H" -> "B"). Ohne diese Slash-Behandlung blieb der Basston bisher
%% unkonvertiert deutsch stehen (chordpro kennt "Dis"/"H" als Note nicht --
%% "Unknown chord to copy"/"Unknown chord", Akkord-Diagramm fehlte).
#(define (chordpro-convert-chord-string chord-str)
(if (or (not (string? chord-str)) (string-null? chord-str))
chord-str
(let ((slash-pos (string-index chord-str #\/)))
(if slash-pos
(string-append (chordpro-convert-chord-root (substring chord-str 0 slash-pos))
"/"
(chordpro-convert-chord-root (substring chord-str (+ slash-pos 1))))
(chordpro-convert-chord-root chord-str)))))
%% Merkt sich (original . international) fuer eine {define:}-Direktive,
%% falls die internationale Form vom Original abweicht (Akkord-Teil
%% und/oder /Basston) -- liefert IMMER das Original zurueck, das bleibt
%% als kompakte deutsche Inline-Notation im ChordPro-Text stehen.
#(define (track-and-return-chord song chord-str)
(if (or (not (string? chord-str)) (string-null? chord-str))
chord-str
(let ((converted (chordpro-convert-chord-string chord-str)))
(unless (or (string=? chord-str converted)
(assoc chord-str (chordpro-song-chord-defines song)))
(set-chordpro-song-chord-defines! song
(cons (cons chord-str converted) (chordpro-song-chord-defines song))))
chord-str)))
%% Wandelt eine ChordName-Markup in reinen Text um -- wie markup->string,
%% behandelt aber zusaetzlich \accidental-Glyphen (fuer veraenderte
%% Akkord-Stufen wie die verminderte Quinte/Septime in z.B. \chordmode
%% "a:1.3-.5-.7-") als #/b-Text. LilyPonds eigenes markup->string kennt nur
%% Text-Markups und laesst grafische Glyphen (auch fuer Akzidenzien
%% verwendet) klanglos weg -- ohne diese Sonderbehandlung geht die
%% Erniedrigt/Erhoeht-Information einer veraenderten Stufe verloren, z.B.
%% wird aus "7-5-" (verm. Septakkord) einfach "75" (siehe
%% [[chordpro-music-collector-context-bug]]).
#(define (chordpro-markup->plain-string m)
(cond
((string? m) m)
((not (pair? m)) "")
(else
(let ((cmd (car m)) (args (cdr m)))
(cond
((eq? cmd accidental-markup)
(let ((alteration (car args)))
(cond ((> alteration 0) "#") ((< alteration 0) "b") (else ""))))
((or (eq? cmd line-markup) (eq? cmd concat-markup))
(string-concatenate (map chordpro-markup->plain-string (car args))))
((or (eq? cmd smaller-markup) (eq? cmd translate-scaled-markup)
(eq? cmd super-markup) (eq? cmd sub-markup) (eq? cmd bold-markup))
(chordpro-markup->plain-string (car (last-pair args))))
((eq? cmd hspace-markup) "")
(else ""))))))
%% Helper function to convert chord music object to chord name string
#(define (music-to-chord-name chord-music)
"Extract pitches from a chord music object and convert to German chord name"
(if (not chord-music)
""
(let* ((pitches (music-pitches chord-music)))
(if (or (not pitches) (null? pitches))
"" ; No pitches found
(let* (;; Use ignatzek chord naming with German root names
(chord-markup ((chord-name:name-markup 'deutsch) pitches #f #f #f))
;; Convert markup to string
(chord-str (if (markup? chord-markup)
(markup->string chord-markup)
""))
;; Remove spaces
(cleaned (string-delete #\space chord-str)))
cleaned)))))
%% Helper function to normalize multiple spaces to single space
#(define (normalize-spaces str)
"Replace multiple consecutive spaces with a single space"
(let loop ((chars (string->list str))
(result '())
(prev-was-space #f))
(if (null? chars)
(list->string (reverse result))
(let ((char (car chars)))
(if (char=? char #\space)
(if prev-was-space
;; Skip this space
(loop (cdr chars) result #t)
;; Keep this space
(loop (cdr chars) (cons char result) #t))
;; Not a space
(loop (cdr chars) (cons char result) #f))))))
%% Helper function to extract chord names from markup, handling \altChord format
#(define (extract-chord-names-from-markup markup)
"Extract chord names from markup, handling complex structures like \altChord which produces 'B(Gm)' format"
(let* ((raw-str (cond
((string? markup) markup)
((markup? markup) (chordpro-markup->plain-string markup))
((pair? markup) (extract-chord-names-from-markup (car markup)))
(else (format #f "~a" markup))))
;; Remove all spaces
(clean-str (string-delete #\space raw-str)))
;; Check if this is an altChord format: "B(Gm)" or similar
(if (string-index clean-str #\()
;; Multiple chords: split by parentheses
(let* ((open-paren (string-index clean-str #\())
(close-paren (string-index clean-str #\)))
(first-chord (substring clean-str 0 open-paren))
(second-chord (if (and open-paren close-paren)
(substring clean-str (+ open-paren 1) close-paren)
"")))
;; Format as:[B][(Gm)] - first chord normal, second in parens
(string-append first-chord "][(" second-chord ")"))
;; Single chord: return as is
clean-str)))
%% 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"
(let* ((has-numbers (and stanza-numbers (not (null? stanza-numbers))))
(numbers-string (if has-numbers
(string-join (map (lambda (n) (format #f "~a" n)) stanza-numbers) ", ")
"")))
(cond
((eq? stanza-type 'ref)
(if has-numbers
(format #f (if (defined? 'refStringWithNumbers) refStringWithNumbers "Ref. ~a:") numbers-string)
(if (defined? 'refString) refString "Ref.:")))
((eq? stanza-type 'bridge)
(if has-numbers
(format #f (if (defined? 'bridgeStringWithNumbers) bridgeStringWithNumbers "Bridge ~a:") numbers-string)
(if (defined? 'bridgeString) bridgeString "Bridge:")))
(else #f))))
%% Verarbeitet einen ChordName-Grob zu einem ChordPro-Akkordnamen (inkl.
%% Klammer-Notation fuer altChord und Umwandlung deutscher Akkordnamen);
%% trackt dabei nebenbei ins song's chordpro-song-*-chords (fuer die
%% {define:}-Direktiven). Liefert #f fuer leere Akkorde (nichts zu tun).
%% Gemeinsam genutzt von ChordPro_score_collector (chordlyrics) und
%% ChordPro_music_collector (Noten).
#(define (chordpro-extract-chord-name song grob)
(let* ((details (ly:grob-property grob 'details '()))
(alt-main-name (assoc-get 'alt-chord-main-name details #f))
(alt-alt-name (assoc-get 'alt-chord-alt-name details #f))
(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 song alt-main-name))
(alt (track-and-return-chord song alt-alt-name)))
(if (string-null? main)
(string-append "[(" alt ")]") ; Only alt chord: [(D7)]
(string-append "[" main "][(" alt ")]")))
;; Normal chord - extract from markup text
(let* ((chord-text (ly:grob-property grob 'text))
(chord-names-str (extract-chord-names-from-markup chord-text))
(has-bracket (string-index chord-names-str #\])))
(if has-bracket
;; Multiple chords from old logic: manually split and process
(let* ((bracket-pos (string-index chord-names-str #\]))
(first-part (substring chord-names-str 0 bracket-pos))
(rest (substring chord-names-str bracket-pos))
(open-pos (string-index rest #\())
(close-pos (string-index rest #\)))
(second-part (if (and open-pos close-pos)
(substring rest (+ open-pos 1) close-pos)
""))
(first-converted (track-and-return-chord song first-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 song chord-names-str))))))
;; Filter out completely empty chords, but convert ][(X) to [(X)]
(cond
((or (string-null? chord-name-final)
(string=? chord-name-final "")
(string=? chord-name-final "]["))
#f) ; Filter out
((string-prefix? "][(" chord-name-final)
;; ][(D7) → [(D7)]
(let* ((inner (substring chord-name-final 3 (- (string-length chord-name-final) 1))))
(string-append "[(" inner ")]")))
(else chord-name-final))))
%% Single engraver in Score context
#(define ChordPro_score_collector
(lambda (context)
(let ((song #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)
;; \chordlyrics hat den aktiven Song-Key vor der Interpretation gesetzt;
;; jeder \chordlyrics-Score ist ein Vers dieses Lieds.
(set! song (chordpro-get-song (or chordpro-active-song-key "output")))
(set! this-verse-index (chordpro-song-verse-index song))
(set-chordpro-song-verse-index! song (+ this-verse-index 1))
(let ((order (or chordpro-active-doc-order (cons 0 0))))
(set! doc-seq (car order))
(set! doc-pos (cdr order)))
(record-verse-order! this-verse-index))
;; Event listeners
(listeners
;; LyricEvent from Lyrics context
((lyric-event engraver event)
(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)
;; Save previous syllable if any (it had no hyphen)
(save-pending! #f)
;; 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)
(save-pending! #t))
;; 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-song-breaks! song
(cons (cons moment this-verse-index) (chordpro-song-breaks song))))))
;; Acknowledge grobs from child contexts
(acknowledgers
;; StanzaNumber grobs to extract stanza type and text
((stanza-number-interface engraver grob source-engraver)
(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))
;; \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))
;; Try to read stanza text from multiple sources:
;; 1. From the grob's text property
(stanza-text-from-grob (ly:grob-property grob 'text #f))
;; 2. From the Lyrics context's stanza property
(lyrics-context (ly:translator-context source-engraver))
(stanza-text-from-context (if lyrics-context
(ly:context-property lyrics-context 'stanza #f)
#f))
;; Use context property if available, otherwise grob property
(stanza-markup (or stanza-text-from-context stanza-text-from-grob))
;; For ref/bridge, always use format-chordpro-stanza-label
;; For verse, extract from markup (includes roman numerals if \romanStanza was used)
(stanza-text (if (or (eq? stanza-type 'ref) (eq? stanza-type 'bridge))
(format-chordpro-stanza-label stanza-type stanza-numbers)
(if (markup? stanza-markup)
(markup->string stanza-markup)
(if stanza-markup
(format #f "~a" stanza-markup)
#f))))
(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-song-inline-texts! song
(cons (list moment this-verse-index custom-inline-text custom-inline-direction)
(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-song-inline-texts! song
(cons (list moment this-verse-index stanza-text direction)
(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 numbers)
(when custom-realstanza
(let* ((existing-text (and existing (cadr existing)))
(existing-type (and existing (caddr existing)))
(existing-realstanza (and existing (> (length existing) 3) (cadddr existing)))
(existing-numbers (or (and existing (> (length existing) 4) (list-ref existing 4)) '()))
;; Reprint desselben Markers (Strophennummer am Zeilen-
;; umbruch erneut gedruckt, ggf. als Nummern-Obermenge
;; 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-realstanza
existing-text
(or stanza-text existing-text))
stanza-type
#t
(if existing-realstanza existing-numbers stanza-numbers))
entry))
(chordpro-song-stanza-numbers song))))
;; ANDERER echter Marker im selben \chordlyrics (z.B.
;; Refrain nach der Strophe): neuen logischen Vers beginnen.
;; Alles ab hier (inkl. einer im selben Timestep schon
;; 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
((chord-name-interface engraver grob source-engraver)
(let ((moment (ly:context-current-moment context))
(processed-chord-name (chordpro-extract-chord-name song grob)))
;; Store grob reference along with chord data (unless empty)
;; Format: (moment chord-name verse-index grob)
(when processed-chord-name
(set-chordpro-song-chords! song
(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)
(let* ((stanza-grob (ly:grob-property grob 'stanza #f))
;; Get the Lyrics context from the source engraver
(lyrics-context (ly:translator-context source-engraver))
(stanza-context (if lyrics-context
(ly:context-property lyrics-context 'stanza #f)
#f))
(stanza-value (or stanza-grob stanza-context)))
(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-song-stanza-numbers song)))
(existing-text (if existing (cadr existing) #f))
(stanza-text (if (markup? stanza-value)
(markup->string stanza-value)
(format #f "~a" stanza-value))))
;; Only update if entry exists and existing text is empty/false and new text is non-empty
(when (and existing
(not (and (string? existing-text) (not (string-null? existing-text))))
(string? stanza-text)
(not (string-null? stanza-text)))
;; Update existing entry with text (keep type and realstanza flag)
(set-chordpro-song-stanza-numbers! song
(map (lambda (entry)
(if (= (car entry) this-verse-index)
(list (car entry)
(or existing-text stanza-text) ; Keep existing text if present
(caddr entry) ; Keep stanza-type
(if (> (length entry) 3) (cadddr entry) #f)) ; Keep realstanza-flag if exists
entry))
(chordpro-song-stanza-numbers song)))))))) ; schließt lyric-syllable-interface
) ; schließt acknowledgers
;; End of timestep
((stop-translation-timestep engraver)
(save-pending! #f))
;; Finalize - just save leftovers, don't filter chords yet
;; (Filtering happens in chordpro-write-song where grob properties are final)
((finalize engraver)
;; Save any remaining pending syllable
(save-pending! #f))))))
%% Zweiter Collector-Engraver: sammelt Strophen UNTER DEN NOTEN (im
%% MUSIC-Teil), nicht nur aus \chordlyrics -- fuellt damit Luecken wie
%% eine nur dort stehende erste Strophe oder einen nur dort stehenden
%% Refrain (siehe chordpro-include-music-lyrics). Sitzt auf Score-Ebene
%% wie ChordPro_score_collector, sieht daher sowohl die parallele
%% ChordNames-Stimme (Akkorde -- global fuers ganze Lied, alle Strophen
%% unter den Noten teilen sich dieselbe Melodie/Zeitachse) als auch ALLE
%% Lyrics-Kontexte (\addlyrics/\lyricsto). Mehrere Strophen/Stimmen
%% koennen dabei in EINEM Score zusammenlaufen -- Silben werden deshalb
%% ueber source-engraver -> Kontext in getrennte "Buckets" sortiert
%% (nicht wie bei chordlyrics ueber mehrere Engraver-Instanzen: dort hat
%% jeder \chordlyrics-Aufruf seinen eigenen Mini-Score). Buckets ohne
%% echten Strophenmarker (reine Dekoration/Lautmalerei ohne
%% #(stanza n)/\ref/\bridge) werden beim Schreiben verworfen.
#(define ChordPro_music_collector
(lambda (context)
(let ((song #f)
;; Immer \consists't (wie chordpro-delayed-write); schaltet
;; sich ueber die Flag selbst ab statt bedingt eingebunden zu
;; werden -- einmal pro Engraver-Instanz gelesen, aendert sich
;; waehrend eines Durchlaufs nicht.
(enabled? (and (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics))
;; Lyrics-Kontext (eq?) -> Bucket (Hashtabelle mit den Feldern
;; syllables/stanza/type/marked)
(buckets (make-hash-table))
;; Reihenfolge, in der Buckets zuerst angelegt wurden --
;; hash-table-Reihenfolge ist unspezifiziert, das hier ist es
;; nicht (fuer eine nachvollziehbare Kandidaten-Reihenfolge).
(bucket-order '()))
(define (bucket-for lyr-context)
(or (hashq-ref buckets lyr-context #f)
(let ((b (make-hash-table)))
(hashq-set! b 'syllables '())
(hashq-set! b 'stanza #f)
(hashq-set! b 'type 'verse)
(hashq-set! b 'marked #f)
(hashq-set! buckets lyr-context b)
(set! bucket-order (cons lyr-context bucket-order))
b)))
;; Song-Key bevorzugt aus der Score-Context-Property (siehe
;; book_include.ily), die per \applyContext DIREKT IN DER MUSIK
;; gesetzt wird und deshalb korrekt bleibt, auch wenn LilyPond die
;; \score-Bloecke mehrerer Lieder gesammelt/verzoegert interpretiert
;; (Buch) -- ein globales chordpro-active-song-key waere zu diesem
;; Zeitpunkt schon auf ein ANDERES Lied gesetzt. WICHTIG: (initialize
;; engraver) laeuft bei Context-Erzeugung, VOR jeder Musik-Interpretation
;; -- \applyContext (ein Musik-Ereignis) hat die Property zu diesem
;; Zeitpunkt noch nicht gesetzt. Deshalb wird der Song erst BEIM ERSTEN
;; TATSAECHLICHEN GEBRAUCH (Listener/Acknowledger-Aufruf, Timestep >= 0,
;; also nach \applyContext) aufgeloest, nicht in initialize.
;; chordpro-active-song-key bleibt Fallback (Einzellied-Standalone-Pfad,
;; dort synchron genug).
(define (resolve-song!)
(unless song
(let ((global-ctx (ly:context-parent context)))
(set! song (chordpro-get-song
(or (and global-ctx (hashq-ref chordpro-context-song-keys global-ctx #f))
chordpro-active-song-key
"output"))))))
(make-engraver
(listeners
;; Umbrueche sind Score-weit (betreffen alle Stimmen gleich) --
;; global sammeln, nicht pro Bucket.
((break-event engraver event)
(when enabled?
(resolve-song!)
;; format-verse-as-chordpro erwartet (moment . irgendwas)-Paare
;; (liest nur (car b)); #f als Fuellwert, da kein Vers-Index
;; noetig ist -- diese Breaks sind global fuers ganze Lied.
(set-chordpro-song-music-breaks! song
(cons (cons (ly:context-current-moment context) #f) (chordpro-song-music-breaks song))))))
(acknowledgers
;; Akkorde: global fuers ganze Lied, wie bei ChordPro_score_collector.
((chord-name-interface engraver grob source-engraver)
(when enabled?
(resolve-song!)
(let ((moment (ly:context-current-moment context))
(processed-chord-name (chordpro-extract-chord-name song grob)))
(when processed-chord-name
(set-chordpro-song-music-chords! song
(cons (list moment processed-chord-name) (chordpro-song-music-chords song)))))))
;; Silben: pro Lyrics-Kontext-Instanz (via source-engraver) in
;; getrennte Buckets, damit mehrere \addlyrics/\lyricsto nicht
;; ineinanderlaufen. Trennstrich-Info kommt aus der cause-Kette
;; des Grobs zurueck zum urspruenglichen LyricEvent -- dieselbe
;; Konvention wie in der Statik (data_extractor.ily): eine Silbe
;; ist "getrennt" (verbindet sich mit der naechsten), wenn SIE
;; SELBST eine HyphenEvent-Artikulation hat.
((lyric-syllable-interface engraver grob source-engraver)
(when enabled?
(let* ((lyr-context (ly:translator-context source-engraver))
(text (ly:grob-property grob 'text))
(cause (ly:grob-property grob 'cause))
(mcause (and cause (ly:event-property cause 'music-cause)))
(has-hyphen (and (ly:music? mcause)
(any (lambda (a) (eq? (ly:music-property a 'name) 'HyphenEvent))
(ly:music-property mcause 'articulations '())))))
;; "_"-Skips (Melisma-Platzhalter) kommen als Leerzeichen an
;; und werden ignoriert, wie in der Statik.
(when (and (string? text) (not (string-null? (string-trim-both text))))
(let ((bucket (bucket-for lyr-context)))
(hashq-set! bucket 'syllables
(cons (list (ly:context-current-moment lyr-context) text has-hyphen)
(hashq-ref bucket 'syllables))))))))
;; Strophenmarker: pro Kontext, nur der ERSTE echte Marker zaehlt
;; (ein \addlyrics-Block unter den Noten hat ueblicherweise genau
;; einen #(stanza n)/\ref/\bridge am Anfang).
((stanza-number-interface engraver grob source-engraver)
(when enabled?
(let* ((lyr-context (ly:translator-context source-engraver))
(bucket (bucket-for lyr-context))
(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 (or (ly:assoc-get 'custom-stanzanumber-override details #f)
(ly:assoc-get 'custom-stanza-numbers details '())))
(stanza-text-from-grob (ly:grob-property grob 'text #f))
(stanza-text-from-context (ly:context-property lyr-context 'stanza #f))
(stanza-markup (or stanza-text-from-context stanza-text-from-grob))
(label (if (or (eq? stanza-type 'ref) (eq? stanza-type 'bridge))
(format-chordpro-stanza-label stanza-type stanza-numbers)
(if (markup? stanza-markup)
(markup->string stanza-markup)
(if stanza-markup (format #f "~a" stanza-markup) #f)))))
(when (and custom-realstanza (not (hashq-ref bucket 'marked)))
(hashq-set! bucket 'marked #t)
(hashq-set! bucket 'stanza (or label ""))
(hashq-set! bucket 'type stanza-type))))))
((finalize engraver)
;; Markierte Buckets in der Reihenfolge ihres ersten Auftretens
;; als Kandidaten in den Store uebernehmen; unmarkierte
;; (dekorative Stimmen ohne echten Strophenmarker) verwerfen.
(when enabled?
(resolve-song!)
(for-each
(lambda (lyr-context)
(let ((bucket (hashq-ref buckets lyr-context)))
(when (hashq-ref bucket 'marked)
(set-chordpro-song-music-candidates! song
(cons (list (cons 'syllables (reverse (hashq-ref bucket 'syllables)))
(cons 'stanza (hashq-ref bucket 'stanza))
(cons 'type (hashq-ref bucket 'type)))
(chordpro-song-music-candidates song))))))
(reverse bucket-order))))))))
%% Entfernt aufeinanderfolgende Wiederholungen desselben Akkordnamens --
%% nur bei einem tatsaechlichen Akkordwechsel soll ein neuer Akkord in der
%% ChordPro-Ausgabe erscheinen, nicht bei jedem erneuten Anschlag desselben
%% Akkords. chords-list: Liste von (moment chord-name . irgendwas), Reihen-
%% folge chronologisch. Von chordpro-format-song fuer sowohl \chordlyrics-
%% Strophen als auch aus der Musik nachgeholte Kandidaten genutzt (dort
%% fehlte dieser Schritt urspruenglich, siehe [[chordpro-music-collector-context-bug]]).
#(define (chordpro-filter-repeated-chords chords-list)
(let filter-repeats ((chords-left chords-list) (last-chord #f) (result '()))
(if (null? chords-left)
(reverse result)
(let* ((chord (car chords-left))
(chord-name (cadr chord)))
(if (equal? chord-name last-chord)
(filter-repeats (cdr chords-left) last-chord result)
(filter-repeats (cdr chords-left) chord-name (cons chord result)))))))
%% Formatiert einen einzelnen Strophen-/Refrain-/Bridge-Block als
%% ChordPro-String (mit den passenden Direktiven bzw. als Kommentar bei
%% Nicht-Realstanza-Fragmenten). Von chordpro-format-song fuer sowohl
%% \chordlyrics-Strophen als auch aus der Musik nachgeholte Kandidaten
%% genutzt.
#(define (chordpro-format-verse-block realstanza stanza-type label body-text)
(let ((start-directive (cond ((eq? stanza-type 'ref) "start_of_chorus")
((eq? stanza-type 'bridge) "start_of_bridge")
(else "start_of_verse")))
(end-directive (cond ((eq? stanza-type 'ref) "end_of_chorus")
((eq? stanza-type 'bridge) "end_of_bridge")
(else "end_of_verse")))
(has-label (and label (string? label) (not (string-null? label)))))
(with-output-to-string
(lambda ()
(if realstanza
(begin
(if has-label
(display (format #f "{~a: label=\"~a\"}\n" start-directive label))
(display (format #f "{~a}\n" start-directive)))
(display body-text)
(display (format #f "\n{~a}\n\n" end-directive)))
(begin
(when has-label
(display (format #f "# ~a\n" label)))
(display body-text)
(display "\n\n")))))))
%% Helper functions to format and write ChordPro
#(define (chordpro-format-song song)
"Format one song's collected engraver data as a ChordPro string."
(let* ((num-verses (chordpro-song-verse-index song))
;; Reverse all lists (they were collected in reverse order)
(syllables (reverse (chordpro-song-syllables song)))
(chords (reverse (chordpro-song-chords song)))
(breaks (reverse (chordpro-song-breaks song)))
(stanza-numbers (chordpro-song-stanza-numbers song))
(inline-texts (chordpro-song-inline-texts song))
(chord-defines (reverse (chordpro-song-chord-defines song))))
(with-output-to-string
(lambda ()
;; Write metadata
(display (format #f "{title: ~a}\n" (or (chordpro-song-title song) "Untitled")))
(when (chordpro-song-authors song)
(for-each (lambda (name) (display (format #f "{artist: ~a}\n" name)))
(chordpro-all-author-names (chordpro-song-authors song)))
(for-each (lambda (name) (display (format #f "{composer: ~a}\n" name)))
(chordpro-authors-by-role 'melody (chordpro-song-authors song)))
(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))))
;; {define:} directives: B/b (German B = English Bb), H/h (German H =
;; English B), Akzidenzien (is/es -> #/b), jeweils inkl. /Basston.
(unless (null? chord-defines)
(newline))
(for-each
(lambda (pair)
(let* ((original (car pair))
(converted (cdr pair))
(diagram (assoc-ref chordpro-custom-chord-diagrams converted)))
(if diagram
(display (format #f "{define: ~a base-fret ~a frets ~a}\n"
original (car diagram)
(string-join (map (lambda (f) (format #f "~a" f)) (cdr diagram)) " ")))
(display (format #f "{define: ~a copy ~a}\n" original converted)))))
chord-defines)
(newline)
;; \chordlyrics-Strophen zu (label realstanza block-string) auswerten,
;; statt sie sofort zu schreiben -- die aus der Musik nachgeholten
;; Kandidaten (falls chordpro-include-music-lyrics) muessen erst
;; wissen, welche Label schon abgedeckt sind (chordlyrics gewinnt
;; bei Konflikt, da dort Akkorde UND die gedruckte Textseite
;; dahinterstehen).
(let* ((chordlyrics-blocks
(filter-map
(lambda (verse-idx)
(let* ((verse-syllables (filter (lambda (s) (= (cadddr s) verse-idx)) syllables))
(verse-chords-raw (filter (lambda (c)
(and (list? c)
(>= (length c) 3)
(= (caddr c) verse-idx)))
chords))
;; Nur Akkordwechsel ausgeben, keine Wiederholungen
(verse-chords (chordpro-filter-repeated-chords verse-chords-raw))
(verse-breaks (filter (lambda (b) (= (cdr b) verse-idx)) breaks))
(verse-inline-texts (filter (lambda (r) (= (cadr r) verse-idx))
(reverse inline-texts)))
(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)))
(and (not (null? verse-syllables))
(list stanza-num
(chordpro-format-verse-block realstanza stanza-type stanza-num
(format-verse-as-chordpro verse-syllables verse-chords verse-breaks verse-inline-texts))))))
(chordpro-song-ordered-verse-indices song)))
(chordlyrics-labels (filter-map (lambda (b) (and (string? (car b))
(not (string-null? (car b)))
(car b)))
chordlyrics-blocks))
;; Aus der Musik nachgeholte Kandidaten: nur wenn gewuenscht,
;; und nur die, deren Label NICHT schon von \chordlyrics
;; abgedeckt ist (auch nicht von einem VORHERIGEN Kandidaten
;; -- z.B. mehrere Stimmen, die alle denselben Refrain
;; markiert haben).
(music-chords (chordpro-filter-repeated-chords (reverse (chordpro-song-music-chords song))))
(music-breaks (reverse (chordpro-song-music-breaks song)))
(music-blocks
(if (and (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics)
(let loop ((candidates (reverse (chordpro-song-music-candidates song)))
(covered chordlyrics-labels)
(acc '()))
(if (null? candidates)
(reverse acc)
(let* ((candidate (car candidates))
(label (assq-ref candidate 'stanza))
(type (assq-ref candidate 'type))
(candidate-syllables (assq-ref candidate 'syllables))
(has-label (and (string? label) (not (string-null? label)))))
(if (and has-label (member label covered))
(loop (cdr candidates) covered acc)
(loop (cdr candidates)
(if has-label (cons label covered) covered)
(cons (chordpro-format-verse-block #t type label
(format-verse-as-chordpro candidate-syllables music-chords music-breaks '()))
acc))))))
'())))
;; Nachgeholte Strophen (typischerweise Strophe 1 und/oder Refrain)
;; kommen vor den \chordlyrics-Strophen -- das deckt den weit
;; ueberwiegenden Praxisfall (fehlende erste Strophe/Refrain
;; gehoert an den Anfang); eine perfekte Einsortierung nach
;; Strophennummer bei exotischeren Luecken waere deutlich
;; aufwendiger und lohnt den Mehraufwand fuer diesen Randfall nicht.
(for-each display music-blocks)
(for-each (lambda (b) (display (cadr b))) chordlyrics-blocks))))))
%% 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.
Chords are placed at syllable boundaries, not word boundaries.
Inline texts (𝄆 𝄇 etc.) are inserted based on their direction property."
(let* (;; Get break moments
(break-moments (sort (map (lambda (b) (ly:moment-main (car b))) breaks) <))
;; Map each chord to the nearest following syllable
(chord-to-syllable-map (map-chords-to-syllables chords syllables))
;; Sort inline texts by moment
(sorted-inline-texts (sort inline-texts (lambda (a b) (ly:moment<? (car a) (car b)))))
;; Build formatted output
(lines '())
(current-line '())
(current-word-parts '())
(pending-word-suffix-chords '()) ; Collect suffix chords during word building
(word-start-moment #f))
;; Process each syllable
(let process-syllables ((syls-left syllables) (syl-idx 0) (breaks-left break-moments) (inlines-left sorted-inline-texts) (pending-line-chords '()))
(if (null? syls-left)
;; Finish last word and line
(begin
(unless (null? current-word-parts)
;; Append pending suffix chords to the last word part
(when (not (null? pending-word-suffix-chords))
(let ((last-part (car current-word-parts))
(suffix-str (string-concatenate (reverse pending-word-suffix-chords))))
(set! current-word-parts (cons (string-append last-part suffix-str) (cdr current-word-parts)))
(set! pending-word-suffix-chords '())))
(set! current-line (cons (string-concatenate (reverse current-word-parts)) current-line)))
(unless (null? current-line)
(set! lines (cons (reverse current-line) lines))))
;; Process next syllable
(let* ((syl-entry (car syls-left))
(syl-moment (ly:moment-main (car syl-entry)))
(syl-text-raw (cadr syl-entry))
;; Normalize: treat whitespace-only strings as empty (lyric extenders come as spaces)
(syl-text (if (and (string? syl-text-raw)
(not (string-null? syl-text-raw))
(string-every char-set:whitespace syl-text-raw))
""
syl-text-raw))
(has-hyphen (caddr syl-entry))
(rest-syls (cdr syls-left))
;; Find chords for this syllable position (including extenders!)
(syl-chords (filter (lambda (cm) (= (caddr cm) syl-idx)) chord-to-syllable-map))
;; Separate chords into prefix (before/on syllable) and suffix (after syllable)
;; Separate chords into prefix (before/on syllable) and suffix (after syllable)
(prefix-chords (filter (lambda (c) (<= (ly:moment-main (car c)) syl-moment)) syl-chords))
(suffix-chords-all (filter (lambda (c) (> (ly:moment-main (car c)) syl-moment)) syl-chords))
;; Filter suffix chords: only keep those where NO line break exists between syllable and chord
;; If a break is between the syllable and chord, the chord belongs to the next line
(suffix-chords (filter (lambda (c)
(let ((chord-moment (ly:moment-main (car c))))
;; Keep chord if no break exists, or if break is not between syl and chord
(or (null? breaks-left)
(let ((next-break (car breaks-left)))
;; Only keep if break is AFTER the chord (or before/at syllable)
;; Reject if: syl-moment < next-break <= chord-moment
(not (and (> next-break syl-moment)
(<= next-break chord-moment)))))))
suffix-chords-all))
;; Collect chords that were filtered out - they belong to the next line
(next-line-chords (filter (lambda (c)
(let ((chord-moment (ly:moment-main (car c))))
(and (not (null? breaks-left))
(let ((next-break (car breaks-left)))
(and (> next-break syl-moment)
(<= next-break chord-moment))))))
suffix-chords-all))
;; Create chord prefix: add space after chord if it plays on a rest (before syllable)
(chord-prefix (if (null? prefix-chords)
""
(string-join
(map (lambda (c)
(let* ((chord-moment (ly:moment-main (car c)))
(chord-name (cadr c))
;; Check if chord plays before syllable (on a rest)
(on-rest? (< chord-moment syl-moment))
;; Check if chord already has brackets
(has-brackets (string-prefix? "[" chord-name)))
(if has-brackets
;; Already has brackets - just add space if needed
(if on-rest?
(string-append chord-name " ")
chord-name)
;; Add brackets
(if on-rest?
(string-append "[" chord-name "] ")
(string-append "[" chord-name "]")))))
prefix-chords)
"")))
;; Create chord suffix for chords that play after the syllable (on rests)
(chord-suffix (if (null? suffix-chords)
""
(string-join
(map (lambda (c)
(let ((chord-name (cadr c)))
;; Check if chord already has brackets (e.g., "[(D7)]")
(if (string-prefix? "[" chord-name)
chord-name ; Already has brackets
(string-append "[" chord-name "]"))))
suffix-chords)
"")))
;; Check for line break
(next-syl-moment (if (null? rest-syls) 999999 (ly:moment-main (car (car rest-syls)))))
(break-here (and (not (null? breaks-left))
(let ((next-break (car breaks-left)))
(and (> next-break syl-moment)
(<= next-break next-syl-moment))))))
;; Check for inline texts at this syllable position
(let* ((inline-result
(let collect-inlines ((inls inlines-left) (collected '()))
(if (or (null? inls)
(let ((inl-entry (car inls)))
(> (ly:moment-main (car inl-entry)) syl-moment)))
(list (reverse collected) inls)
(collect-inlines (cdr inls) (cons (car inls) collected)))))
(inlines-to-insert (car inline-result))
(new-inlines-left (cadr inline-result))
;; Separate by direction: LEFT texts go before, RIGHT texts go after
(before-texts (filter (lambda (i) (eqv? (cadddr i) LEFT)) inlines-to-insert))
(after-texts (filter (lambda (i) (eqv? (cadddr i) RIGHT)) inlines-to-insert)))
;; If this is the start of a new line and we have pending chords from the previous line
(when (and (null? current-line) (not (null? pending-line-chords)))
;; If we're continuing a word (current-word-parts not empty), add chords as infix
;; Otherwise add them as a separate word-like element
(if (not (null? current-word-parts))
;; Add pending chords as infix to the last word part
(let* ((last-part (car current-word-parts))
(rest-parts (cdr current-word-parts))
(pending-chord-str (string-join
(map (lambda (c)
(let ((chord-name (cadr c)))
(if (string-prefix? "[" chord-name)
chord-name ; Already has brackets
(string-append "[" chord-name "]"))))
pending-line-chords)
"")))
(set! current-word-parts (cons (string-append last-part pending-chord-str) rest-parts)))
;; No word continuation - add as separate element
(let ((pending-chord-str (string-join
(map (lambda (c)
(let ((chord-name (cadr c)))
(if (string-prefix? "[" chord-name)
chord-name ; Already has brackets
(string-append "[" chord-name "]"))))
pending-line-chords)
"")))
(set! current-line (cons pending-chord-str current-line)))))
;; Insert texts that should appear BEFORE the syllable (direction = LEFT)
(for-each
(lambda (inline-text)
(set! current-line (cons (caddr inline-text) current-line)))
before-texts)
;; Track word start
(when (null? current-word-parts)
(set! word-start-moment syl-moment))
;; Add text to current word only if syllable is not empty (not a lyric extender _)
;; Handle chords: if we're continuing a word (current-word-parts not empty),
;; prefix chords should be inserted between syllables as infixes (without trailing space)
(unless (string-null? syl-text)
(if (null? current-word-parts)
;; First syllable of word: use prefix as normal
(set! current-word-parts (cons (string-append chord-prefix syl-text) current-word-parts))
;; Continuation of word: insert prefix chord between previous syllable and this one
(begin
;; Append prefix chord to the LAST syllable (strip trailing space from chord-prefix for infix use)
(unless (string-null? chord-prefix)
(let* ((last-part (car current-word-parts))
(rest-parts (cdr current-word-parts))
;; Remove trailing space from chord-prefix if present
(chord-infix (if (string-suffix? " " chord-prefix)
(substring chord-prefix 0 (- (string-length chord-prefix) 1))
chord-prefix)))
(set! current-word-parts (cons (string-append last-part chord-infix) rest-parts))))
;; Add current syllable
(set! current-word-parts (cons syl-text current-word-parts)))))
;; Always collect suffix chords (even from extenders), they'll be output at word end
(unless (string-null? chord-suffix)
(set! pending-word-suffix-chords (cons chord-suffix pending-word-suffix-chords)))
;; Complete word only if: no hyphen AND syllable has text (not an extender)
(when (and (not has-hyphen) (not (string-null? syl-text)))
(if (null? current-word-parts)
;; No word parts (shouldn't happen) - just output suffix chords if any
(unless (null? pending-word-suffix-chords)
(set! current-line (cons (string-concatenate (reverse pending-word-suffix-chords)) current-line))
(set! pending-word-suffix-chords '()))
;; Normal word completion with all collected suffix chords
(let ((word-with-suffix
(if (null? pending-word-suffix-chords)
(string-concatenate (reverse current-word-parts))
(string-append
(string-concatenate (reverse current-word-parts))
(string-concatenate (reverse pending-word-suffix-chords))))))
(set! current-line (cons word-with-suffix current-line))
(set! current-word-parts '())
(set! pending-word-suffix-chords '()))))
(for-each
(lambda (inline-text)
(set! current-line (cons (caddr inline-text) current-line)))
after-texts)
;; If break here, complete line (word parts continue on next line)
(if break-here
(begin
(set! lines (cons (reverse current-line) lines))
(set! current-line '())
(process-syllables rest-syls (+ syl-idx 1) (cdr breaks-left) new-inlines-left next-line-chords))
(process-syllables rest-syls (+ syl-idx 1) breaks-left new-inlines-left '())))))
;; Format all lines and normalize multiple spaces
(string-join
(map (lambda (line-words)
(let ((line (string-join line-words " ")))
(normalize-spaces line)))
(reverse lines))
"\n"))))
#(define (map-chords-to-syllables chords syllables)
"For each chord, find the nearest following syllable.
If no following syllable within tolerance, use the last preceding syllable.
Returns list of (chord-moment chord-name syllable-index)"
(let ((tolerance (ly:make-moment 1/4)))
(filter-map
(lambda (chord-entry)
(let* ((chord-moment (car chord-entry))
(chord-name (cadr chord-entry))
;; Find syllables that start AT or AFTER this chord (within tolerance)
(candidate-syllables-forward
(filter-map
(lambda (syl-entry syl-idx)
(let* ((syl-moment (car syl-entry))
(diff (ly:moment-sub syl-moment chord-moment)))
;; Syllable must start at or after chord, within tolerance
(if (and (not (ly:moment<? diff (ly:make-moment 0))) ; diff >= 0
(ly:moment<=? diff tolerance))
(list diff syl-idx)
#f)))
syllables
(iota (length syllables))))) ; syllable indices
;; If no forward match, try to find the last syllable BEFORE the chord
(if (not (null? candidate-syllables-forward))
;; Pick the closest following syllable (smallest diff)
(let* ((sorted (sort candidate-syllables-forward (lambda (a b) (ly:moment<? (car a) (car b)))))
(best (car sorted))
(best-syl-idx (cadr best)))
(list chord-moment chord-name best-syl-idx))
;; No following syllable - find last preceding syllable
(let ((preceding-syllables
(filter-map
(lambda (syl-entry syl-idx)
(let* ((syl-moment (car syl-entry))
(diff (ly:moment-sub chord-moment syl-moment)))
;; Chord must come after syllable (diff > 0)
(if (ly:moment<? (ly:make-moment 0) diff)
(list diff syl-idx syl-moment)
#f)))
syllables
(iota (length syllables)))))
(if (null? preceding-syllables)
#f ; No syllables at all - skip this chord
;; Pick the latest preceding syllable (smallest diff = closest before chord)
(let* ((sorted (sort preceding-syllables (lambda (a b) (ly:moment<? (car a) (car b)))))
(best (car sorted))
(best-syl-idx (cadr best)))
(list chord-moment chord-name best-syl-idx)))))))
chords)))
#(define (join-syllables-into-words syllables)
"Join syllables into words based on hyphen flags"
;; syllables structure: (moment text has-hyphen verse-idx)
(let ((result '())
(current-word-parts '())
(word-start-moment #f))
(for-each
(lambda (syl-entry)
(let* ((moment (car syl-entry))
(text (cadr syl-entry))
(has-hyphen (caddr syl-entry)))
;; Track the moment of the first syllable of each word
(when (null? current-word-parts)
(set! word-start-moment moment))
;; Add syllable part to current word
(set! current-word-parts (cons text current-word-parts))
;; If no hyphen after this syllable, the word is complete
(unless has-hyphen
(let ((complete-word (string-concatenate (reverse current-word-parts))))
(set! result (cons (cons word-start-moment complete-word) result)))
(set! current-word-parts '()))))
syllables)
;; Return words in correct order
(reverse result)))
#(define (find-chord-at-moment chords moment)
"Find chord at or close to the given syllable moment"
;; chords structure: (moment name verse-idx)
;; Strategy: Find the CLOSEST chord that comes AT or AFTER the word start
;; This way each chord is only matched to the nearest preceding word
(let ((tolerance (ly:make-moment 1/4))) ; Allow chord up to 1/4 after word start
(let loop ((remaining chords) (best-match #f) (best-diff #f))
(cond
((null? remaining) best-match)
(else
(let* ((chord-entry (car remaining))
(chord-moment (car chord-entry))
(chord-name (cadr chord-entry))
(diff (ly:moment-sub chord-moment moment))) ; positive if chord is after word
;; Only consider chords that are AT or AFTER the word start (diff >= 0)
;; and within tolerance
(let ((valid (and (not (ly:moment<? diff (ly:make-moment 0))) ; diff >= 0
(ly:moment<=? diff tolerance))))
(if (and valid
(or (not best-diff)
(ly:moment<? diff best-diff))) ; prefer closest (smallest diff)
(loop (cdr remaining) chord-name diff)
(loop (cdr remaining) best-match best-diff)))))))))
#(define (ly:moment=? a b)
"Check if two moments are equal"
(and (not (ly:moment<? a b))
(not (ly:moment<? b a))))
#(define (ly:moment-abs m)
"Get absolute value of moment"
(if (ly:moment<? m (ly:make-moment 0))
(ly:moment-sub (ly:make-moment 0) m)
m))
#(define (ly:moment<=? m1 m2)
"Check if m1 <= m2"
(or (ly:moment<? m1 m2)
(ly:moment=? m1 m2)))
#(define (ly:moment-add m1 m2)
"Add two moments"
(ly:moment-sub m1 (ly:moment-sub (ly:make-moment 0) m2)))
%% Lieferbarer Name eines Autors-Keys (z.B. "HansLeip") aus AUTHOR_DATA
%% (Feld "name", z.B. "Hans Leip"); ohne Eintrag der rohe Key als Fallback,
%% analog zu format-author in footer_with_songinfo.ily -- aber ohne dessen
%% Praefixe/Jahresangaben, die fuer ChordPro-Metadaten nicht passen.
#(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) (chordpro-author-display-name (car author-info)))
((string? author-info) (chordpro-author-display-name author-info))
(else "")))
authors))
'()))
%% 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 one song's ChordPro file during stencil
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)
(let ((song (hash-ref chordpro-song-store key)))
(when (and song
(not (chordpro-song-written song))
;; \chordlyrics-Strophen ODER (bei
;; chordpro-include-music-lyrics) aus der Musik
;; nachgeholte Kandidaten -- ein Lied kann auch
;; ganz ohne \chordlyrics nur ueber Letztere
;; etwas zu schreiben haben (z.B. Krabats
;; Muehlenlied).
(or (> (chordpro-song-verse-index song) 0)
(pair? (chordpro-song-music-candidates song))))
(chordpro-write-song song)
(set-chordpro-song-written! song #t))))
empty-stencil))))))
Reference in New Issue View Git Blame Copy Permalink