Author SHA1 Message Date
tux 39d9e8c0d5 use lilypond 2.27 and be compatibel to 2.26 2026-10-22 12:54:22 +02:00
tux dfd72cd64d layout size for inline-scores 2026-10-22 11:59:27 +02:00
tux d0db6fae69 finetuning chord lyrics engraver 2026-10-22 11:47:48 +02:00
tux 2359a7c5ae Mehrere Lieder auf eine Seite 2026-10-11 23:20:40 +02:00
zuk 809100b2f3 define rehearsalMarkFormatter 2026-08-28 13:11:47 +02:00
15 changed files with 879 additions and 2215 deletions

No files matched your search

+4 -3
View File
@@ -20,8 +20,7 @@
"scm" file-name-separator-string filename "scm" file-name-separator-string filename
))))) )))))
(scm-load "resolve_inherits.scm") (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) #(define (song-includes-data-path filename)
(string-join (string-join
@@ -34,13 +33,14 @@
#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file (song-includes-data-path "authors.yml")))) #(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file (song-includes-data-path "authors.yml"))))
#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file (song-includes-data-path "songs.yml")))) #(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file (song-includes-data-path "songs.yml"))))
\include #(if (ly:version? < '(2 27 0)) "compat_lilypond_2_26.ily" "../void.ily")
\include "merge_rests_engraver_override.ily" \include "merge_rests_engraver_override.ily"
\include "basic_format_and_style_settings.ily" \include "basic_format_and_style_settings.ily"
\include "eps_file_from_song_dir.ily" \include "eps_file_from_song_dir.ily"
\include "embedded_songs.ily"
\include "title_with_category_images.ily" \include "title_with_category_images.ily"
\include "chord_settings.ily" \include "chord_settings.ily"
\include "chordpro.ily" \include "chordpro.ily"
\include "data_extractor.ily"
\include "transposition.ily" \include "transposition.ily"
\include "markup_tag_groups_hack.ily" \include "markup_tag_groups_hack.ily"
\include "verses_with_chords.ily" \include "verses_with_chords.ily"
@@ -56,6 +56,7 @@ HEADER = {}
MUSIC = {} MUSIC = {}
TEXT = \markuplist {} TEXT = \markuplist {}
TEXT_PAGES = #f TEXT_PAGES = #f
EMBEDDED_SONGS = #'()
verseChords = {} verseChords = {}
firstVoice = {} firstVoice = {}
@@ -58,6 +58,7 @@ generalLayout = \layout {
\RemoveEmptyStaves \RemoveEmptyStaves
\override VerticalAxisGroup.remove-first = ##t \override VerticalAxisGroup.remove-first = ##t
\numericTimeSignature \numericTimeSignature
rehearsalMarkFormatter = #format-mark-box-alphabet
\overrideTimeSignatureSettings \overrideTimeSignatureSettings
4/4 % timeSignatureFraction 4/4 % timeSignatureFraction
1/4 % baseMomentFraction 1/4 % baseMomentFraction
@@ -90,6 +91,22 @@ generalLayout = \layout {
((custom-size (ly:output-def-lookup base-layout 'size #f))) ((custom-size (ly:output-def-lookup base-layout 'size #f)))
(if custom-size (layout-set-staff-size custom-size)))) (if custom-size (layout-set-staff-size custom-size))))
% Scores in Markups (z.B. inline-score) kopieren ihr \layout schon beim Parsen,
% also bevor customized-layout greift. Deshalb nachträglich anpassen.
#(define (customize-embedded-score-layouts! obj)
(cond
((ly:score? obj)
(for-each
(lambda (def)
(let ((custom-size (ly:output-def-lookup def 'size #f))
(scope (ly:output-def-scope def)))
(if custom-size
(layout-set-absolute-staff-size-in-module scope (* custom-size (eval 'pt scope))))))
(ly:score-output-defs obj)))
((pair? obj)
(customize-embedded-score-layouts! (car obj))
(customize-embedded-score-layouts! (cdr obj)))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% kleine Helferlein: %%% kleine Helferlein:
@@ -138,50 +155,83 @@ romanStanza =
#(define-music-function (parser location) () #(define-music-function (parser location) ()
#{ \override StanzaNumber.style = #'roman #}) #{ \override StanzaNumber.style = #'roman #})
#(define (number-or-number-list? x) (or (number? x) (number-list? x)))
% "1,4" -> (1 4); Einträge, die keine Zahl sind, bleiben Strings ("1b,2b" -> ("1b" "2b"))
#(define (stanza-numbers-from-string str)
(map (lambda (s) (or (string->number s) s))
(remove string-null? (map string-trim-both (string-split str #\,)))))
% Kein number? hier, sonst kann der Parser 1,4 nicht mehr als Liste lesen
#(define (stanza-numbers? x) (or (number-list? x) (string? x)))
override-stanza = override-stanza =
#(define-music-function (parser location stanzanumbers) (number-list?) #(define-music-function (stanzanumbers) (number-or-number-list?)
#{ #{
\once \override StanzaNumber.details.custom-stanzanumber-override = #stanzanumbers \once \override StanzaNumber.details.custom-stanzanumber-override = #(if (number? stanzanumbers) (list stanzanumbers) stanzanumbers)
#} #}
) )
#(define (handle-stanza-numbers context numbers number-formater) #(define (romanize-stanza-numbers numbers style)
(let* ((stanzanumbers (ly:assoc-get 'custom-stanzanumber-override (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) numbers)) (if (eq? style 'roman)
(stanza-style (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber))) (map (lambda (n) (if (number? n) (format #f "~@r" n) n)) numbers)
(roman-format (lambda (stanzanumber) (format #f "~@r" stanzanumber)))) numbers))
(ly:context-set-property! context 'stanza
(make-pad-left-markup 1
(number-formater
(if (eq? stanza-style 'roman)
(map roman-format stanzanumbers)
stanzanumbers))))))
#(define (stanza . stanzanumbers) #(define (format-stanza-numbers numbers style)
(string-join
(map (lambda (n) (format #f stanzaFormat n)) (romanize-stanza-numbers numbers style))
", "))
% Strophennummer, die erst beim Setzen aus den Eigenschaften des StanzaNumber-Grobs gebaut wird
% (details.custom-stanza-type, details.custom-stanza-numbers, style, details.custom-inline-text).
% So können \fstanza, \ref, \bridge und \repStartWithTag im selben Zeitschritt kombiniert werden.
#(define-markup-command (formatted-stanza layout props) ()
#:properties ((details '()) (style #f))
(let* ((realstanza (ly:assoc-get 'custom-realstanza details #f))
(type (ly:assoc-get 'custom-stanza-type details 'verse))
(numbers (ly:assoc-get 'custom-stanzanumber-override details
(ly:assoc-get 'custom-stanza-numbers details '())))
(inline-text (ly:assoc-get 'custom-inline-text details #f))
(inline-direction (ly:assoc-get 'custom-inline-direction details CENTER))
(rep-start (and inline-text (eqv? inline-direction LEFT)))
(roman-numbers (romanize-stanza-numbers numbers style))
(stanza-stencil
(and realstanza
(case type
((ref) ((ly:output-def-lookup layout 'refMarkupFormatter) layout props roman-numbers))
((bridge) ((ly:output-def-lookup layout 'bridgeMarkupFormatter) layout props roman-numbers))
(else (interpret-markup layout props (format-stanza-numbers numbers style))))))
(padded-stanza-stencil
(and stanza-stencil
(interpret-markup layout props (make-pad-left-markup 1 (make-stencil-markup stanza-stencil))))))
(if rep-start
(interpret-markup layout props
(make-concat-markup
(append
(if padded-stanza-stencil (list (make-stencil-markup padded-stanza-stencil) (make-hspace-markup 1)) '())
(list (make-override-markup '(font-series . normal) inline-text)))))
(or padded-stanza-stencil empty-stencil))))
#(define (formatted-stanza-music type stanzanumbers)
#{ #{
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs \once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs
\once \override StanzaNumber.details.custom-stanza-type = #'verse \once \override StanzaNumber.details.custom-stanza-type = #type
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers \once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
\applyContext \stanza \markup \formatted-stanza
#(lambda (context) #})
(handle-stanza-numbers context stanzanumbers
(lambda (numbers) (string-join (map (lambda (n) (format #f stanzaFormat n)) numbers) ", ")))) % \fstanza 1 -> "1."
#} % \fstanza 1,4 -> "1., 4." (nur im Notenmodus, z.B. \chordverse { \fstanza 1,4 } ...)
) % \fstanza "1,4" -> "1., 4." (auch im \lyricmode, dort versteht LilyPond 1,4 nicht als Liste)
fstanza =
#(define-music-function (stanzanumbers) (stanza-numbers?)
(formatted-stanza-music 'verse
(if (string? stanzanumbers) (stanza-numbers-from-string stanzanumbers) stanzanumbers)))
ref = ref =
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?) #(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
#{ \lyricmode { #{ \lyricmode {
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs #(formatted-stanza-music 'ref stanzanumbers)
\once \override StanzaNumber.details.custom-stanza-type = #'ref
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
\applyContext
#(lambda (context)
(handle-stanza-numbers context stanzanumbers
(lambda (numbers)
(make-on-the-fly-markup
(lambda (layout props m)
((ly:output-def-lookup layout 'refMarkupFormatter) layout props numbers))
(make-null-markup)))))
#lyrics #lyrics
} }
#} #}
@@ -190,43 +240,24 @@ ref =
bridge = bridge =
#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?) #(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
#{ \lyricmode { #{ \lyricmode {
\once \override StanzaNumber.details.custom-realstanza = ##t % set this to signal that there is a real stanza and no repeat signs #(formatted-stanza-music 'bridge stanzanumbers)
\once \override StanzaNumber.details.custom-stanza-type = #'bridge
\once \override StanzaNumber.details.custom-stanza-numbers = #stanzanumbers
\applyContext
#(lambda (context)
(handle-stanza-numbers context stanzanumbers
(lambda (numbers)
(make-on-the-fly-markup
(lambda (layout props m)
((ly:output-def-lookup layout 'bridgeMarkupFormatter) layout props numbers))
(make-null-markup)))))
#lyrics #lyrics
} }
#} #}
) )
% prints a repStart Sign as stanza if the tag 'repeats is kept. % prints a repStart Sign as stanza if the tag 'repeats is kept.
% if there was a stanza already set by the stanza function with StanzaNumber.details.custom-realstanza = ##t we set that also as stanza. % if there is a stanza set by \fstanza in the same moment, \formatted-stanza prints both.
% Sets custom-inline-text for ChordPro export so it can collect the repeat sign separately % Sets custom-inline-text for ChordPro export so it can collect the repeat sign separately
repStartWithTag = \lyricmode { repStartWithTag =
#(define-music-function () ()
#{ \lyricmode {
\tag #'repeats { \tag #'repeats {
\once \override StanzaNumber.details.custom-inline-text = \repStart \once \override StanzaNumber.details.custom-inline-text = \repStart
\once \override StanzaNumber.details.custom-inline-direction = #LEFT \once \override StanzaNumber.details.custom-inline-direction = #LEFT
\applyContext \stanza \markup \formatted-stanza
#(lambda (context)
(let ((lastStanza (ly:context-property context 'stanza))
(printLastStanza (ly:assoc-get 'custom-realstanza (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) #f))
(stanzaFontSeries (ly:assoc-get 'font-series (ly:context-grob-definition context 'StanzaNumber) 'normal)))
(ly:context-set-property! context 'stanza
(make-concat-markup
(if printLastStanza
(list (make-override-markup `(font-series . ,stanzaFontSeries) lastStanza) (make-hspace-markup 1) repStart)
(list repStart)
)))))
\once \override StanzaNumber.font-series = #'normal
} }
} } #})
repStopWithTag = \lyricmode { repStopWithTag = \lyricmode {
\tag #'repeats { \tag #'repeats {
@@ -234,19 +265,19 @@ repStopWithTag = \lyricmode {
\once \override StanzaNumber.details.custom-inline-direction = #RIGHT \once \override StanzaNumber.details.custom-inline-direction = #RIGHT
\once \override StanzaNumber.font-series = #'normal \once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1 \once \override StanzaNumber.direction = 1
\set stanza = \markup { \pad-x-right #1 \repStop } \stanza \markup { \pad-x-right #1 \repStop }
} }
} }
rightHyphen = \lyricmode { rightHyphen = \lyricmode {
\once \override StanzaNumber.font-series = #'normal \once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1 \once \override StanzaNumber.direction = 1
\set stanza = "-" \stanza "-"
} }
leftHyphen = \lyricmode { leftHyphen = \lyricmode {
\once \override StanzaNumber.font-series = #'normal \once \override StanzaNumber.font-series = #'normal
\set stanza = "-" \stanza "-"
} }
multiVerseSkips = multiVerseSkips =
@@ -312,7 +343,7 @@ rufWithMarkup =
\lyricmode { \lyricmode {
\once \override StanzaNumber.font-series = #'normal \once \override StanzaNumber.font-series = #'normal
\once \override StanzaNumber.direction = 1 \once \override StanzaNumber.direction = 1
\set stanza = #text \stanza #text
} }
#}) #})
ruf = ruf =
+1 -1
View File
@@ -155,7 +155,7 @@ Ensure_first_chord_after_line_break_printed_engraver =
; the current chord handling implementation in lilypond uses 'begin-of-line-visible to mark repeated chords ; the current chord handling implementation in lilypond uses 'begin-of-line-visible to mark repeated chords
(ly:grob-set-property! grob 'begin-of-line-visible #f)) (ly:grob-set-property! grob 'begin-of-line-visible #f))
(set! last-system-column-rank current-system-column-rank) (set! last-system-column-rank current-system-column-rank)
(ly:chord-name::after-line-breaking grob) (item::enforce-musical-break-visibility grob)
))))))) )))))))
% If you add this engraver to ChordNames Context chords get only printed on chordchanges and not at newline. % If you add this engraver to ChordNames Context chords get only printed on chordchanges and not at newline.
File diff suppressed because it is too large. Load diff
@@ -0,0 +1,11 @@
% Abwärtskompatibilität zu LilyPond 2.26.
% Wird von all.ily nur eingebunden, wenn die laufende LilyPond-Version älter als 2.27 ist.
% Alles andere ist für die aktuelle 2.27 geschrieben.
% Ab 2.27 gibt es \stanza als Musikfunktion (StanzaEvent), in 2.26 nur die Kontext-Property stanza.
stanza =
#(define-music-function (text) (markup?)
(context-spec-music (make-property-set 'stanza text) 'Bottom))
% Ab 2.27 heißt ly:chord-name::after-line-breaking item::enforce-musical-break-visibility.
#(define item::enforce-musical-break-visibility ly:chord-name::after-line-breaking)
-550
View File
@@ -1,550 +0,0 @@
%%% 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))))))
+157
View File
@@ -0,0 +1,157 @@
%% Mehrere Lieder in einer Liederdatei (z.B. zwei Lieder auf einer Seite)
%%
%% Das erste Lied ist das Hauptlied (HEADER), alle weiteren werden als
%% eingebettete Lieder angemeldet. Eingebettete Lieder bekommen eigene
%% Eintraege im Inhaltsverzeichnis, in den Kategorie-, Autoren- und
%% Kapitelverzeichnissen, im PDF-Inhaltsverzeichnis, in der toc.csv und
%% eine eigene Liednummer. Im Footer steht die Songinfo des letzten
%% eingebetteten Lieds (abschaltbar mit footersong = ##f im HEADER bzw. mit
%% footersong = \andereslied umstellbar), die Songinfo des Hauptlieds wird
%% mit \songinfo-of selbst platziert.
%%
%% Beispiel:
%%
%% \include "../../lilypond-song-includes/liedbausteine/lied_a.ly"
%% liedA = \captureSong
%% \include "../../lilypond-song-includes/liedbausteine/lied_b.ly"
%% liedB = \captureSong
%%
%% TEXT = \markuplist {
%% \songinfo-of \liedA
%% \vspace #2
%% \embedded-song-title \liedB
%% \vspace #.5
%% \score { \songMusic \liedB \layout { \LAYOUT } }
%% \with-song \liedB {
%% \chordlyrics \secondVerse
%% }
%% }
%%
%% \restoreSong \liedA
%% \embedSong \liedB
%% \include "public_includes/layout_bottom.ily"
%%
%% \captureSong sichert den Header (basicSongInfo) und die Variablen aus
%% captured-song-variable-names, damit das naechste \include sie nicht
%% ueberschreibt. Das Ergebnis ist ein normales Header-Modul, es kann also
%% auch in \header { \liedA } verwendet werden.
%%
%% \restoreSong setzt basicSongInfo, HEADER und diese Variablen zurueck,
%% TEXT aber nicht. TEXT also vor \restoreSong schreiben, solange darin noch
%% Variablen des zuletzt eingebundenen Lieds (\secondVerse usw.) stehen.
%%
%% Ohne \with-song beziehen sich Strophen mit Akkorden auf das Hauptlied.
%%
%% Alle Verzeichniseintraege zeigen auf die erste Seite des Hauptlieds.
#(define captured-song-variable-names '(MUSIC global firstVoice verseChords))
#(define (song-variable song name)
(assq-ref (module-ref song 'captured-song-variables '()) name))
#(define (extract-and-check-vars-from-module headermodule varlist)
(let* ((headervars (if (module? headermodule) (hash-map->list cons (struct-ref headermodule 0)) '()))
(extract-var-and-check (lambda (headervar)
(let* ((variableref (assoc-ref headervars headervar))
(extracted (if variableref (variable-ref variableref) #f)))
(if (and extracted (not (and (string? extracted) (string-null? extracted)))) extracted #f)))))
(map (lambda (varsymbol)
(cons varsymbol (extract-var-and-check varsymbol))
) varlist)))
% Text des PDF-Lesezeichens eines Lieds, #f wenn es keins bekommt.
% Gleiche Regel wie in build-full-title.
#(define (song-pdf-bookmark-title headermodule)
(let* ((vars (extract-and-check-vars-from-module headermodule '(title starttext)))
(title (assq-ref vars 'title))
(starttext (assq-ref vars 'starttext))
(as-string (lambda (m) (if (markup? m) (markup->string m) ""))))
(cond ((and title starttext) (string-append (as-string starttext) " | " (as-string title)))
(title (as-string title))
(starttext (string-append (as-string starttext) " | "))
(else #f))))
#(define (embedded-song-list songs)
(if (list? songs) (filter module? songs) '()))
#(define (embedded-songs-of-header headermodule)
(if (module? headermodule)
(embedded-song-list (module-ref headermodule 'embeddedsongs '()))
'()))
% Ersetzt alle header:*-Properties durch die Felder aus headermodule, damit
% keine Felder des Hauptlieds in das andere Lied durchsickern.
#(define (header-module->props headermodule props)
(let ((header-key? (lambda (entry)
(and (pair? entry) (symbol? (car entry))
(string-prefix? "header:" (symbol->string (car entry)))))))
(cons
(map (lambda (kv) (cons (symbol-append 'header: (car kv)) (cdr kv)))
(ly:module->alist headermodule))
(map (lambda (alist) (remove header-key? alist)) props))))
captureSong =
#(define-scheme-function () ()
(let ((song (make-module)))
(ly:module-copy song basicSongInfo)
(module-define! song 'captured-song-variables
(filter-map
(lambda (name)
(let ((value (ly:parser-lookup name)))
(and (not (null? value)) (cons name value))))
captured-song-variable-names))
song))
% Stellt basicSongInfo, HEADER und die gesicherten Variablen eines Lieds
% wieder her, als waere es das zuletzt eingebundene.
restoreSong =
#(define-void-function (song) (module?)
(for-each
(lambda (kv) (ly:parser-define! (car kv) (cdr kv)))
(module-ref song 'captured-song-variables '()))
(ly:parser-define! 'basicSongInfo song)
(ly:parser-define! 'HEADER #{ \bookpart { \header { $song } } #}))
embedSong =
#(define-void-function (song) (module?)
(set! EMBEDDED_SONGS (append EMBEDDED_SONGS (list song))))
songMusic =
#(define-music-function (song) (module?)
(let ((music (song-variable song 'MUSIC)))
(if (ly:music? music) music (make-music 'SequentialMusic))))
% Strophen, \fromproperty #'header:... usw. beziehen sich innerhalb auf das
% angegebene Lied. Die Transposition des Hauptlieds wird nicht uebernommen.
#(define-markup-list-command (with-song layout props song args) (module? markup-list?)
(let* ((music-or-empty (lambda (name)
(let ((music (song-variable song name)))
(if (ly:music? music) music (make-music 'SequentialMusic)))))
(verseChords (music-or-empty 'verseChords))
(global (music-or-empty 'global))
(firstVoice (music-or-empty 'firstVoice)))
(interpret-markup-list layout
(prepend-alist-chain 'verse-chords #{ \chords { $verseChords } #}
(prepend-alist-chain 'verse-reference-voice #{ $global $firstVoice #}
(prepend-alist-chain 'transposition (cons #f #f)
(header-module->props song props))))
args)))
#(define-markup-command (songinfo-of layout props song) (module?)
(interpret-markup layout (header-module->props song props)
(make-fractional-line-width-markup (make-songinfo-content-markup))))
#(define-markup-command (embedded-song-title layout props song) (module?)
(interpret-markup layout (header-module->props song props)
(make-fill-line-markup (list (ly:output-def-lookup layout 'defaultTitleMarkup)))))
% PDF-Lesezeichen der eingebetteten Lieder, wird von build-full-title direkt
% nach dem Lesezeichen des Hauptlieds ausgegeben.
#(define-markup-command (embedded-songs-to-pdf-toc layout props) ()
(apply ly:stencil-add
(cons empty-stencil
(filter-map
(lambda (song)
(let ((bookmark (song-pdf-bookmark-title song)))
(and bookmark (make-pdf-toc-stencil bookmark 0))))
(embedded-song-list (chain-assoc-get 'header:embeddedsongs props '()))))))
+19 -4
View File
@@ -33,7 +33,8 @@
#(define (join-present items joiner) #(define (join-present items joiner)
(string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner)) (string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner))
#(define-markup-command (print-songinfo layout props) () % Songinfo aus den header:*-Properties, ohne Pruefung auf die letzte Seite.
#(define-markup-command (songinfo-content layout props) ()
(define (songinfo-from songId key) (define (songinfo-from songId key)
(let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f))) (let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f)))
(if song (if song
@@ -131,7 +132,6 @@
) )
(interpret-markup layout props (interpret-markup layout props
(if (chain-assoc-get 'page:is-bookpart-last-page props #f)
(let* ((authors (chain-assoc-get 'header:authors props #f)) (let* ((authors (chain-assoc-get 'header:authors props #f))
(poet-and-composers (poet-and-composer-from-authors authors)) (poet-and-composers (poet-and-composer-from-authors authors))
(songId (chain-assoc-get 'header:songId props #f)) (songId (chain-assoc-get 'header:songId props #f))
@@ -167,10 +167,25 @@
#:fontsize songInfoFontSize #:fontsize songInfoFontSize
#:sans #:sans
(ly:output-def-lookup layout 'songinfoMarkup) (ly:output-def-lookup layout 'songinfoMarkup)
))) ))))
(make-null-markup)))
) )
% Songinfo im Footer, nur auf der letzten Seite des Bookparts. Gibt es
% eingebettete Lieder (siehe embedded_songs.ily), steht hier die Songinfo des
% letzten eingebetteten Lieds, ausser im Header ist footersong gesetzt
% (##f = Hauptlied, oder ein mit \captureSong gesichertes Lied).
#(define-markup-command (print-songinfo layout props) ()
(if (chain-assoc-get 'page:is-bookpart-last-page props #f)
(let* ((footersong (chain-assoc-get 'header:footersong props 'auto))
(embedded (embedded-song-list (chain-assoc-get 'header:embeddedsongs props '())))
(song (if (eq? footersong 'auto)
(and (pair? embedded) (last embedded))
footersong)))
(interpret-markup layout
(if (module? song) (header-module->props song props) props)
(make-songinfo-content-markup)))
(interpret-markup layout props (make-null-markup))))
#(define-markup-command (print-pagenumber layout props)() #(define-markup-command (print-pagenumber layout props)()
(let ((label (chain-assoc-get 'header:myindexlabel props #f))) (let ((label (chain-assoc-get 'header:myindexlabel props #f)))
(interpret-markup layout props (interpret-markup layout props
+127 -232
View File
@@ -1,259 +1,154 @@
(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 receive) (srfi srfi-1)) (use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (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) (define (yml-file->scm filename)
;; --- Zeilen einlesen ------------------------------------------------ ;; Utility: Zeile 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 (call-with-input-file filename
(lambda (port) (lambda (port)
(let loop ((items '())) (let loop ((lines '()))
(let ((line (read-line port))) (let ((line (read-line port)))
(if (eof-object? line) (if (eof-object? line)
(reverse items) (reverse lines)
(let* ((line (if (string-suffix? "\r" line) (let ((clean (string-trim line)))
(string-drop-right line 1) (if (or (string=? clean "---") (string-null? clean))
line)) (loop lines) ;; Ignoriere "---" oder leere Zeile
(content (string-trim-both line))) (loop (cons line lines))))))))))
(if (or (string-null? content)
(string-prefix? "#" content)
(string=? content "---")
(string=? content "..."))
(loop items)
(loop (cons (cons (line-indent line) content)
items))))))))))
(define (item-indent item) (car item)) ;; Einrückung bestimmen (Anzahl Leerzeichen am Anfang)
(define (item-content item) (cdr item)) (define (line-indent line)
(let ((match (string-match "^ *" line)))
(if match
(match:end match) ; Anzahl der Leerzeichen = Position nach Leerzeichen
0))) ; Falls kein Match → 0
;; --- Skalare ---------------------------------------------------------- ;; Kommentar entfernen
(define (strip-comment line)
(let ((m (string-match "#.*" line)))
(if m
(string-trim-right (string-take line (match:start m)))
line)))
;; Position des schließenden Double-Quotes ab start (oder #f); ;; Hilfsfunktion: Whitespace entfernen
;; Backslash escaped das Folgezeichen. (define (clean-line line)
(define (closing-double-quote s start) (string-trim (strip-comment line)))
(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))))))
;; Position des schließenden Single-Quotes ab start (oder #f); ;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)?
;; '' ist ein escaptes Quote. (define (blank-or-comment? line)
(define (closing-single-quote s start) (string-null? (clean-line line)))
(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))))))
;; \\ -> \, \" -> ", \n -> Zeilenumbruch ;; Skalare Werte interpretieren
(define (unescape-double s) (define (parse-scalar str)
(let loop ((chars (string->list s)) (acc '())) (define (strip-quotes s)
(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 (cond
((member s '("{}" "[]" "null")) '()) ((and (string-prefix? "\"" s) (string-suffix? "\"" s))
(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 "true") #t)
((string=? s "false") #f) ((string=? s "false") #f)
((string-match "^-?[0-9]+(\\.[0-9]+)?$" s) (string->number s)) ((string=? s "null") '())
(else s))) (else s))))
;; Skalar parsen; Rest hinter einem schließenden Quote wird ignoriert
;; (darf nur ein Kommentar sein)
(define (parse-scalar str)
(let ((s (string-trim-both str)))
(cond
((string-null? s) "")
((char=? (string-ref s 0) #\")
(let ((end (closing-double-quote s 1)))
(if end
(unescape-double (substring s 1 end))
(string-trim-right (strip-plain-comment s)))))
((char=? (string-ref s 0) #\')
(let ((end (closing-single-quote s 1)))
(if end
(interpret-plain (unescape-single (substring s 1 end)))
(string-trim-right (strip-plain-comment s)))))
(else
(interpret-plain (string-trim-right (strip-plain-comment s)))))))
;; --- Struktur ---------------------------------------------------------- ;; Hilfsfunktion: Zeilen mit gleicher oder höherer Einrückung sammeln
(define (take-indented lines min-indent)
(let loop ((ls lines) (acc '()))
(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))))))
;; Erste Key-Trennstelle: ":" am Zeilenende oder gefolgt von Leerzeichen. ;; Hilfsfunktion: N Zeilen überspringen
;; Beginnt die Zeile mit einem gequoteten Key (oder Skalar), zaehlt ein (define (drop lst n)
;; ":" innerhalb der Quotes nicht als Trennstelle. (let loop ((l lst) (i n))
(define (key-split-index s) (if (or (zero? i) (null? l))
(let ((start (if (string-null? s) l
0 (loop (cdr l) (- i 1)))))
(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 ;; Listenparsing: Liest Zeilen mit `-` als Listeneinträge
;; Strings), unquoted Keys bleiben unveraendert (define (parse-list lines current-indent)
(define (parse-key s) (let loop ((ls lines) (result '()))
(let ((k (string-trim-both s))) (if (null? ls)
(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) (reverse result)
(let* ((content (item-content (car items))) (let* ((line (clean-line (car ls))))
(split (key-split-index content))) (if (string-match "^-" line)
(if (not split) (let* ((indent (line-indent (car ls)))
(begin (item-str (string-trim (string-drop line 1)))
(format (current-error-port) (next-lines (cdr ls)))
"YAML-Syntaxfehler: Ungültige Zeile: ~a\n" content) (if (or (null? next-lines)
(loop (cdr items) result)) (> (line-indent (car next-lines)) indent))
(let ((key (parse-key (string-take content split))) ;; Verschachtelter Inhalt
(value-str (effective-value (let* ((sub (take-indented next-lines (+ indent 2)))
(string-drop content (+ split 1))))) (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
((blank-or-comment? raw-line)
(loop (cdr ls) result))
;; Liste
((string-match "^- " line)
(let ((list-lines (take-indented ls current-indent)))
(let ((parsed-list (parse-list list-lines current-indent)))
(loop (drop ls (length list-lines))
(cons parsed-list result)))))
;; 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) (if (string-null? value-str)
;; Wert steht im eingerückten Block darunter ;; Wert auf nachfolgender Einrückungsebene
(receive (children rest) (let* ((sub (take-indented next-lines (+ current-indent 2)))
(span (lambda (it) (> (item-indent it) map-indent)) (parsed (parse-lines sub (+ current-indent 2)))
(cdr items)) (remaining (drop next-lines (length sub))))
(loop rest (loop remaining
(cons (cons key (parse-block children)) (cons (cons key parsed) result)))
result))) ;; Einfacher Key:Value
(loop (cdr items) (loop next-lines
(cons (cons key (parse-scalar value-str)) (cons (cons key (parse-scalar value-str)) result)))))
result))))))))))
;; Liste: "- wert", "- key: value" (Inline-Mapping) oder "-" mit ;; Fehlerhafte Zeile
;; eingerücktem Block darunter (else
(define (parse-list items) ;; Vermeide Fehlermeldung für Leerzeilen oder leere Objekte
(let ((list-indent (item-indent (car items)))) (if (or (string-null? (string-trim line))
(let loop ((items items) (result '())) (member line '("{}" "[]")))
(if (null? items) (loop (cdr ls) result)
(reverse result)
(let ((content (item-content (car items))))
(if (not (dash-line? content))
(begin (begin
(format (current-error-port) (format (current-error-port)
"YAML-Syntaxfehler: Ungültiges Listenelement: ~a\n" "Syntaxfehler: Ungültige Zeile: ~a\n" raw-line)
content) (loop (cdr ls) result))))
(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))) (let ((lines (read-lines filename)))
(parse-lines lines 0)))
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename))) (define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))
-162
View File
@@ -1,162 +0,0 @@
(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))))
@@ -65,10 +65,11 @@
;; Ist dieses Lied das erste eines Kapitels, wird der Kapitel-Eintrag ;; Ist dieses Lied das erste eines Kapitels, wird der Kapitel-Eintrag
;; unmittelbar vor dem Lied-Eintrag ausgegeben, damit die pdfmark-/OUT- ;; unmittelbar vor dem Lied-Eintrag ausgegeben, damit die pdfmark-/OUT-
;; Reihenfolge (Elternteil vor Kindern) im PDF-Stream garantiert stimmt. ;; Reihenfolge (Elternteil vor Kindern) im PDF-Stream garantiert stimmt.
;; Eingebettete Lieder (embedded_songs.ily) folgen direkt nach dem Lied.
(if (and (string? chaptertitle) (not (string-null? chaptertitle))) (if (and (string? chaptertitle) (not (string-null? chaptertitle)))
(markup #:chapter-to-pdf-toc chaptercount chaptertitle (markup #:chapter-to-pdf-toc chaptercount chaptertitle
#:title-to-pdf-toc pdfbookmark title-markup) #:title-to-pdf-toc pdfbookmark #:embedded-songs-to-pdf-toc title-markup)
(markup #:title-to-pdf-toc pdfbookmark title-markup)) (markup #:title-to-pdf-toc pdfbookmark #:embedded-songs-to-pdf-toc title-markup))
make-null-markup) make-null-markup)
))) )))
+44 -28
View File
@@ -89,7 +89,7 @@
(if (and (string? arg) (string-null? arg)) (if (and (string? arg) (string-null? arg))
" " " "
#{\markup #{\markup
\score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \set stanza = #arg #}) "" } } \layout { $verselayout #(customized-layout verselayout) } } \score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \stanza #arg #}) "" } } \layout { $verselayout #(customized-layout verselayout) } }
#} #}
))) )))
@@ -182,19 +182,7 @@
((if reverses fold fold-right) (lambda (element filled-list) ((if reverses fold fold-right) (lambda (element filled-list)
(cons element (if (null? filled-list) '() (cons markup-between filled-list)))) (cons element (if (null? filled-list) '() (cons markup-between filled-list))))
'() elements)) '() elements))
;; Dokumentposition fuer den ChordPro-/Data-Collector: jede Gruppe nimmt (let* ((column-item-count (ceiling (/ (length versegroup) verse-cols)))
;; 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))) (column-data (make-list verse-cols)))
(let columnize-list ((index 0) (items versegroup)) (let columnize-list ((index 0) (items versegroup))
(if (not (null? items)) (if (not (null? items))
@@ -261,6 +249,13 @@ Chord_lyrics_spacing_engraver =
(lyrics-seen-since-break #f) (lyrics-seen-since-break #f)
(have-a-rest #f) (have-a-rest #f)
(stanza #f) (stanza #f)
; Akkord auf einer Skip-Silbe "_" nach Wortende soll über die folgende Silbe
(word-continues #f)
(continuation-this-step #f)
(lyric-skip-this-step #f)
(syllable-this-step #f)
(chord-this-step #f)
(chord-on-lyric-skip #f)
(place-at-right-edge (place-at-right-edge
(lambda (grob anchor padding) (lambda (grob anchor padding)
(let ((anchor-width (interval-length (ly:grob-extent anchor anchor X)))) (let ((anchor-width (interval-length (ly:grob-extent anchor anchor X))))
@@ -268,6 +263,25 @@ Chord_lyrics_spacing_engraver =
(ly:grob-set-property! grob 'X-offset (+ padding anchor-width)) (ly:grob-set-property! grob 'X-offset (+ padding anchor-width))
)))) ))))
(make-engraver (make-engraver
((start-translation-timestep engraver)
(set! continuation-this-step #f)
(set! lyric-skip-this-step #f)
(set! syllable-this-step #f)
(set! chord-this-step #f)
)
((stop-translation-timestep engraver)
(if (and chord-on-lyric-skip (not (eq? chord-on-lyric-skip chord-this-step)))
(begin
(if (and syllable-this-step (not chord-this-step))
(begin
(ly:grob-set-parent! chord-on-lyric-skip X syllable-this-step)
(ly:grob-set-property! chord-on-lyric-skip 'X-offset 0)
(ly:grob-set-property! chord-on-lyric-skip 'extra-spacing-width '(+inf.0 . -inf.0))
(set! lyric-width-since-last-chord (interval-length (ly:grob-extent syllable-this-step syllable-this-step X)))))
(set! chord-on-lyric-skip #f)))
(if syllable-this-step
(set! word-continues continuation-this-step))
)
(listeners (listeners
((multi-measure-rest-event engraver event) ((multi-measure-rest-event engraver event)
(set! have-a-rest #t) (set! have-a-rest #t)
@@ -275,8 +289,19 @@ Chord_lyrics_spacing_engraver =
((rest-event engraver event) ((rest-event engraver event)
(set! have-a-rest #t) (set! have-a-rest #t)
) )
((hyphen-event engraver event)
(set! continuation-this-step #t)
)
((extender-event engraver event)
(set! continuation-this-step #t)
)
((lyric-event engraver event) ((lyric-event engraver event)
(set! have-a-rest #f) (set! have-a-rest #f)
; "_" wird zu " " und erzeugt keine LyricText
(if (equal? (ly:event-property event 'text) " ")
(begin
(set! lyric-skip-this-step #t)
(set! chord-on-lyric-skip #f)))
(set! music-columns-for-last-syllable 0) (set! music-columns-for-last-syllable 0)
) )
((break-event engraver event) ((break-event engraver event)
@@ -286,6 +311,7 @@ Chord_lyrics_spacing_engraver =
(set! last-printed-chord #f) (set! last-printed-chord #f)
(set! chord-width-since-last-lyric 0) (set! chord-width-since-last-lyric 0)
(set! lyrics-seen-since-break #f) (set! lyrics-seen-since-break #f)
(set! chord-on-lyric-skip #f)
)) ))
(acknowledgers (acknowledgers
((musical-paper-column-interface this-engraver grob source-engraver) ((musical-paper-column-interface this-engraver grob source-engraver)
@@ -306,6 +332,7 @@ Chord_lyrics_spacing_engraver =
(ly:grob-set-property! grob 'X-offset gap-for-starting-rest) (ly:grob-set-property! grob 'X-offset gap-for-starting-rest)
))) )))
) )
(set! syllable-this-step grob)
(set! last-lyric-syllable grob) (set! last-lyric-syllable grob)
(set! chord-width-since-last-lyric 0) (set! chord-width-since-last-lyric 0)
(set! lyrics-seen-since-break #t) (set! lyrics-seen-since-break #t)
@@ -333,6 +360,9 @@ Chord_lyrics_spacing_engraver =
(cons (car (ly:grob-property last-lyric-syllable 'extra-spacing-width '(0 . 0))) (+ chord-gap chord-overwidth))) (cons (car (ly:grob-property last-lyric-syllable 'extra-spacing-width '(0 . 0))) (+ chord-gap chord-overwidth)))
) )
(set! lyric-width-since-last-chord (* (if last-lyric-syllable (interval-length (ly:grob-extent last-lyric-syllable last-lyric-syllable X)) 0) (- 1 (/ 1.0 music-columns-for-last-syllable)))) (set! lyric-width-since-last-chord (* (if last-lyric-syllable (interval-length (ly:grob-extent last-lyric-syllable last-lyric-syllable X)) 0) (- 1 (/ 1.0 music-columns-for-last-syllable))))
(set! chord-this-step grob)
(if (and lyric-skip-this-step (not have-a-rest) (not word-continues))
(set! chord-on-lyric-skip grob))
(set! last-printed-chord grob) (set! last-printed-chord grob)
(set! last-lyric-syllable #f) (set! last-lyric-syllable #f)
) )
@@ -353,20 +383,6 @@ Chord_lyrics_spacing_engraver =
(transposition (cons #f #f)) (transposition (cons #f #f))
(verselayout generalLayout)) (verselayout generalLayout))
"Vers mit Akkorden" "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 (interpret-markup layout props
#{ #{
\markup { \markup {
+33 -180
View File
@@ -65,26 +65,6 @@ additionalPageNumbers =
display-pages-list 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: % TODO:
% Eigentlich können wir das direkt in oddFooderMarkup und evenFooterMarkup aufrufen % 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 % vermutlich sogar ohne den delay kram. Wir sollten außerdem einfach nur die property
@@ -117,7 +97,12 @@ width may require additional tweaking.)"
(if (assq-ref additional-page-switch-label-list label) (if (assq-ref additional-page-switch-label-list label)
(make-concat-markup (list (number-format number-type display-page) (make-concat-markup (list (number-format number-type display-page)
(make-char-markup (+ 97 (- real-current-page (real-page-number layout (make-char-markup (+ 97 (- real-current-page (real-page-number layout
(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)))
))))))
(number-format number-type (+ display-page (- real-current-page (real-page-number layout label)))) (number-format number-type (+ display-page (- real-current-page (real-page-number layout label))))
)) ))
(page-stencil (interpret-markup layout props page-markup)) (page-stencil (interpret-markup layout props page-markup))
@@ -133,79 +118,6 @@ width may require additional tweaking.)"
(make-filled-box-stencil x-ext y-ext)))) (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
;; \chordlyrics-Strophen ODER (bei
;; chordpro-include-music-lyrics) aus der
;; Musik nachgeholte Kandidaten.
(lambda (song) (or (> (chordpro-song-verse-index song) 0)
(pair? (chordpro-song-music-candidates song))))
(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 = includeSong =
#(define-void-function (filename) (string?) #(define-void-function (filename) (string?)
#{ #{
@@ -213,15 +125,6 @@ includeSong =
#} #}
(ly:parser-parse-string (ly:parser-clone) (ly:parser-parse-string (ly:parser-clone)
(ly:format "\\include \"~a/~a/~a.ly\"" songPath filename filename)) (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 HEADER)
(let ((label (gensym "index"))) (let ((label (gensym "index")))
(set! additional-page-switch-label-list (set! additional-page-switch-label-list
(acons label additional-page-numbers additional-page-switch-label-list)) (acons label additional-page-numbers additional-page-switch-label-list))
@@ -284,20 +187,24 @@ songs =
;; Lieder duerfen als Kapitel-Kinder gezaehlt werden -- sonst wird die ;; Lieder duerfen als Kapitel-Kinder gezaehlt werden -- sonst wird die
;; /Count zu hoch und der erste Folgeeintrag (z.B. ein spaeteres Kapitel) ;; /Count zu hoch und der erste Folgeeintrag (z.B. ein spaeteres Kapitel)
;; rutscht faelschlich als Kind mit hinein. ;; rutscht faelschlich als Kind mit hinein.
(emits-bookmark? ;; Eingebettete Lieder (embedded_songs.ily) haben jeweils ein eigenes
;; Lesezeichen, daher die Anzahl statt eines Booleans.
(bookmark-count
(lambda (e) (lambda (e)
(and (not (eq? (car e) 'emptyPage)) (if (or (eq? (car e) 'emptyPage)
(not (eq? (car e) 'imagePage)) (eq? (car e) 'imagePage)
(not (eq? (car e) 'markupPage)) (eq? (car e) 'markupPage))
(let ((vars (extract-and-check-vars-from-header 0
(assq-ref (cdr e) 'header) '(title starttext)))) (let* ((headermodule (ly:book-header (assq-ref (cdr e) 'header)))
(if (or (assq-ref vars 'title) (assq-ref vars 'starttext)) #t #f))))) (vars (extract-and-check-vars-from-module headermodule '(title starttext))))
(+ (if (or (assq-ref vars 'title) (assq-ref vars 'starttext)) 1 0)
(count song-pdf-bookmark-title (embedded-songs-of-header headermodule)))))))
(count-bookmark-songs (count-bookmark-songs
(lambda (start end) (lambda (start end)
(let loop ((i 0) (l ordered) (c 0)) (let loop ((i 0) (l ordered) (c 0))
(cond ((or (null? l) (>= i end)) c) (cond ((or (null? l) (>= i end)) c)
((< i start) (loop (+ i 1) (cdr l) c)) ((< i start) (loop (+ i 1) (cdr l) c))
(else (loop (+ i 1) (cdr l) (if (emits-bookmark? (car l)) (+ c 1) c))))))) (else (loop (+ i 1) (cdr l) (+ c (bookmark-count (car l)))))))))
;; chapters: (title . start-index). start-index = Anzahl der song-list- ;; chapters: (title . start-index). start-index = Anzahl der song-list-
;; Eintraege beim Aufruf von songsChapter = Index in `ordered`, ab dem ;; Eintraege beim Aufruf von songsChapter = Index in `ordered`, ab dem
;; das Kapitel beginnt. ;; das Kapitel beginnt.
@@ -397,81 +304,27 @@ songs =
(music (assq-ref songvars 'music)) (music (assq-ref songvars 'music))
(layout (assq-ref songvars 'layout)) (layout (assq-ref songvars 'layout))
(text-pages (assq-ref songvars 'text-pages)) (text-pages (assq-ref songvars 'text-pages))
(label (assq-ref songvars 'label))) (label (assq-ref songvars 'label))
(toc-music (header-module-to-toc! (ly:book-header header) label)))
(set! song-number newnumber) (set! song-number newnumber)
;; ChordPro_music_collector (Strophen unter den Noten, siehe ;; Eingebettete Lieder: eigene Liednummer, gleiche Seite (label)
;; chordpro.ily) braucht den Song-Key beim tatsaechlichen (for-each
;; Interpretieren dieses Songs' Hauptscore. Im Buch ist DAS (lambda (song)
;; NICHT synchron zu dieser for-each-Schleife -- LilyPond (let ((tocheader (make-module)))
;; interpretiert die \score-Bloecke aller Lieder gesammelt fuer (set! song-number (+ 1 song-number))
;; das Seitenlayout, oft NACHDEM die Schleife schon beim (ly:module-copy tocheader song)
;; naechsten (oder letzten) Lied angelangt ist. Ein globaler (module-define! tocheader 'songnumber (number->string song-number))
;; chordpro-active-song-key waere zu diesem Zeitpunkt also auf (module-define! tocheader 'chapterref current-chapter)
;; ein ANDERES Lied gesetzt -- die gesammelten Strophen landen (header-module-to-toc! tocheader label)))
;; dann fälschlich im Store-Eintrag des zuletzt verarbeiteten (embedded-songs-of-header (ly:book-header header)))
;; Lieds (beobachtet: mehrere Lieder ohne eigene \chordlyrics
;; wurden alle in den letzten Song der Test-Bibliothek
;; geschrieben). Deshalb setzen wir den Key per \applyContext
;; DIREKT IN DER MUSIK in chordpro-context-song-keys (siehe
;; chordpro.ily) -- das laeuft synchron zur tatsaechlichen
;; Interpretation dieses Scores und ist deshalb robust gegen die
;; verzoegerte/gesammelte Verarbeitung (eine LilyPond-Context-
;; Property ueber den \layout-Block waere hier keine Alternative:
;; LilyPond verwirft \applyContext-\ly:context-set-property!-
;; Aufrufe fuer nicht deklarierte Properties stillschweigend).
;; Der Music_collector liest bevorzugt diese Tabelle,
;; chordpro-active-song-key bleibt nur als Fallback
;; (Einzellied-Standalone-Pfad, dort synchron genug).
;; \consists nur bei chordpro-include-music-lyrics -- sonst
;; keine Kosten (Grob-Acknowledger fuer JEDEN Akkord/jede
;; Silbe/Strophenmarker des Hauptscores) fuer Buecher, die das
;; Feature nicht nutzen. Bewusst NICHT zusaetzlich an
;; chordpro-export-enabled gekoppelt -- die steuert nur, ob
;; \write-book-chordpro/\chordpro-delayed-write am Ende etwas
;; schreiben, nicht ob hier gesammelt wird.
(set! chordpro-active-song-key (symbol->string filename))
(let* ((collect-music-lyrics? (and (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics))
(song-layout
(if collect-music-lyrics?
#{
\layout {
$layout
songfilename = $(symbol->string filename)
\context {
\Score
\consists \ChordPro_music_collector
}
}
#}
#{
\layout {
$layout
songfilename = $(symbol->string filename)
}
#}))
(score-music
(if collect-music-lyrics?
#{
<<
\applyContext
#(let ((key (symbol->string filename)))
(lambda (ctx)
(hashq-set! chordpro-context-song-keys ctx key)))
$music
>>
#}
music)))
#{ #{
\bookpart { \bookpart {
$header $header
\headerToTOC #header #label $toc-music
\score { \score { $music \layout { $layout songfilename = $(symbol->string filename) } }
$score-music
$song-layout
}
$(add-text-pages text-pages) $(add-text-pages text-pages)
} }
#}))))))))) #}))))))))
ordered ordered
))) )))
+18 -19
View File
@@ -304,16 +304,9 @@ indexSection =
(add-index-item! 'indexSectionMarkup (prepend-alist-chain 'combine-with-next #t (prepend-alist-chain 'rawtext text '())) sorttext)) (add-index-item! 'indexSectionMarkup (prepend-alist-chain 'combine-with-next #t (prepend-alist-chain 'rawtext text '())) sorttext))
#(define (extract-and-check-vars-from-header bookheader varlist) #(define (extract-and-check-vars-from-header bookheader varlist)
(let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0))) (extract-and-check-vars-from-module (ly:book-header bookheader) varlist))
(extract-var-and-check (lambda (headervar)
(let* ((variableref (assoc-ref headervars headervar))
(extracted (if variableref (variable-ref variableref) #f)))
(if (and extracted (not (and (string? extracted) (string-null? extracted)))) extracted #f)))))
(map (lambda (varsymbol)
(cons varsymbol (extract-var-and-check varsymbol))
) varlist)))
headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?) #(define (header-module-to-toc! headermodule label)
(define (all-author-ids authors) (define (all-author-ids authors)
(let ((poetIds (find-author-ids-by 'text authors)) (let ((poetIds (find-author-ids-by 'text authors))
(translatorIds (find-author-ids-by 'translation authors)) (translatorIds (find-author-ids-by 'translation authors))
@@ -331,7 +324,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
)) ))
(let* (let*
( (
(extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors songnumber chapterref))) (extractedheadervars (extract-and-check-vars-from-module headermodule '(title starttext alttitle categorytitle categories authors songnumber chapterref)))
(title (assq-ref extractedheadervars 'title)) (title (assq-ref extractedheadervars 'title))
(starttext (assq-ref extractedheadervars 'starttext)) (starttext (assq-ref extractedheadervars 'starttext))
(alttitle (assq-ref extractedheadervars 'alttitle)) (alttitle (assq-ref extractedheadervars 'alttitle))
@@ -357,6 +350,9 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(if title (add-to-toc! title #f) #{ #}) (if title (add-to-toc! title #f) #{ #})
)) ))
headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?)
(header-module-to-toc! (ly:book-header header) label))
%% https://github.com/NalaGinrut/guile-csv/blob/master/csv/csv.scm %% https://github.com/NalaGinrut/guile-csv/blob/master/csv/csv.scm
@@ -370,9 +366,6 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
#(define csv-write sxml->csv) #(define csv-write sxml->csv)
#(define-markup-command (write-toc-csv layout props) () #(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) (define (csv-escape field)
(if (string-null? field) (if (string-null? field)
field field
@@ -405,11 +398,8 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(para-lines (map cleanup-whitespaces para-strings))) (para-lines (map cleanup-whitespaces para-strings)))
(string-join para-lines "\n"))) (string-join para-lines "\n")))
(define (generate-toc-csv labelPageTable) (define (generate-toc-csv labelPageTable)
(let ((song-lines (map (lambda (song) (define (song-line filename page-number headermodule)
(let* ((filename (symbol->string (car song))) (let* ((extractedheadervars (extract-and-check-vars-from-module headermodule
(songvars (cdr song))
(page-number (assoc-get (assq-ref songvars 'label) labelPageTable))
(extractedheadervars (extract-and-check-vars-from-header (assq-ref songvars 'header)
'(title starttext alttitle categorytitle categories authors year_text year_melody year_translation year_composition year_adaption infotext translation pronunciation copyright source))) '(title starttext alttitle categorytitle categories authors year_text year_melody year_translation year_composition year_adaption infotext translation pronunciation copyright source)))
(headervar-or-empty (lambda (varsym) (headervar-or-empty (lambda (varsym)
(let ((extracted (assq-ref extractedheadervars varsym))) (let ((extracted (assq-ref extractedheadervars varsym)))
@@ -455,8 +445,17 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
(format-info-paragraphs (headervar-or-empty 'translation)) (format-info-paragraphs (headervar-or-empty 'translation))
(format-info-paragraphs (headervar-or-empty 'pronunciation)) (format-info-paragraphs (headervar-or-empty 'pronunciation))
)))) ))))
;; Eingebettete Lieder (embedded_songs.ily) bekommen eigene Zeilen mit
;; Dateiname und Seite des Hauptlieds.
(let ((song-lines (append-map (lambda (song)
(let* ((filename (symbol->string (car song)))
(songvars (cdr song))
(page-number (assoc-get (assq-ref songvars 'label) labelPageTable))
(headermodule (ly:book-header (assq-ref songvars 'header))))
(map (lambda (module) (song-line filename page-number module))
(cons headermodule (embedded-songs-of-header headermodule)))))
(alist-delete 'markupPage (alist-delete 'imagePage (alist-delete 'emptyPage song-list)))))) (alist-delete 'markupPage (alist-delete 'imagePage (alist-delete 'emptyPage song-list))))))
(call-with-output-file csv-filename (call-with-output-file "toc.csv"
(lambda (port) (lambda (port)
(csv-write (cons '( (csv-write (cons '(
"filename" "filename"
+29 -56
View File
@@ -1,10 +1,17 @@
MUSIC = { \transposable #TRANSPOSITION \MUSIC } MUSIC = { \transposable #TRANSPOSITION \MUSIC }
%% Eingebettete Lieder (siehe embedded_songs.ily) im Header des Hauptlieds
%% vermerken, daraus bauen Footer, PDF-Lesezeichen und Verzeichnisse.
#(if (and (pair? EMBEDDED_SONGS) (ly:book? HEADER) (ly:book-header HEADER))
(module-define! (ly:book-header HEADER) 'embeddedsongs EMBEDDED_SONGS))
LAYOUT = \layout { LAYOUT = \layout {
\LAYOUT \LAYOUT
#(customized-layout LAYOUT) #(customized-layout LAYOUT)
} }
#(customize-embedded-score-layouts! (list TEXT TEXT_PAGES))
verselayout = \layout { verselayout = \layout {
\LAYOUT \LAYOUT
\context { \context {
@@ -72,68 +79,34 @@ TEXT = \markuplist {
(if paper (set! $defaultpaper paper)) (if paper (set! $defaultpaper paper))
) )
;; Meta-Daten des Liedes als YAML neben die Ausgabedatei schreiben ;; ChordPro export: Store filename and extract metadata from basicSongInfo FIRST
;; (<ly:parser-output-name>.yml, landet wie das PDF relativ zum
;; Arbeitsverzeichnis). Die Textseiten-Strophen kommen aus dem
;; Render-Collector (chordpro.ily), deshalb wird erst bei der Ausgabe
;; geschrieben: unsichtbarer delayed Stencil an der letzten Textseite.
;; 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)))))
;; ChordPro export (Einzellied): Song-Key ist der Ausgabename (die .cho
;; landet wie das PDF relativ zum Arbeitsverzeichnis); Titel/Autoren
;; kommen aus HEADER in den per-Song-Store.
(when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled) (when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled)
(set! chordpro-default-song-key (ly:parser-output-name)) ;; Use ly:parser-output-name which returns the output basename
(chordpro-register-song-metadata chordpro-default-song-key HEADER)) ;; This will write relative to current working directory (same as PDF)
(let ((output-name (ly:parser-output-name)))
(set! chordpro-current-filename output-name))
;; Try to extract metadata from the HEADER (falls back to basicSongInfo)
(let ((header-module (if (and (ly:book? HEADER) (ly:book-header HEADER))
(ly:book-header HEADER)
(and (defined? 'basicSongInfo) basicSongInfo))))
(when header-module
(let* ((header-alist (ly:module->alist header-module))
(title (assoc-ref header-alist 'title))
(authors (assoc-ref header-alist 'authors)))
(when title
(set! chordpro-header-title
(if (markup? title)
(markup->string title)
(if (string? title) title "Untitled"))))
(when authors
(set! chordpro-header-authors authors))))))
;; ChordPro_music_collector (Strophen unter den Noten, siehe chordpro.ily)
;; braucht den aktiven Song-Key VOR der Interpretation des Hauptscores.
;; \consists nur bei chordpro-include-music-lyrics -- sonst keine Kosten
;; (Grob-Acknowledger fuer JEDEN Akkord/jede Silbe/Strophenmarker des
;; Hauptscores) fuer Lieder/Buecher, die das Feature nicht nutzen. Bewusst
;; NICHT zusaetzlich an chordpro-export-enabled gekoppelt: die Flag ist
;; eigenstaendig gedacht (steuert nur, ob \chordpro-delayed-write bzw.
;; \write-book-chordpro am Ende tatsaechlich etwas schreiben -- ob dafuer
;; Daten gesammelt wurden, ist eine davon unabhaengige Entscheidung).
(set! chordpro-active-song-key (ly:parser-output-name))
(if (and (defined? 'chordpro-include-music-lyrics) chordpro-include-music-lyrics)
(add-score #{
\score {
\MUSIC
\layout {
\LAYOUT
\context {
\Score
\consists \ChordPro_music_collector
}
}
}#})
(add-score #{ (add-score #{
\score { \score {
\MUSIC \MUSIC
\layout { \LAYOUT } \layout { \LAYOUT }
}#})) }#})
(add-text-pages TEXT_PAGES) (add-text-pages TEXT_PAGES)
(add-score #{ (add-score #{