extract meta data from lilypond compilation

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

.gitignore

@@ -1,8 +1,8 @@
 # ---> Lilypond
 *.pdf
+*.cho
 *.ps
 *.midi
 *.mid
 *.log
 *~
-

all_base_includes.ly

@@ -1,40 +0,0 @@
-#(define noStandaloneOutput (if (defined? 'noStandaloneOutput) noStandaloneOutput #f))
-
-#(define windows? (string-prefix-ci? "windows" (utsname:sysname (uname))))
-
-#(if (defined? 'LAYOUT) #f
-  (let ((scm-load (lambda (filename) (load (
-    string-append
-      ; on windows the detection of absolute pathes is broken (cause they start with a drive letter and not with a /)
-      ; so we have to use relative pathes for load. That works in frescobaldi, but not if you call lilypond from command line,
-      ; with a relative path to the .ly file, so we use absolute pathes on posix systems, where it works.
-      (if windows?
-        ""
-        (string-append (dirname (current-filename)) file-name-separator-string))
-      "scm" file-name-separator-string filename
-    )))))
-    (scm-load "json_parser.scm")
-    (scm-load "resolve_inherits.scm")
-    (scm-load "yaml_parser.scm")))
-#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file "../../lilypond-song-includes/data/authors.yml")))
-#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file "../../lilypond-song-includes/data/songs.yml")))
-
-\include "basic_format_and_style_settings.ly"
-\include "eps_file_from_song_dir.ly"
-\include "title_with_category_images.ly"
-\include "chord_settings.ly"
-\include "transposition.ly"
-\include "verses_with_chords.ly"
-\include "arrows_in_scores.ly"
-\include "swing_style.ly"
-\include "inline_score.ly"
-
-% reset important variables
-LAYOUT = \layout { \generalLayout }
-HEADER = {}
-MUSIC = {}
-TEXT = \markuplist {""}
-
-verseChords = {}
-firstVoice = {}
-global = {}

basic_format_and_style_settings.ly

@@ -1,196 +0,0 @@
-\language "deutsch"
-
-\include "default_style.ly"
-\include "default_songinfo_style.ly"
-\include "footer_with_songinfo.ly"
-
-\include #(if (defined? 'customStyleOverridesFile) customStyleOverridesFile "void.ly")
-
-#(set-default-paper-size songFormatAndSize)
-#(set-global-staff-size globalSize)
-
-\paper {
-  property-defaults.fonts.serif = \songChordFont
-  property-defaults.fonts.sans = \songLyricFont
-  %annotate-spacing = ##t
-  % spacing stuff
-  two-sided = ##t
-  inner-margin = 1.5\cm
-  outer-margin = \songMargin
-  binding-offset = 0\cm
-  top-margin = \songMargin
-  bottom-margin = \songMargin
-  system-system-spacing = #'((basic-distance . 10) (padding . 1.5))
-  markup-system-spacing = #'((basic-distance . 1))
-  score-markup-spacing = #'((padding . 2))
-  top-markup-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
-  refMarkupFormatter = #(lambda (layout props stanzanumbers)
-    (interpret-markup layout props
-    (if (null? stanzanumbers)
-        refString
-        (ly:format refStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", ")))))
-}
-
-generalLayout = \layout {
-  indent = #0
-  \context {
-    \Lyrics
-    \override LyricText.font-size = #lyricSize
-    \override StanzaNumber.font-size = #lyricSize
-    \override StanzaNumber.font-family = #'sans
-    \override LyricText.font-family = #'sans
-    \override LyricExtender.minimum-length = 0
-  }
-  \context {
-    \Staff
-    \accidentalStyle modern
-    \consists Merge_rests_engraver
-  }
-  \context {
-    \Score
-    \remove "Bar_number_engraver"
-    \RemoveEmptyStaves
-    \override VerticalAxisGroup.remove-first = ##t
-    \overrideTimeSignatureSettings
-      4/4               % timeSignatureFraction
-      1/4               % baseMomentFraction
-      #'(1 1 1 1)       % beatStructure
-      #'()		% beamExceptions
-    \overrideTimeSignatureSettings
-      3/4               % timeSignatureFraction
-      1/4               % baseMomentFraction
-      #'(1 1 1 1)       % beatStructure
-      #'()		% beamExceptions
-  }
-  \context {
-    \Voice
-    % ich will lines breaken wie ich will!
-    \remove "Forbid_line_break_engraver"
-    \override NoteHead.layer = 2
-    \override Dots.layer = 2
-    \override Stem.layer = 2
-    \override Flag.layer = 2
-    \override Beam.layer = 2
-  }
-}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% kleine Helferlein:
-
-textp = \lyricmode { \markup { \raise #1 \musicglyph #"rests.3" } }
-
-% zweite Stimme alles grau
-secondVoiceStyle = {
-  \override NoteHead.color = #grey
-  \override Dots.color = #grey
-  \override Stem.color = #grey
-  \override Flag.color = #grey
-  \override Beam.color = #grey
-  \override NoteHead.layer = 1
-  \override Dots.layer = 1
-  \override Stem.layer = 1
-  \override Flag.layer = 1
-  \override Beam.layer = 1
-}
-
-firstVoiceStyle = {
-  \override NoteHead.color = #black
-  \override Dots.color = #black
-  \override Stem.color = #black
-  \override Flag.color = #black
-  \override Beam.color = #black
-}
-
-% Deprecated: einzelne Noten innerhalb von \secondVoiceStyle mit schwarzem statt grauem Kopf
-schwarzkopf =
-  #(define-music-function (parser location noten) (ly:music?)
-    (begin (ly:warning "\\schwarzkopf brauchts nicht mehr, das kann ersatzlos weg!") noten))
-
-romanStanza =
-  #(define-music-function (parser location) ()
-  #{ \override StanzaNumber.style = #'roman #})
-
-override-stanza =
-#(define-music-function (parser location stanzanumber) (number?)
-#{
-  \once \override StanzaNumber.forced-spacing = #stanzanumber % misuse property "forced-spacing" to override the stanzanumber
-#}
-)
-
-stanza =
-#(define-music-function (parser location stanzanumber) (number?)
-#{
-  \once \override StanzaNumber.layer = 23 % set this to signal that there is a real stanza and no repeat signs
-  \applyContext
-  #(lambda (context)
-    (let* ((stanzanumber (ly:assoc-get 'forced-spacing (ly:context-grob-definition context 'StanzaNumber) stanzanumber))
-           (stanzastyle (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber)))
-           (formattedStanzaNumber (format #f (if (eq? stanzastyle 'roman) romanStanzaFormat stanzaFormat) stanzanumber)))
-        (ly:context-set-property! context 'stanza formattedStanzaNumber)))
-#}
-)
-
-ref =
-#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
-#{ \lyricmode {
-    \once \override StanzaNumber.layer = 23 % set this to signal that there is a real stanza and no repeat signs
-    \set stanza = #(make-on-the-fly-markup (lambda (layout props m) ((ly:output-def-lookup layout 'refMarkupFormatter) layout props stanzanumbers)) (make-null-markup))
-    #lyrics
-  }
-#}
-)
-
-% 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.layer = 23 we set that also as stanza.
-repStartWithTag = \lyricmode {
-  \tag #'repeats {
-    \applyContext
-    #(lambda (context)
-      (let ((lastStanza (ly:context-property context 'stanza))
-            (printLastStanza (= (ly:assoc-get 'layer (ly:context-grob-definition context 'StanzaNumber) 0) 23))
-            (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 {
-  \tag #'repeats {
-    \once \override StanzaNumber.font-series = #'normal
-    \once \override StanzaNumber.direction = 1
-    \set stanza = \markup { \repStop }
-  }
-}
-
-rightHyphen = \lyricmode {
-  \once \override StanzaNumber.font-series = #'normal
-  \once \override StanzaNumber.direction = 1
-  \set stanza = "-"
-}
-
-leftHyphen = \lyricmode {
-  \once \override StanzaNumber.font-series = #'normal
-  \set stanza = "-"
-}
-
-multiVerseSkips =
-#(define-music-function (parser location skips) (number?)
-  #{ \tag #'multiVerse { \repeat unfold #skips { \skip4 } } #})
-
-alt =
-#(define-music-function (parser location a b) (ly:music? ly:music?)
-  #{ \tag #'firstVerse { #a } \tag #'multiVerse { #b } #})
-
-updown =
-#(define-music-function (parser location word) (string?)
-#{
-  \lyricmode {
-    \tag #'up { \markup { #(string-capitalize word) } }
-    \tag #'down { \markup { #(string-downcase word) } }
-  }
-#})

book_include.ly

@@ -1,360 +0,0 @@
-#(define song-list '())
-
-#(define (files-in-directory dirname)
-      ;;; Generate list containing filenames
-      (let ((dir (opendir dirname)))
-        (let next ((f (readdir dir))
-    	       (files '()))
-          (cond ((eof-object? f)
-    	     (closedir dir)
-    	     files)
-    	    (else
-    	     (next (readdir dir) (if (string-match "^(0|\\.)" f) files (cons f files))))))))
-
-#(define (file-to-stats filename)
-   (set! song-list (cons filename song-list)))
-
-
-#(define additional-page-switch-label-list '())
-#(define additional-page-numbers #f)
-
-normalPageNumbers =
-#(define-void-function (parser location) ()
-  (set! additional-page-numbers #f)
-)
-additionalPageNumbers =
-#(define-void-function (parser location) ()
-  (set! additional-page-numbers #t)
-)
-
-#(define (real-page-number layout label)
-  (let ((table (ly:output-def-lookup layout 'label-page-table)))
-        (if (list? table)
-            (assoc-get label table)
-            #f))
-  )
-
-#(define display-pages-list '())
-#(define (build-display-pages-list layout)
-  (if (null? display-pages-list)
-    (let calculate-display-page ((switch-label-list additional-page-switch-label-list))
-      (let* ((label (caar switch-label-list))
-             (is-additional (cdar switch-label-list))
-             (real-page (real-page-number layout label))
-             (rest-switch-label-list (cdr switch-label-list))
-             (display-page (if (null? rest-switch-label-list)
-               (if is-additional (- real-page 1) real-page)
-               (let* ((previous-label (caar rest-switch-label-list))
-                      (previous-is-additional (cdar rest-switch-label-list))
-                      (previous-display-page (calculate-display-page rest-switch-label-list)))
-                  (+ previous-display-page
-                    (if previous-is-additional
-                      (if is-additional 0 1)
-                      (if is-additional
-                          (- (- real-page (real-page-number layout previous-label)) 1)
-                          (- real-page (real-page-number layout previous-label)))
-                    )
-                  )
-               )
-             ))
-      )
-      (set! display-pages-list (acons label display-page display-pages-list))
-      display-page
-    )))
-  display-pages-list
-)
-
-
-#(define-markup-command (custom-page-number layout props label real-current-page-number)
-  (symbol? number?)
-  #:category other
-  "
-@cindex referencing page number, in text
-
-Reference to a page number.  @var{label} is the label set on the referenced
-page (using the @code{\\label} command), @var{gauge} a markup used to estimate
-the maximum width of the page number, and @var{default} the value to display
-when @var{label} is not found.
-
-(If the current book or bookpart is set to use roman numerals for page numbers,
-the reference will be formatted accordingly -- in which case the @var{gauge}'s
-width may require additional tweaking.)"
-  (let* ((gauge-stencil (interpret-markup layout props "XXX"))
-         (x-ext (ly:stencil-extent gauge-stencil X))
-         (y-ext (ly:stencil-extent gauge-stencil Y)))
-    (ly:stencil-outline
-     (ly:make-stencil
-      `(delay-stencil-evaluation
-        ,(delay (ly:stencil-expr
-                 (let* ((display-page (assq-ref (build-display-pages-list layout) label))
-                        (real-current-page (if (negative? real-current-page-number) (real-page-number layout label) real-current-page-number))
-                        (page-markup
-                          (if (assq-ref additional-page-switch-label-list label)
-                              (make-concat-markup (list (number-format 'arabic display-page)
-                                (make-char-markup (+ 97 (- real-current-page (real-page-number layout
-                                  (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 'arabic (+ display-page (- real-current-page (real-page-number layout label))))
-                          ))
-                        (page-stencil (interpret-markup layout props page-markup))
-                        (gap (- (interval-length x-ext)
-                                (interval-length (ly:stencil-extent page-stencil X)))))
-                   (interpret-markup layout props
-                                     (make-line-markup
-                                      (list
-                                       (make-hspace-markup gap)
-                                       page-markup)))))))
-      x-ext
-      y-ext)
-     (make-filled-box-stencil x-ext y-ext))))
-
-
-includeSong =
-#(define-void-function (parser location textproc filename) ((procedure?) string?)
-     #{
-     \bookOutputName #filename
-     #}
-    (ly:parser-parse-string (ly:parser-clone)
-      (ly:format "\\include \"~a/~a/~a.ly\"" songPath filename filename))
-    (let ((label (gensym "index")))
-      (set! additional-page-switch-label-list
-        (acons label additional-page-numbers additional-page-switch-label-list))
-      (set! song-list
-        (acons (string->symbol filename)
-          (acons 'label label (acons 'header HEADER (acons 'music MUSIC (acons 'layout LAYOUT (acons 'text #{ \markuplist \setsongfilename $filename $(if textproc (textproc TEXT) TEXT) #} '())))))
-          song-list))
-    ))
-
-blankpage =
-#(define-void-function (parser location) ()
-    (set! song-list
-      (acons 'emptyPage
-        '()
-        song-list)))
-
-imagepage =
-#(define-void-function (parser location xsize filename) (number? string?)
-    (set! song-list
-      (acons 'imagePage
-        (acons 'xsize xsize (acons 'filename filename '()))
-        song-list)))
-
-#(define-markup-command (pagecenter layout props stuff)(markup?)
-   (interpret-markup layout props
-     (let ((halfpaperheight (/ (ly:output-def-lookup layout 'paper-height) 2))
-           (halfstuffheight (/ (interval-length (ly:stencil-extent (interpret-markup layout props stuff) Y)) 2)))
-       (make-fill-line-markup (list (make-pad-to-box-markup '(0 . 0) (cons (- (- halfpaperheight halfstuffheight)) (+ halfpaperheight halfstuffheight)) stuff)))
-   )))
-
-songs =
-#(define-void-function (parser location) ()
- (for-each (lambda (songitems)
-   (ly:book-add-bookpart! (ly:parser-lookup '$current-book)
-    (let ((filename (car songitems))
-          (songvars (cdr songitems)))
-      (if (eq? filename 'emptyPage)
-          #{ \bookpart { \markup { \null } } #}
-      (if (eq? filename 'imagePage)
-          (let ((xsize (assq-ref songvars 'xsize))
-                (filename (ly:format "~a/~a" imagePagePath (assq-ref songvars 'filename))))
-          #{ \bookpart {
-               \paper {
-                 %{
-                 inner-margin = 0
-                 outer-margin = 0
-                 binding-offset = 0
-                 top-margin = 0
-                 bottom-margin = 0
-                 %}
-                 print-page-number = ##f
-                 last-bottom-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
-                 page-count = 1
-              }
-              \markup { \pagecenter { \epsfile #X #xsize #filename } }
-          } #}
-          )
-          (let ((header #{ \bookpart { $(assq-ref songvars 'header) \header {
-                  songfilename = $(symbol->string filename)
-                  myindexlabel = #(assq-ref songvars 'label)
-                } } #})
-                ;(header (assq-ref songvars 'header))
-                (music (assq-ref songvars 'music))
-                (layout (assq-ref songvars 'layout))
-                (text (assq-ref songvars 'text))
-                (label (assq-ref songvars 'label)))
-            #{
-              \bookpart {
-                $header
-                \headerToTOC #header #label
-                \score { $music \layout { $layout } }
-                $text
-              }
-            #}))))))
-   (reverse song-list)
-   ))
-
-#(define (boernel-stats)
-   (let (
-          (songs (map (lambda (song) (symbol->string (car song))) (alist-delete 'emptyPage song-list)))
-          (opticalline "---------------------------------------------------------"))
-   (ly:warning (string-join (list
-     opticalline
-     (string-concatenate (list "Inkludiert: " (number->string (length songs)) " Lieder\n"))
-     ;(string-join songs "\n")
-     "Nicht inkludiert:"
-     opticalline
-     (string-join (sort-list (lset-difference string=? (files-in-directory songPath) songs) string<?) "\n")
-     opticalline
-     ) "\n" )
-)))
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Include Images once and reference them:
-#(define bbox-regexp
-  (ly:make-regex "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
-
-#(define (get-postscript-bbox string)
-  "Extract the bbox from STRING, or return #f if not present."
-  (let*
-      ((match (ly:regex-exec bbox-regexp string)))
-
-    (if match
-        (map (lambda (x)
-               (string->number (ly:regex-match-substring match x)))
-             (cdr (iota 5)))
-
-        #f)))
-
-
-#(define eps-references '())
-
-#(define-public (eps-file-ref->stencil axis size just-embed file-name)
-  (let*
-      ((already-embedded (assq (string->symbol file-name) eps-references))
-       (counter (if already-embedded (cadr already-embedded) (if (null-list? eps-references) 1 (+ 1 (cadar eps-references)))))
-       (form-name (ly:format "IDForm~a" counter))
-       (data-name (ly:format "ImageData~a" counter))
-       (eps-content (ly:gulp-file file-name))
-       (contents (ly:format "~a execform" form-name))
-       (bbox (if already-embedded (cddr already-embedded) (get-postscript-bbox (car (string-split eps-content #\nul)))))
-       (bbox-size (if (= axis X)
-                      (- (list-ref bbox 2) (list-ref bbox 0))
-                      (- (list-ref bbox 3) (list-ref bbox 1))
-                      ))
-       (factor (if (< 0 bbox-size)
-                   (exact->inexact (/ size bbox-size))
-                   0))
-       (scaled-bbox
-        (map (lambda (x) (* factor x)) bbox))
-       ;; We need to shift the whole eps to (0,0), otherwise it will appear
-       ;; displaced in lilypond (displacement will depend on the scaling!)
-       (translate-string (ly:format "~a ~a translate" (- (list-ref bbox 0)) (- (list-ref bbox 1))))
-       (clip-rect-string (ly:format
-                          "~a ~a ~a ~a rectclip"
-                          (list-ref bbox 0)
-                          (list-ref bbox 1)
-                          (- (list-ref bbox 2) (list-ref bbox 0))
-                          (- (list-ref bbox 3) (list-ref bbox 1)))))
-
-    (if (not already-embedded) (set! eps-references
-                                     (acons (string->symbol file-name) (cons counter bbox) eps-references)))
-    (if bbox
-        (ly:make-stencil
-         (list
-          'embedded-ps
-          (string-append
-           (if (and already-embedded (not just-embed)) "" (ly:format
-            "
-/~a
-currentfile
-<< /Filter /SubFileDecode
-   /DecodeParms << /EODCount 0 /EODString (*EOD*) >>
->> /ReusableStreamDecode filter
-~a
-*EOD*
-def
-
-/~a
-<< /FormType 1
-   /BBox [~a ~a ~a ~a]
-   /Matrix [ 1 0 0 1 0 0]
-   /PaintProc
-   { pop
-       /ostate save def
-         /showpage {} def
-         /setpagedevice /pop load def
-         ~a 0 setfileposition ~a cvx exec
-       ostate restore
-   } bind
->> def
-" data-name eps-content form-name (list-ref bbox 0) (list-ref bbox 1) (list-ref bbox 2) (list-ref bbox 3) data-name data-name))
-           (if just-embed "" (ly:format
-            "
-gsave
-currentpoint translate
-BeginEPSF
-~a dup scale
-~a
-~a
-%%BeginDocument: ~a
-~a
-%%EndDocument
-EndEPSF
-grestore
-"         factor translate-string  clip-rect-string file-name contents
-))))
-         ;; Stencil starts at (0,0), since we have shifted the eps, and its
-         ;; size is exactly the size of the scaled bounding box
-         (if just-embed '(0 . 0) (cons 0 (- (list-ref scaled-bbox 2) (list-ref scaled-bbox 0))))
-         (if just-embed '(0 . 0) (cons 0 (- (list-ref scaled-bbox 3) (list-ref scaled-bbox 1)))))
-
-        (ly:make-stencil "" '(0 . 0) '(0 . 0)))
-    ))
-
-#(define-markup-command (epsfileref layout props axis size file-name)
-  (number? number? string?)
-  #:category graphic
-  "
-@cindex inlining an Encapsulated PostScript image
-
-Inline an EPS image.  The image is scaled along @var{axis} to
-@var{size}.
-
-@lilypond[verbatim,quote]
-\\markup {
-  \\general-align #Y #DOWN {
-    \\epsfile #X #20 #\"context-example.eps\"
-    \\epsfile #Y #20 #\"context-example.eps\"
-  }
-}
-@end lilypond"
-  (if (ly:get-option 'safe)
-      (interpret-markup layout props "not allowed in safe")
-      (eps-file-ref->stencil axis size #f file-name)
-      ))
-
-#(define-markup-command (epsfileembed layout props file-name)
-  (string?)
-  #:category graphic
-  "
-@cindex inlining an Encapsulated PostScript image
-
-Inline an EPS image.  The image is scaled along @var{axis} to
-@var{size}.
-
-@lilypond[verbatim,quote]
-\\markup {
-  \\general-align #Y #DOWN {
-    \\epsfile #X #20 #\"context-example.eps\"
-    \\epsfile #Y #20 #\"context-example.eps\"
-  }
-}
-@end lilypond"
-  (if (ly:get-option 'safe)
-      (interpret-markup layout props "not allowed in safe")
-      (eps-file-ref->stencil X 30 #t file-name)
-      ))

default_songinfo_style.ly

@@ -1,62 +0,0 @@
-\paper {
-  poetPrefix = "Worte:"
-  composerPrefix = "Weise:"
-  compositionPrefix = "Satz:"
-  poetAndComposerEqualPrefix = "Worte und Weise:"
-  voicePrefix = "Stimme:"
-  versePrefix = "Strophe:"
-  translationPrefix = "Übersetzung:"
-  interludePrefix = "Zwischenspiel:"
-  bridgePrefix = "Bridge:"
-
-  authorFormat =
-    #(lambda (noDetails name trail_name birth_year death_year organization)
-        (let ((string-present (lambda (str) (and str (not (and (string? str) (string-null? str))))))
-              (render_informations (lambda (infolist) (string-append (car infolist) (if (or noDetails (null? (cdr infolist))) "" (string-append " (" (string-join (cdr infolist) ", ") ")"))))))
-            (if (or (string-present trail_name) (string-present name))
-              (render_informations (filter string-present (list
-                trail_name
-                name
-                (if (and (string-present birth_year) (string-present death_year))
-                  (ly:format "~a‒~a" birth_year death_year)
-                  (if (string-present birth_year)
-                    (ly:format "*~a" birth_year)
-                    (if (string-present death_year) (ly:format "†~a" death_year) "")))
-                organization
-              )))
-              ""
-          )))
-
-  songinfoMarkup =
-    #(make-on-the-fly-markup
-      (lambda (layout props m)
-        (let* ((between-poet-and-composer-markup (chain-assoc-get 'header:between-poet-and-composer-markup props (make-hspace-markup 3)))
-              (poet-maybe-with-composer (chain-assoc-get 'songinfo:poet-maybe-with-composer props #f))
-              (composer (chain-assoc-get 'songinfo:composer props #f))
-              (copyright (chain-assoc-get 'songinfo:copyright props #f))
-              (infotext (chain-assoc-get 'songinfo:infotext props #f))
-              (translation (chain-assoc-get 'songinfo:translation props #f))
-              (pronunciation (chain-assoc-get 'songinfo:pronunciation props #f))
-              (year_text (chain-assoc-get 'songinfo:year_text props #f))
-              (year_melody (chain-assoc-get 'songinfo:year_melody props #f))
-              (poet-with-year (if (and poet-maybe-with-composer year_text) (string-append poet-maybe-with-composer ", " year_text) poet-maybe-with-composer))
-              (composer-with-year (if (and composer year_melody) (string-append composer ", " year_melody) composer))
-              (poet-and-composer-oneliner (if (and poet-with-year composer-with-year) (markup poet-with-year between-poet-and-composer-markup composer-with-year) #f))
-              (current-line-width (chain-assoc-get 'line-width props (ly:output-def-lookup layout 'line-width))))
-          (stack-lines DOWN 0.0 (chain-assoc-get 'baseline-skip props)
-            (interpret-markup-list layout props
-              (append
-                (if (and poet-and-composer-oneliner (< (interval-length (ly:stencil-extent (interpret-markup layout props poet-and-composer-oneliner) X)) current-line-width))
-                  (list poet-and-composer-oneliner)
-                  (make-wordwrap-string-internal-markup-list #t (string-append
-                    (if poet-with-year (string-append "\n\n" poet-with-year) "")
-                    (if composer-with-year (string-append "\n\n" composer-with-year) "")
-                  )))
-                (make-wordwrap-string-internal-markup-list #t (string-append
-                  (if copyright (string-append "\n\n© " copyright) "")
-                  (if infotext (string-append "\n\n" infotext) "")
-                  (if translation (string-append "\n\nÜbersetzung: " translation) "")
-                  (if pronunciation (string-append "\n\nAussprache: " pronunciation) ""))))))))
-      (make-null-markup)
-    )
-}

eps_file_from_song_dir.ly

@@ -1,18 +0,0 @@
-% songfilename auch im Markup verfügbar machen
-#(define-markup-list-command (setsongfilename layout props songfilename markuplist)
-  (string? markup-list?)
-  (interpret-markup-list layout (prepend-alist-chain 'songfilename songfilename props) markuplist))
-
-#(define-markup-command (customEps layout props ysize filename)(number? string?)
-   #:properties ((songfilename "")
-                 (defaultmarkup #f))
-   (interpret-markup layout props
-     (let ((filepath (if (string-null? songfilename)
-                          filename
-                          (ly:format "~a/~a/~a" songPath songfilename filename))))
-       (if (file-exists? filepath)
-             (make-epsfile-markup Y ysize filepath)
-             (if defaultmarkup
-                 defaultmarkup
-                 (ly:format "file does not exist ~a" filepath))
-))))

private_includes/base/all.ily

@@ -0,0 +1,64 @@
+#(define include_dir_not_added? (if (defined? 'include_dir_not_added?) include_dir_not_added? #t))
+#(if include_dir_not_added?
+   (let* ((common-include-dir (dirname (dirname (dirname (current-filename))))))
+      (ly:parser-append-to-include-path common-include-dir)
+      (set! include_dir_not_added? #f)))
+
+#(define noStandaloneOutput (if (defined? 'noStandaloneOutput) noStandaloneOutput #f))
+
+#(define windows? (string-prefix-ci? "windows" (utsname:sysname (uname))))
+
+#(if (defined? 'LAYOUT) #f
+  (let ((scm-load (lambda (filename) (load (
+    string-append
+      ; on windows the detection of absolute pathes is broken (cause they start with a drive letter and not with a /)
+      ; so we have to use relative pathes for load. That works in frescobaldi, but not if you call lilypond from command line,
+      ; with a relative path to the .ly file, so we use absolute pathes on posix systems, where it works.
+      (if windows?
+        ""
+        (string-append (dirname (current-filename)) file-name-separator-string))
+      "scm" file-name-separator-string filename
+    )))))
+    (scm-load "resolve_inherits.scm")
+    (scm-load "yaml_parser.scm")
+    (scm-load "yaml_writer.scm")))
+
+#(define (song-includes-data-path filename)
+  (string-join
+    (list
+      (dirname (dirname (dirname (dirname (current-filename)))))
+      "lilypond-song-includes"
+      "data"
+      filename)
+    file-name-separator-string))
+#(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"))))
+
+\include "merge_rests_engraver_override.ily"
+\include "basic_format_and_style_settings.ily"
+\include "eps_file_from_song_dir.ily"
+\include "title_with_category_images.ily"
+\include "chord_settings.ily"
+\include "chordpro.ily"
+\include "data_extractor.ily"
+\include "transposition.ily"
+\include "markup_tag_groups_hack.ily"
+\include "verses_with_chords.ily"
+\include "arrows_in_scores.ily"
+\include "swing_style.ily"
+\include "inline_score.ily"
+\include "custom_indentation.ily"
+\include "include_from_song.ily"
+
+% reset important variables
+LAYOUT = \layout { \generalLayout }
+HEADER = {}
+MUSIC = {}
+TEXT = \markuplist {}
+TEXT_PAGES = #f
+
+verseChords = {}
+firstVoice = {}
+global = {}
+
+\resetTagGroups

private_includes/base/basic_format_and_style_settings.ily

@@ -0,0 +1,334 @@
+\language "deutsch"
+
+\include "default_style.ily"
+\include "default_songinfo_style.ily"
+\include "footer_with_songinfo.ily"
+
+\include #(if (defined? 'customStyleOverridesFile) customStyleOverridesFile "../void.ily")
+
+#(set-default-paper-size songFormatAndSize)
+#(set-global-staff-size globalSize)
+
+\paper {
+  property-defaults.fonts.serif = \songChordFont
+  property-defaults.fonts.sans = \songLyricFont
+  %annotate-spacing = ##t
+  % spacing stuff
+  two-sided = ##t
+  inner-margin = 1.5\cm
+  outer-margin = \songMargin
+  binding-offset = 0\cm
+  top-margin = \songMargin
+  bottom-margin = \songMargin
+  system-system-spacing = #'((basic-distance . 10) (padding . 1.5))
+  markup-system-spacing = #'((basic-distance . 1))
+  score-markup-spacing = #'((padding . 2))
+  top-markup-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
+  refMarkupFormatter = #(lambda (layout props stanzanumbers)
+    (interpret-markup layout props
+    (if (null? stanzanumbers)
+        refString
+        (ly:format refStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", ")))))
+  bridgeMarkupFormatter = #(lambda (layout props stanzanumbers)
+    (interpret-markup layout props
+    (if (null? stanzanumbers)
+        bridgeString
+        (ly:format bridgeStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", ")))))
+}
+
+generalLayout = \layout {
+  indent = #0
+  \context {
+    \Lyrics
+    \override LyricText.font-size = #lyricSize
+    \override StanzaNumber.font-size = #lyricSize
+    \override StanzaNumber.font-family = #'sans
+    \override LyricText.font-family = #'sans
+    \override LyricExtender.minimum-length = 0
+  }
+  \context {
+    \Staff
+    \accidentalStyle modern-voice-cautionary
+    \consists \Better_Merge_rests_engraver
+  }
+  \context {
+    \Score
+    \remove "Bar_number_engraver"
+    \remove "Metronome_mark_engraver"
+    \RemoveEmptyStaves
+    \override VerticalAxisGroup.remove-first = ##t
+    \numericTimeSignature
+    \overrideTimeSignatureSettings
+      4/4               % timeSignatureFraction
+      1/4               % baseMomentFraction
+      #'(1 1 1 1)       % beatStructure
+      #'()		% beamExceptions
+    \overrideTimeSignatureSettings
+      3/4               % timeSignatureFraction
+      1/4               % baseMomentFraction
+      #'(1 1 1 1)       % beatStructure
+      #'()		% beamExceptions
+  }
+  \context {
+    \Voice
+    % ich will lines breaken wie ich will!
+    \remove "Forbid_line_break_engraver"
+    \override NoteHead.layer = 2
+    \override Rest.layer = 2
+    \override Dots.layer = 2
+    \override Stem.layer = 2
+    \override Flag.layer = 2
+    \override Beam.layer = 2
+    \override Slur.layer = 2
+    \override Tie.layer = 2
+    \override Accidental.layer = 2
+  }
+}
+
+#(define (customized-layout base-layout)
+   (let
+     ((custom-size (ly:output-def-lookup base-layout 'size #f)))
+     (if custom-size (layout-set-staff-size custom-size))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% kleine Helferlein:
+
+textp = \lyricmode { \markup { \raise #1 \musicglyph #"rests.3" } }
+
+% zweite Stimme alles grau
+secondVoiceStyle = {
+  \override NoteHead.color = #grey
+  \override Rest.color = #grey
+  \override Dots.color = #grey
+  \override Stem.color = #grey
+  \override Flag.color = #grey
+  \override Beam.color = #grey
+  \override Slur.color = #grey
+  \override Tie.color = #grey
+  \override Accidental.color = #grey
+  \override NoteHead.layer = 1
+  \override Rest.layer = 1
+  \override Dots.layer = 1
+  \override Stem.layer = 1
+  \override Flag.layer = 1
+  \override Beam.layer = 1
+  \override Slur.layer = 1
+  \override Tie.layer = 1
+  \override Accidental.layer = 1
+}
+
+firstVoiceStyle = {
+  \override NoteHead.color = #black
+  \override Rest.color = #black
+  \override Dots.color = #black
+  \override Stem.color = #black
+  \override Flag.color = #black
+  \override Beam.color = #black
+  \override Slur.color = #black
+  \override Tie.color = #black
+  \override Accidental.color = #black
+}
+
+% Deprecated: einzelne Noten innerhalb von \secondVoiceStyle mit schwarzem statt grauem Kopf
+schwarzkopf =
+  #(define-music-function (parser location noten) (ly:music?)
+    (begin (ly:warning "\\schwarzkopf brauchts nicht mehr, das kann ersatzlos weg!") noten))
+
+romanStanza =
+  #(define-music-function (parser location) ()
+  #{ \override StanzaNumber.style = #'roman #})
+
+override-stanza =
+#(define-music-function (parser location stanzanumbers) (number-list?)
+#{
+  \once \override StanzaNumber.details.custom-stanzanumber-override = #stanzanumbers
+#}
+)
+
+#(define (handle-stanza-numbers context numbers number-formater)
+  (let* ((stanzanumbers (ly:assoc-get 'custom-stanzanumber-override (ly:assoc-get 'details (ly:context-grob-definition context 'StanzaNumber) '()) numbers))
+         (stanza-style (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber)))
+         (roman-format (lambda (stanzanumber) (format #f "~@r" stanzanumber))))
+      (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)
+#{
+  \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-numbers = #stanzanumbers
+  \applyContext
+  #(lambda (context)
+    (handle-stanza-numbers context stanzanumbers
+      (lambda (numbers) (string-join (map (lambda (n) (format #f stanzaFormat n)) numbers) ", "))))
+#}
+)
+
+ref =
+#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
+#{ \lyricmode {
+    \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 = #'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
+  }
+#}
+)
+
+bridge =
+#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
+#{ \lyricmode {
+    \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 = #'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
+  }
+#}
+)
+
+% 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.
+% Sets custom-inline-text for ChordPro export so it can collect the repeat sign separately
+repStartWithTag = \lyricmode {
+  \tag #'repeats {
+    \once \override StanzaNumber.details.custom-inline-text = \repStart
+    \once \override StanzaNumber.details.custom-inline-direction = #LEFT
+    \applyContext
+    #(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 {
+  \tag #'repeats {
+    \once \override StanzaNumber.details.custom-inline-text = \repStop
+    \once \override StanzaNumber.details.custom-inline-direction = #RIGHT
+    \once \override StanzaNumber.font-series = #'normal
+    \once \override StanzaNumber.direction = 1
+    \set stanza = \markup { \pad-x-right #1 \repStop }
+  }
+}
+
+rightHyphen = \lyricmode {
+  \once \override StanzaNumber.font-series = #'normal
+  \once \override StanzaNumber.direction = 1
+  \set stanza = "-"
+}
+
+leftHyphen = \lyricmode {
+  \once \override StanzaNumber.font-series = #'normal
+  \set stanza = "-"
+}
+
+multiVerseSkips =
+#(define-music-function (parser location skips) (number?)
+  #{ \tag #'multiVerse { \repeat unfold #skips { \skip4 } } #})
+
+alt =
+#(define-music-function (parser location a b) (ly:music? ly:music?)
+  #{ \tag #'firstVerse { #a } \tag #'multiVerse { #b } #})
+
+updown =
+#(define-music-function (parser location word) (string?)
+(let ((first-char (string-take word 1))
+      (rest (substring word 1 (string-length word))))
+#{
+  \lyricmode {
+    \markup {
+      \tag #'up #(string-append (string-capitalize first-char) rest)
+      \tag #'down #(string-append (string-downcase first-char) rest)
+    }
+  }
+#}))
+
+dottedExtender = {
+  \override LyricExtender.style = #'dotted-line
+  \override LyricExtender.thickness = 2
+  \override LyricExtender.Y-offset = 0.1
+  \override LyricExtender.stencil =
+    #(lambda (grob)
+      (let* ((stil (ly:lyric-extender::print grob))
+             (nostil (null? stil))
+             (x-ext (if nostil 0 (ly:stencil-extent stil X))))
+         (if nostil
+           stil
+           (make-connected-line
+             (list
+               (cons (car x-ext) 0)
+               (cons (cdr x-ext) 0))
+             grob))))
+}
+
+melisOff = \set ignoreMelismata = ##t
+melisOn = \unset ignoreMelismata
+
+cue =
+#(define-music-function (zahlen) (number-list?)
+  #{
+      \tag #'cues {
+        \tweak self-alignment-X #LEFT
+        \mark
+          #(make-on-the-fly-markup
+            (lambda (layout props m) (interpret-markup layout (prepend-alist-chain 'cues zahlen props) (ly:output-def-lookup layout 'cueMarkup)))
+            (make-null-markup))
+      }
+  #})
+
+#(define-markup-command (ruf-style layout props text) (string?)
+   (interpret-markup layout props
+                     (markup #:italic (string-append "(" text ")"))))
+rufWithMarkup =
+#(define-music-function (text) (markup?)
+   #{
+     \lyricmode {
+       \once \override StanzaNumber.font-series = #'normal
+       \once \override StanzaNumber.direction = 1
+       \set stanza = #text
+     }
+   #})
+ruf =
+#(define-music-function (text) (string?)
+   (rufWithMarkup (make-ruf-style-markup text)))
+
+underlineOn =
+#(define-music-function () ()
+   #{
+     \override LyricText.stencil =
+     #(lambda (grob)
+        (grob-interpret-markup grob (make-underline-markup (ly:grob-property grob 'text))))
+   #})
+
+underlineOff =
+#(define-music-function () ()
+   #{
+     \revert LyricText.stencil
+   #})

private_includes/base/chord_settings.ily

@@ -38,87 +38,86 @@ shiftChords = #(define-music-function (parser location xshift chords) (number? l
 	$chords
 #})
 
-altChord = #(define-music-function (parser location mainchord altchord) (ly:music? ly:music?)
+altChord =
-(define (chord-namer in-pitches bass inversion context)
+#(define-music-function (parser location mainchord altchord) (ly:music? ly:music?)
-#{
+  (let* ((chord-name (lambda (in-pitches bass inversion context)
-  \markup {
+           (make-line-markup (list
-    \translate #'(-0.5 . 0)
+             (ignatzek-chord-names in-pitches bass inversion context)
-    \score {
+             (make-hspace-markup 0.3)
-      \chords { #mainchord \klamm #altchord }
+             (parenthesis-ignatzek-chord-names (music-pitches (transposable (cons (car (music-pitches mainchord)) (car in-pitches)) (music-clone altchord))) '() '() context)
-      \layout {
-        \LAYOUT
-        \context {
-          \ChordNames
-          \override ChordName.extra-spacing-width = #'(0 . 0.3)
-        }
-        \context {
-          \Score
-          \override SpacingSpanner.spacing-increment = 0
-        }
-      }
-    }
-  }
-#})
-#{
-  \once \set chordNameFunction = #chord-namer
-	#mainchord
-#})
-
-% kleine Mollakkorde und Alteration ausgeschrieben
-#(define (note-name->german-markup-nosym pitch lowercase?)
-   (define (pitch-alteration-semitones pitch) (inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
-   (define (accidental->markup alteration name)
-     (if (= alteration 0)
-         (make-line-markup (list empty-markup))
-          (if (= alteration FLAT)
-              (if (equal? name "B")
-                  ""
-              ;   (make-line-markup (list (make-hspace-markup 0.2)
-              ;     (make-tiny-markup (make-raise-markup 1.2
-              ;     (make-musicglyph-markup (assoc-get alteration standard-alteration-glyph-name-alist ""))))
-              ;   ))
-              (if (or (equal? name "E") (equal? name "A")) "s" "es"))
-              "is")
              ))
-   (define (conditional-string-downcase str condition)
+           )))
-     (if condition (string-downcase str) str))
+    #{
+      \once \set chordNameFunction = #chord-name
+      #mainchord
+    #}))
 
-   (let* ((name (ly:pitch-notename pitch))
+
-         (alt-semitones  (pitch-alteration-semitones pitch))
+% Akkorde werden so transponiert, dass sie passen, wenn man mit Kapo im angegebenen Bund spielt
-	 (n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -2)))
+capoTranspose =
-		  (cons 7 (+ 0 alt-semitones))
+#(define-music-function (fret chords) (number? ly:music?)
-		  (cons name alt-semitones))))
+  (define semi->pitch
-    (make-line-markup
+    (make-semitone->pitch
-     (list
+      (music-pitches
-      (make-simple-markup
+        #{ h b a gis g fis f e es d cis c #})))
-       (conditional-string-downcase
+  (transpose
-		(vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
+    (ly:pitch-transpose (semi->pitch fret) (ly:make-pitch 0 0))
-		lowercase?))
+    (ly:make-pitch 0 0)
-       (accidental->markup (/ (cdr n-a) 2) (vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a)) ))))
+    chords))
-)
 
 % additional bass notes should get uppercased
-#(define (bassnote-name->german-markup-nosym pitch lowercase?)(note-name->german-markup-nosym pitch #f))
+#(define (bassnote-name->german-markup-nosym pitch lowercase?)((chord-name:name-markup 'deutsch) pitch #f))
 
+defaultChordPrintings = {
+  <c g>-\markup { \super "5" }
+  %% Dur
+  <c e g a>-\markup { \super "6" } %Standardverhalten
+  <c e a >-\markup { \super "6(no5)" }
+  <c e g a d'>-\markup { \super "6/9" }
+  <c e g b d'>-\markup { \super "9" } %Standardverhalten
+  <c e g b d' f'>-\markup { \super "11" } %Standardverhalten
+  <c e g b d' a'>-\markup { \super "13" }
+  %add chords
+  <c e g d'>-\markup { \super "add9" }
+  <c e g f'>-\markup { \super "add11" }
+  <c e g a'>-\markup { \super "add13" }
+  %major chords
+  <c e g h d'>-\markup { \super "maj9" }
+  %% Moll
+  <c es g a>-\markup { \super "6" } %Standardverhalten
+  <c es a >-\markup { \super "6(no5)" }
+  <c es g a d'>-\markup { \super "6/9" }
+  <c es g b d'>-\markup { \super "9" } %Standardverhalten
+  <c es g b d' f'>-\markup { \super "11" } %Standardverhalten
+  <c es g b d' a'>-\markup { \super "13" }
+  %add chords
+  <c es g d'>-\markup { \super "add9" }
+  <c es g f'>-\markup { \super "add11" }
+  <c es g a'>-\markup { \super "add13" }
+  %major chords
+  <c es g h d'>-\markup { \super "maj9" }
+}
 
 #(define chordNameExceptions
+  (append
     (if (defined? 'customChordPrintings)
       (sequential-music-to-chord-exceptions customChordPrintings #t)
-  '()))
+      '())
+    (sequential-music-to-chord-exceptions defaultChordPrintings #t)))
 
 generalLayout = \layout {
   \generalLayout
   \context {
     \ChordNames
-    \semiGermanChords
     \override ChordName.font-size = \songScoreChordFontSize
     \override ChordName.font-series = \songChordFontSeries
     \override ChordName.font-family = #'serif
     chordNameLowercaseMinor = ##t
     chordChanges = ##t
-    % eigenen chordRootNamer damit F# = Fis und Gb = Ges (also alteration ausgeschrieben)
+    chordRootNamer = #(chord-name:name-markup 'deutsch)
-    chordRootNamer = #note-name->german-markup-nosym
     chordNoteNamer = #bassnote-name->german-markup-nosym
+    additionalPitchPrefix = ""
+
     majorSevenSymbol = "maj7"
     chordNameExceptions = \chordNameExceptions
   }

private_includes/base/custom_indentation.ily

@@ -0,0 +1,135 @@
+% https://lsr.di.unimi.it/LSR/Snippet?id=1098
+%%%%%%%% HEADER %%%%%%%%
+%
+% this code was prompted by
+% https://lists.gnu.org/archive/html/lilypond-user/2019-07/msg00139.html
+% and offers a pseudoIndent hack suitable for general use
+
+% keywords:
+% indent short-indent indentation system line
+% mid-score temporarily arbitrary individual single just only once
+% coda margin
+% mouse's tale acrostic mesostic spine
+
+%%%%%%%% PSEUDOINDENT FUNCTIONS %%%%%%%%
+
+% these two functions are for indenting individual systems
+% - to left-indent a system, apply \pseudoIndent before the music continues
+% - \pseudoIndents is similar, but lets you also indent on the right
+% - both provide an option for changing that system's instrument names
+
+% N.B. these functions
+% - assume application to non-ragged lines (generally the default)
+% - include a manual \break to ensure application at line start
+% - misbehave if called more than once at the same line start
+
+% the parameters of the (full) pseudoIndents function are:
+% 1: name-tweaks
+%      usually omitted; accepts replacement \markup for instrument names
+%      as an ordered list; starred elements leave their i-names unchanged.
+% 2: left-indent
+%      additional left-indentation, in staff-space units; can be negative,
+%      but avoid a total indentation which implies (unsupported) stretching.
+% 3: right-indent
+%      amount of right-indentation, in staff-space units; can be negative.
+%      - not offered by the (reduced) pseudoIndent function
+
+
+pseudoIndents = % inline alternative to a new \score, also with right-indent
+#(define-music-function (name-tweaks left-indent right-indent)
+  ((markup-list? '()) number? number?)
+  (define (warn-stretched p1 p2) (ly:input-warning (*location*) (G_
+    " pseudoIndents ~s ~s is stretching staff; expect distorted layout") p1 p2))
+  (let* (
+    (narrowing (+ left-indent right-indent)) ; of staff implied by args
+
+    (set-staffsymbol! (lambda (staffsymbol-grob) ; change staff to new width
+      (let* (
+        (left-bound (ly:spanner-bound staffsymbol-grob LEFT))
+        (left-moment (ly:grob-property left-bound 'when))
+        (capo? (moment<=? left-moment ZERO-MOMENT)) ; in first system of score
+        (layout (ly:grob-layout staffsymbol-grob))
+        (lw (ly:output-def-lookup layout 'line-width)) ; debugging info
+        (indent (ly:output-def-lookup layout (if capo? 'indent 'short-indent)))
+        (old-stil (ly:staff-symbol::print staffsymbol-grob))
+        (staffsymbol-x-ext (ly:stencil-extent old-stil X))
+        ;; >=2.19.16's first system has old-stil already narrowed [2]
+        ;; compensate for this (ie being not pristine) when calculating
+        ;; - old leftmost-x (its value is needed when setting so-called 'width)
+        ;; - the new width and position (via local variable narrowing_)
+        (ss-t (ly:staff-symbol-line-thickness staffsymbol-grob))
+        (pristine? (<= 0 (car staffsymbol-x-ext) ss-t)) ; would expect half
+        (leftmost-x (+ indent (if pristine? 0 narrowing)))
+        (narrowing_ (if pristine? narrowing 0)) ; uses 0 if already narrowed
+        (old-width (+ (interval-length staffsymbol-x-ext) ss-t))
+        (new-width (- old-width narrowing_))
+        (new-rightmost-x (+ leftmost-x new-width)) ; and set! this immediately
+        (junk (ly:grob-set-property! staffsymbol-grob 'width new-rightmost-x))
+        (in-situ-stil (ly:staff-symbol::print staffsymbol-grob))
+        (new-stil (ly:stencil-translate-axis in-situ-stil narrowing_ X))
+       ;(new-stil (stencil-with-color new-stil red)) ; for when debugging
+        (new-x-ext (ly:stencil-extent new-stil X)))
+      (ly:grob-set-property! staffsymbol-grob 'stencil new-stil)
+      (ly:grob-set-property! staffsymbol-grob 'X-extent new-x-ext)
+      )))
+
+    (set-X-offset! (lambda (margin-grob) ; move grob across to line start
+      (let* (
+        (old (ly:grob-property-data margin-grob 'X-offset))
+        (new (lambda (grob) (+ (if (procedure? old) (old grob) old) narrowing))))
+      (ly:grob-set-property! margin-grob 'X-offset new))))
+
+    (tweak-text! (lambda (i-name-grob mkup) ; tweak both instrumentname texts
+      (if (and (markup? mkup) (not (string=? (markup->string mkup) "*")))
+      (begin
+        (ly:grob-set-property! i-name-grob 'long-text mkup)
+        (ly:grob-set-property! i-name-grob 'text mkup)
+        )))) ; else retain existing text
+
+    (install-narrowing (lambda (leftedge-grob) ; on staves, + adapt left margin
+      (let* (
+        (sys (ly:grob-system leftedge-grob))
+        (all-grobs (ly:grob-array->list (ly:grob-object sys 'all-elements)))
+        (grobs-named (lambda (name)
+          (filter (lambda (x) (eq? name (grob::name x))) all-grobs)))
+        (first-leftedge-grob (list-ref (grobs-named 'LeftEdge) 0))
+        (relsys-x-of (lambda (g) (ly:grob-relative-coordinate g sys X)))
+        (leftedge-x (relsys-x-of first-leftedge-grob))
+        (leftedged? (lambda (g) (= (relsys-x-of g) leftedge-x)))
+        (leftedged-ss (filter leftedged? (grobs-named 'StaffSymbol))))
+      (if (eq? leftedge-grob first-leftedge-grob) ; ignore other leftedges [1]
+       (begin
+         (for-each set-staffsymbol! leftedged-ss)
+         (for-each set-X-offset! (grobs-named 'SystemStartBar))
+         (for-each set-X-offset! (grobs-named 'InstrumentName))
+         (for-each tweak-text! (grobs-named 'InstrumentName) name-tweaks)
+       ))))))
+
+  (if (negative? narrowing) (warn-stretched left-indent right-indent))
+  #{ % and continue anyway
+    % ensure that these overrides are applied only at begin-of-line
+    \break % (but this does not exclude unsupported multiple application)
+    % give the spacing engine notice regarding the loss of width for music
+    \once \override Score.LeftEdge.X-extent = #(cons narrowing narrowing)
+    % discard line start region of staff and reassemble left-margin elements
+    \once \override Score.LeftEdge.after-line-breaking = #install-narrowing
+    % shift the system to partition the narrowing between left and right
+    \overrideProperty Score.NonMusicalPaperColumn.line-break-system-details
+    .X-offset #(- right-indent)
+    % prevent a leftmost barnumber entering a stretched staff
+    \once \override Score.BarNumber.horizon-padding = #(max 1 (- 1 narrowing))
+  #}))
+
+pseudoIndent = % for changing just left-indent
+#(define-music-function (name-tweaks left-indent)
+  ((markup-list? '()) number?)
+  #{
+    \pseudoIndents $name-tweaks $left-indent 0
+  #})
+
+% [1] versions <2.19.1 can have end-of-line leftedges too
+%     - these were eliminated in issue 3761
+% [2] versions >=2.19.16: the first system behaves differently from the rest
+%     - a side effect of issue 660 ?
+% [3] versions >=2.23.0: LeftEdge's position may well differ in Y (but not in X)
+%     - a side effect of issue 6084 ?

private_includes/base/data_extractor.ily

@@ -0,0 +1,550 @@
+%%% Extrahiert Informationen aus einem ly:music-Objekt und liefert eine alist
+%%% mit String-Werten zurueck (z.B. ((time . "4/4") (key . "d minor"))).
+%%% Benoetigt LilyPond >= 2.26.
+
+%% note-name->lily-string liegt im Modul (lily display-lily).
+#(use-modules (lily display-lily))
+
+#(begin
+
+   ;; --- Taktangabe --------------------------------------------------------
+
+   ;; Numerator einer Taktangabe kann eine Zahl oder eine Liste sein.
+   (define (numerator->string num)
+     (if (list? num)
+         (string-join (map number->string num) "+")
+         (number->string num)))
+
+   ;; Ein einzelner Bruch ist ein Paar (numerator . denominator), der
+   ;; Numerator eine Zahl oder eine Liste (z.B. 3+3/8).
+   (define (fraction->string frac)
+     (string-append (numerator->string (car frac)) "/"
+                    (number->string (cdr frac))))
+
+   ;; Liefert die Taktangabe als String (z.B. "4/4", "3+3/8" oder
+   ;; "3+3/8 + 2/8") oder #f. time-signature ist ein Bruch oder bei
+   ;; zusammengesetzten Taktarten (\timeAbbrev, \compoundMeter) eine
+   ;; Liste von Bruechen.
+   (define (time-music->string m)
+     (let ((ts (ly:music-property m 'time-signature)))
+       (and (pair? ts)
+            (if (number? (cdr ts))
+                (fraction->string ts)
+                (string-join (map fraction->string ts) " + ")))))
+
+   ;; --- Tempo ---------------------------------------------------------------
+
+   ;; Liefert die Tempoangabe als String (z.B. "4 = 130", "4. = 60-70",
+   ;; "Allegro" oder "Allegro (4 = 130)") oder #f.
+   (define (tempo-music->string m)
+     (let* ((unit (ly:music-property m 'tempo-unit))
+            (count (ly:music-property m 'metronome-count))
+            (text (ly:music-property m 'text))
+            (unit-s (and (ly:duration? unit)
+                         (string-append
+                          (number->string (expt 2 (ly:duration-log unit)))
+                          (make-string (ly:duration-dot-count unit) #\.))))
+            (count-s (cond ((number? count) (number->string count))
+                           ((pair? count) (ly:format "~a-~a" (car count) (cdr count)))
+                           (else #f)))
+            (metronome-s (and unit-s count-s (string-append unit-s " = " count-s)))
+            (text-s (and (markup? text) (markup->string text))))
+       (cond
+        ((and text-s metronome-s) (string-append text-s " (" metronome-s ")"))
+        (metronome-s metronome-s)
+        (text-s text-s)
+        (else #f))))
+
+   ;; --- Tonart ------------------------------------------------------------
+
+   ;; Liefert die Tonart als String (z.B. "d minor" oder "c major") oder #f.
+   ;; Vorgehen wie in LilyPonds eigenem \displayMusic (define-music-display-
+   ;; methods.scm): pitch-alist nach c zuruecktransponieren und mit den
+   ;; bekannten Modus-Definitionen vergleichen. note-name->lily-string liefert
+   ;; den Grundton in der aktuell eingestellten Notensprache.
+   (define (key-music->string m)
+     (let ((tonic (ly:music-property m 'tonic))
+           (alist (ly:music-property m 'pitch-alist)))
+       (and (ly:pitch? tonic) (pair? alist)
+            (let* ((c-alist (ly:transpose-key-alist alist (- tonic)))
+                   (mode (any (lambda (mode)
+                                (and (equal? (ly:parser-lookup mode) c-alist)
+                                     (symbol->string mode)))
+                              '(major minor))))
+              (and mode
+                   (string-append (symbol->string (note-name->lily-string tonic))
+                                  " " mode))))))
+
+   ;; --- Header-Metadaten ----------------------------------------------------
+
+   ;; Header-Felder, die eigentlich Layoutsachen sind (gehoerten nach paper)
+   ;; und deshalb nicht mit exportiert werden.
+   (define ignored-header-fields
+     '(titlesize titletopspace tagline between-poet-and-composer-markup))
+
+   ;; categories ist im Header ein String mit Leerzeichen ("trist satz")
+   ;; und wird als Liste von Woertern exportiert.
+   (define (header-value key value)
+     (if (and (eq? key 'categories) (string? value))
+         (string-tokenize value)
+         value))
+
+   ;; Nimmt einen Bookpart entgegen (wie HEADER aus pool_bottom.ily) und
+   ;; liefert dessen Header-Felder als alist, z.B.
+   ;; ((title . "Ako umram") (authors . (("..." text melody))) ...).
+   ;; Die Werte bleiben unveraendert, wie sie im \header definiert wurden
+   ;; (Strings, Listen, Markups ...).
+   (define (bookpart->header-alist bookpart)
+     (let ((header (ly:book-header bookpart)))
+       (if (module? header)
+           (sort
+            (filter-map (lambda (entry)
+                          (and (variable-bound? (cdr entry))
+                               (not (memq (car entry) ignored-header-fields))
+                               (cons (car entry)
+                                     (header-value (car entry)
+                                                   (variable-ref (cdr entry))))))
+                        (module-map cons header))
+            (lambda (a b)
+              (string<? (symbol->string (car a))
+                        (symbol->string (car b)))))
+           '())))
+
+   ;; --- Lyrics --------------------------------------------------------------
+
+   ;; Silbentext (String oder Markup) als String. Eine Tilde verbindet als
+   ;; Lyric-Bindebogen zwei Woerter auf einer Note und wird zum Leerzeichen.
+   (define (syllable->string text)
+     (let ((s (cond ((string? text) text)
+                    ((markup? text) (markup->string text))
+                    (else ""))))
+       (string-map (lambda (c) (if (char=? c #\~) #\space c)) s)))
+
+   ;; Stanza-Beschriftung, wie sie gedruckt wuerde; vgl. handle-stanza-numbers
+   ;; bzw. refMarkupFormatter/bridgeMarkupFormatter in
+   ;; basic_format_and_style_settings.ily. text ist ein direkt per
+   ;; \set stanza = "..." gesetzter Wert und gewinnt. Mit roman? werden die
+   ;; Nummern roemisch formatiert (\romanStanza, z.B. fremdsprachige
+   ;; Originalstrophen).
+   (define (stanza-label type numbers text roman?)
+     (define (number->label n)
+       (if roman? (format #f "~@r" n) n))
+     (define (joined-numbers)
+       (string-join (map (lambda (n) (ly:format "~a" (number->label n))) numbers)
+                    ", "))
+     (define (formatted plain with-numbers)
+       (if (null? numbers)
+           (ly:parser-lookup plain)
+           (ly:format (ly:parser-lookup with-numbers) (joined-numbers))))
+     (cond
+      (text text)
+      ((eq? type 'ref) (formatted 'refString 'refStringWithNumbers))
+      ((eq? type 'bridge) (formatted 'bridgeString 'bridgeStringWithNumbers))
+      ((pair? numbers)
+       (string-join
+        (map (lambda (n)
+               (format #f (ly:parser-lookup 'stanzaFormat) (number->label n)))
+             numbers)
+        ", "))
+      (else "")))
+
+   ;; Wandelt ein Lyrics-Music-Objekt (eine Zeile aus \addlyrics bzw. das
+   ;; Argument von \chordlyrics) in eine Liste von Eintraegen der Form
+   ;; (marked? nummern . ((stanza . "1.") (type . verse) (text . "Auf die ...")))
+   ;; Silben werden an HyphenEvents wieder zu Woertern zusammengesetzt.
+   ;; Strophengrenzen ergeben sich aus den StanzaNumber-Overrides von
+   ;; #(stanza n), \ref und \bridge sowie aus \set stanza = "...".
+   ;; marked? ist #f fuer Fortsetzungsfragmente: Abschnitte ohne Marker oder
+   ;; mit dem Zeilenumbruch-Marker \set stanza = "-" (right-/leftHyphen).
+   ;; \set stanza mit Markup-Wert (Wiederholungszeichen, "D.S." usw.) ist
+   ;; reine Dekoration mitten im Vers und beginnt keine neue Strophe.
+   (define (lyric-line->stanzas lyrics)
+     (let ((stanzas '())    ; fertige Eintraege, rueckwaerts
+           (words '())      ; fertige Woerter der aktuellen Strophe, rueckwaerts
+           (word "")        ; offene Silbenkette
+           (type #f)        ; 'verse / 'ref / 'bridge
+           (numbers '())    ; Strophennummern
+           (set-label #f)   ; direkt gesetztes \set stanza = "..."
+           (roman #f)       ; \romanStanza: Nummern roemisch formatieren
+           (pending-override #f)  ; \override-stanza vor dem naechsten Marker
+           (override-numbers #f)) ; gedruckte Nummern der aktuellen Strophe
+       (define (flush-word!)
+         (unless (string-null? word)
+           (set! words (cons word words))
+           (set! word "")))
+       (define (flush-stanza!)
+         (flush-word!)
+         (when (or type set-label (pair? words))
+           (let ((display-numbers (or override-numbers numbers)))
+             (set! stanzas
+                   (cons (cons* (if (or type (and set-label (not (string=? set-label "-")))) #t #f)
+                                display-numbers
+                                (list (cons 'stanza (stanza-label type display-numbers set-label roman))
+                                      (cons 'type (or type 'verse))
+                                      (cons 'text (string-join (reverse words) " "))))
+                         stanzas)))
+           (set! words '())
+           (set! type #f)
+           (set! numbers '())
+           (set! set-label #f)
+           (set! override-numbers #f)))
+       ;; Ein neuer Marker beendet die laufende Strophe, sobald schon Text da ist.
+       (define (marker!)
+         (when (or (pair? words) (not (string-null? word)))
+           (flush-stanza!)))
+       (define (handle-lyric-event m)
+         (let ((s (syllable->string (ly:music-property m 'text)))
+               (hyphen? (any (lambda (a)
+                               (eq? (ly:music-property a 'name) 'HyphenEvent))
+                             (ly:music-property m 'articulations '()))))
+           ;; "_"-Skips (Melisma-Platzhalter) kommen als " " an und werden
+           ;; ignoriert; ein an einem Trennstrich offenes Wort ("ru -- _ hig")
+           ;; laeuft darueber weiter.
+           (unless (string-null? (string-trim-both s))
+             (set! word (string-append word s))
+             (unless hyphen? (flush-word!)))))
+       (define (handle-override m)
+         (when (eq? (ly:music-property m 'symbol) 'StanzaNumber)
+           (let ((path (ly:music-property m 'grob-property-path))
+                 (value (ly:music-property m 'grob-value)))
+             (cond
+              ((equal? path '(details custom-stanza-type))
+               (marker!)
+               (set! type value)
+               ;; \override-stanza wirkt (\once) auf den naechsten Marker
+               (set! override-numbers pending-override)
+               (set! pending-override #f))
+              ((equal? path '(details custom-stanza-numbers))
+               (marker!)
+               (set! numbers (if (list? value) value (list value))))
+              ((equal? path '(details custom-stanzanumber-override))
+               (set! pending-override (if (list? value) value (list value))))
+              ((equal? path '(style))
+               (set! roman (eq? value 'roman)))))))
+       (define (handle-set m)
+         (let ((value (ly:music-property m 'value)))
+           ;; Nur String-Werte; Markups (Wiederholungszeichen etc.) sind
+           ;; Dekoration mitten im Vers und keine Strophengrenze.
+           (when (and (eq? (ly:music-property m 'symbol) 'stanza)
+                      (string? value))
+             (marker!)
+             (set! set-label value))))
+       (define (walk m)
+         (case (ly:music-property m 'name)
+           ((LyricEvent) (handle-lyric-event m))
+           ((OverrideProperty) (handle-override m))
+           ((PropertySet) (handle-set m))
+           (else
+            (let ((element (ly:music-property m 'element)))
+              (if (ly:music? element) (walk element))
+              (for-each (lambda (e) (if (ly:music? e) (walk e)))
+                        (ly:music-property m 'elements))))))
+       (walk lyrics)
+       (flush-stanza!)
+       (merge-reprinted (reverse stanzas))))
+
+   ;; Beim Zeilenumbruch im Notenbild wird die Strophennummer manchmal erneut
+   ;; gedruckt (z.B. \firstVerseB #(stanza 1) \firstVerseC). Ein Marker
+   ;; direkt nach einer Strophe mit gleicher Kennung oder deren
+   ;; Nummern-Obermenge (#(stanza 2 3) nach Strophe 2) setzt diese fort,
+   ;; statt eine neue Strophe zu beginnen.
+   (define (merge-reprinted entries)
+     (let loop ((remaining entries) (acc '()))
+       (if (null? remaining)
+           (reverse acc)
+           (let ((entry (car remaining)))
+             (if (and (pair? acc)
+                      (car entry)          ; aktueller Eintrag markiert
+                      (car (car acc))      ; vorheriger Eintrag markiert
+                      (let* ((prev (car acc))
+                             (prev-alist (cddr prev))
+                             (alist (cddr entry))
+                             (prev-numbers (cadr prev))
+                             (prev-label (assq-ref prev-alist 'stanza)))
+                        (or (and (not (string-null? prev-label))
+                                 (string=? prev-label (assq-ref alist 'stanza)))
+                            (and (eq? (assq-ref prev-alist 'type)
+                                      (assq-ref alist 'type))
+                                 (pair? prev-numbers)
+                                 (every (lambda (n) (member n (cadr entry)))
+                                        prev-numbers)))))
+                 (begin
+                   (append-fragment-text! (cddr (car acc)) (cddr entry))
+                   (loop (cdr remaining) acc))
+                 (loop (cdr remaining) (cons entry acc)))))))
+
+   ;; Haengt den Text eines Fortsetzungsfragments an eine Strophe an.
+   (define (append-fragment-text! target fragment)
+     (let ((target-cell (assq 'text target))
+           (fragment-text (assq-ref fragment 'text)))
+       (unless (string-null? fragment-text)
+         (set-cdr! target-cell
+                   (if (string-null? (cdr target-cell))
+                       fragment-text
+                       (string-append (cdr target-cell) " " fragment-text))))))
+
+   ;; Fuegt die Strophen-Eintraege mehrerer Lyric-Zeilen (Ergebnisse von
+   ;; lyric-line->stanzas) zu einer flachen Strophenliste zusammen. Manche
+   ;; Lieder verteilen eine Strophe auf mehrere Zeilen unter den Noten
+   ;; (Fragmente mit \set stanza = "-" bzw. ohne Marker): Fortsetzungen
+   ;; werden innerhalb einer Zeile an die vorhergehende markierte Strophe
+   ;; angehaengt; Zeilen ganz ohne markierte Strophen positionsweise an die
+   ;; markierten Strophen der letzten Zeile, die welche hatte.
+   (define (merge-lyric-lines lines)
+     (let ((result '())        ; fertige Strophen-alists, rueckwaerts
+           (last-marked '()))  ; markierte alists der letzten markierten Zeile
+       (for-each
+        (lambda (line)
+          (let ((line-marked (filter-map (lambda (e) (and (car e) (cddr e))) line)))
+            (if (and (null? line-marked) (pair? last-marked))
+                ;; Zeile nur aus Fortsetzungen: k-tes Fragment an k-te
+                ;; markierte Strophe der Vorzeile, Ueberzaehlige an deren letzte.
+                (let loop ((entries line) (targets last-marked))
+                  (when (pair? entries)
+                    (append-fragment-text! (car targets) (cddar entries))
+                    (loop (cdr entries)
+                          (if (null? (cdr targets)) targets (cdr targets)))))
+                ;; Zeile mit markierten Strophen (oder erste Zeile ueberhaupt):
+                ;; Fortsetzungen an die vorhergehende Strophe der Zeile.
+                (begin
+                  (let loop ((entries line)
+                             (prev (if (pair? last-marked) (last last-marked) #f)))
+                    (when (pair? entries)
+                      (let ((marked? (caar entries))
+                            (stanza-alist (cddar entries)))
+                        (if (or marked? (not prev))
+                            (begin
+                              (set! result (cons stanza-alist result))
+                              (loop (cdr entries) stanza-alist))
+                            (begin
+                              (append-fragment-text! prev stanza-alist)
+                              (loop (cdr entries) prev))))))
+                  (when (pair? line-marked)
+                    (set! last-marked line-marked))))))
+        lines)
+       (reverse result)))
+
+   ;; Gruppiert alle LyricCombineMusic-Objekte im music-Baum nach ihrer
+   ;; Stimme (associated-context, das \addlyrics/\lyricsto zuweisen).
+   ;; Liefert eine Liste von Gruppen (je eine Liste von Lyrics-Music-
+   ;; Objekten) in der Reihenfolge, in der die Stimmen zuerst auftauchen.
+   (define (voice-groups music)
+     (let* ((combines (extract-named-music music 'LyricCombineMusic))
+            (contexts (delete-duplicates
+                       (map (lambda (c) (ly:music-property c 'associated-context))
+                            combines))))
+       (map (lambda (ctx)
+              (map (lambda (c) (ly:music-property c 'element))
+                   (filter (lambda (c)
+                             (equal? (ly:music-property c 'associated-context) ctx))
+                           combines)))
+            contexts)))
+
+   ;; Liefert die Strophen aller Stimmen unter den Noten, die selbst echte
+   ;; Strophen/Refrains/Bridges tragen (mindestens einen markierten
+   ;; Abschnitt haben, vgl. lyric-line->stanzas) -- filtert damit rein
+   ;; dekorative Gegen- oder Echostimmen heraus (z.B. wiederholte
+   ;; Lautmalerei ohne eigene Strophennummer). "Die erste Stimme im
+   ;; Dokument" ist dafuer kein verlaessliches Kriterium: welche Stimme
+   ;; die Hauptmelodie mit dem vollstaendigen Strophentext singt, wechselt
+   ;; von Lied zu Lied (mal Stimme 1, mal 2, je nach Satz).
+   ;; Qualifizierende Stimmen werden zusammengefuehrt (verschiedene
+   ;; Sprachfassungen tragen z.B. beide eigene Strophen); dabei bildet die
+   ;; Stimme mit den meisten eigenen Strophen ('verse, nicht Ref/Bridge)
+   ;; das Rueckgrat, in das die anderen einsortiert werden -- sonst wuerde
+   ;; ein von mehreren Stimmen gemeinsam gesungener Refrain, der im
+   ;; Dokument vor der eigentlichen Strophe auftaucht, deren Platz vor der
+   ;; Strophe 1 belegen.
+   (define (main-voice-lyrics music)
+     (define (verse-count stanzas)
+       (count (lambda (e) (eq? (assq-ref e 'type) 'verse)) stanzas))
+     (define (any-marked? lines) (any (lambda (line) (any car line)) lines))
+     (let* ((groups (map (lambda (group) (map lyric-line->stanzas group))
+                         (voice-groups music)))
+            (with-marks (filter any-marked? groups))
+            ;; Der Ausschluss unmarkierter Stimmen lohnt nur, wenn es
+            ;; ueberhaupt eine ALTERNATIVE gibt: hat KEINE Stimme einen
+            ;; echten Strophenmarker, gibt es kein "Rueckgrat" zum
+            ;; Einsortieren -- dann wie frueher nur die erste Stimme nehmen
+            ;; (sonst wuerden z.B. mehrere Satzstimmen mit identischem,
+            ;; unmarkiertem Text ihren Kehrreim mehrfach liefern, weil sich
+            ;; unmarkierte Eintraege ohne Strophennummer nicht als Duplikat
+            ;; erkennen lassen). Nur EINE Stimme insgesamt ist ein
+            ;; Sonderfall davon (erste = einzige).
+            (qualifying (cond
+                         ((pair? with-marks) with-marks)
+                         ((pair? groups) (list (car groups)))
+                         (else '())))
+            (merged-per-group (map merge-lyric-lines qualifying))
+            (ranked (sort (iota (length merged-per-group))
+                          (lambda (a b) (> (verse-count (list-ref merged-per-group a))
+                                           (verse-count (list-ref merged-per-group b)))))))
+       (fold (lambda (i acc) (add-missing-stanzas acc (list-ref merged-per-group i)))
+             '() ranked)))
+
+   ;; --- Textseiten-Strophen aus dem Render-Collector ------------------------
+
+   ;; Liest die Strophen der Textseiten aus dem per-Song-Store (chordpro.ily),
+   ;; den der ChordPro_score_collector beim Rendern der \chordlyrics-Scores
+   ;; fuellt. Dort ist Tag-Filterung, \override-stanza usw. bereits von
+   ;; LilyPond selbst entschieden -- unsichtbare Verse tauchen gar nicht
+   ;; erst auf. Die Dokumentreihenfolge liefert
+   ;; chordpro-song-ordered-verse-indices (die Interpretation laeuft
+   ;; rueckwaerts und bei mehrspaltigen group-verses verschraenkt).
+   ;; Liefert Eintraege wie lyric-line->stanzas:
+   ;; ((stanza . "2.") (type . verse) (text . "Die Haeuser ..."))
+   (define (collector-song->stanzas song)
+     ;; Silben eines Verses in Sammelreihenfolge; Eintrag: (moment text hyphen? idx)
+     (define (verse-syllables idx)
+       (reverse (filter (lambda (s) (= (cadddr s) idx))
+                        (chordpro-song-syllables song))))
+     ;; Gedruckte Labels koennen Wiederholungszeichen tragen ("2.𝄆") --
+     ;; die gehoeren nicht ins Label.
+     (define (clean-label s)
+       (string-trim-both
+        (string-delete (lambda (c) (memv c '(#\𝄆 #\𝄇))) s)))
+     ;; Silben zu Woertern: Trennstriche verbinden, "_"-Extender (kommen als
+     ;; Whitespace an) werden ueberlaufen, ohne das offene Wort zu schliessen.
+     (define (syllables->text syls)
+       (let loop ((rest syls) (word "") (words '()))
+         (if (null? rest)
+             (string-join
+              (reverse (if (string-null? word) words (cons word words)))
+              " ")
+             (let* ((s (syllable->string (cadr (car rest))))
+                    (hyphen? (caddr (car rest))))
+               (if (string-null? (string-trim-both s))
+                   (loop (cdr rest) word words)
+                   (if hyphen?
+                       (loop (cdr rest) (string-append word s) words)
+                       (loop (cdr rest) ""
+                             (cons (string-append word s) words))))))))
+     (filter-map
+      (lambda (idx)
+        (let ((syls (verse-syllables idx))
+              (entry (assoc idx (chordpro-song-stanza-numbers song))))
+          (and (pair? syls)
+               (list (cons 'stanza (clean-label
+                                    (or (and entry (cadr entry)) "")))
+                     (cons 'type (or (and entry (caddr entry)) 'verse))
+                     (cons 'text (syllables->text syls))))))
+      (chordpro-song-ordered-verse-indices song)))
+
+   ;; Dieselbe Strophe? Gleiche Kennung allein reicht nicht: zweisprachige
+   ;; Lieder nutzen dieselben Nummern fuer Uebersetzung und Original. Die
+   ;; Texte muessen sich auch aehneln (mindestens die Haelfte der Woerter
+   ;; der kuerzeren Fassung kommt in der laengeren vor).
+   (define (same-stanza-text? a b)
+     (define (word-list s)
+       (map string-downcase (string-tokenize s char-set:letter)))
+     (let* ((wa (word-list a))
+            (wb (word-list b))
+            (shorter (if (<= (length wa) (length wb)) wa wb))
+            (longer  (if (<= (length wa) (length wb)) wb wa)))
+       (or (null? shorter)
+           (>= (count (lambda (w) (member w longer)) shorter)
+               (/ (length shorter) 2)))))
+
+   ;; Wie merge-stanza-lists, aber bei Konflikt gewinnt BASE statt der
+   ;; einzumischenden Liste: fuer das Zusammenfuehren mehrerer Hauptstimmen-
+   ;; Kandidaten (main-voice-lyrics), wo die 'reichste' Stimme (meiste
+   ;; eigene Strophen) die kanonische Fassung liefert und andere Stimmen
+   ;; nur FEHLENDE Strophen ergaenzen duerfen -- z.B. wenn Sopran und Alt
+   ;; beide "1." tragen, der Alt aber eine gekuerzte Textvariante singt
+   ;; (vgl. Sieh_des_Herbstes_Geisteshelle: infotext "Strophenteile in
+   ;; Klammern sind die Textvarianten im Alt").
+   (define (add-missing-stanzas base additional)
+     (fold
+      (lambda (entry acc)
+        (let* ((key (assq-ref entry 'stanza))
+               (found (and (not (string-null? key))
+                          (not (string=? key "-"))
+                          (find (lambda (e) (and (equal? (assq-ref e 'stanza) key)
+                                                 (same-stanza-text?
+                                                  (assq-ref e 'text)
+                                                  (assq-ref entry 'text))))
+                                acc))))
+          (if found acc (append acc (list entry)))))
+      base
+      additional))
+
+   ;; Fuegt Musik- und Textseiten-Strophen zusammen: gleiche Strophen nur
+   ;; einmal, wobei die Fassung aus den Textseiten die unter den Noten
+   ;; ersetzt (dort steht meist die vollstaendige Fassung).
+   (define (merge-stanza-lists music-stanzas text-stanzas)
+     (let loop ((merged music-stanzas) (remaining text-stanzas))
+       (if (null? remaining)
+           merged
+           (let* ((entry (car remaining))
+                  (key (assq-ref entry 'stanza))
+                  (found (and (not (string-null? key))
+                              (not (string=? key "-"))
+                              (find (lambda (e)
+                                      (and (equal? (assq-ref e 'stanza) key)
+                                           (same-stanza-text?
+                                            (assq-ref e 'text)
+                                            (assq-ref entry 'text))))
+                                    merged))))
+             (loop (if found
+                       (map (lambda (e) (if (eq? e found) entry e)) merged)
+                       (append merged (list entry)))
+                   (cdr remaining))))))
+
+   ;; Extrahiert alle Strophen/Refrain/Bridge-Texte eines Liedes: die Strophen
+   ;; unter den Noten aus music (die Hauptstimme(n), siehe main-voice-lyrics),
+   ;; die Textstrophen aus dem Render-Collector-Store des Liedes (song, darf
+   ;; #f sein).
+   (define (extract-lyrics music song)
+     (merge-stanza-lists
+      (main-voice-lyrics music)
+      (if song (collector-song->stanzas song) '())))
+
+   ;; --- Hauptfunktion -----------------------------------------------------
+
+   ;; Liefert das erste Music-Objekt mit gegebenem Namen (oder #f).
+   (define (first-named-music music music-name)
+     (let ((matches (extract-named-music music music-name)))
+       (and (pair? matches) (car matches))))
+
+   ;; Nimmt ly:music entgegen und liefert eine alist mit String-Werten.
+   (define (music->data-alist music)
+     (let* ((time-m  (first-named-music
+                      music '(TimeSignatureMusic ReferenceTimeSignatureMusic)))
+            (key-m   (first-named-music music 'KeyChangeEvent))
+            (tempo-m (first-named-music music 'TempoChangeEvent))
+            (time-s  (and time-m  (time-music->string time-m)))
+            (key-s   (and key-m   (key-music->string key-m)))
+            (tempo-s (and tempo-m (tempo-music->string tempo-m))))
+       (append
+        (if time-s  (list (cons 'time time-s)) '())
+        (if key-s   (list (cons 'key key-s)) '())
+        (if tempo-s (list (cons 'tempo tempo-s)) '()))))
+
+    ;; song ist der per-Song-Store-Eintrag aus chordpro.ily (oder #f, wenn
+    ;; keine Textseiten gerendert wurden) -- er liefert die Textseiten-
+    ;; Strophen. Darf erst NACH dem Rendern der Textseiten aufgerufen
+    ;; werden (delayed stencil), vorher ist der Store leer. song-id ist
+    ;; der Liedname (Einzellied: Ausgabename; Buch: der bei \includeSong
+    ;; angegebene Dateiname) und landet unter dem Key song_id.
+    (define (extract-song-data header music song song-id)
+      (let ((header-alist (bookpart->header-alist header))
+            (music-alist (music->data-alist music))
+            (lyrics-list (extract-lyrics music song)))
+        (append header-alist
+                (list (cons 'song_id song-id)
+                      (cons 'musical music-alist)
+                      (cons 'lyrics lyrics-list)))))
+
+    ;; Unsichtbarer Stencil fuer die Einzellied-YAML: schreibt <key>.yml
+    ;; per delay-stencil-evaluation erst bei der Ausgabe, wenn der
+    ;; Render-Collector alle Textseiten-Strophen gesammelt hat. header und
+    ;; music werden beim Anhaengen (Parse-Zeit in layout_bottom) gebunden.
+    (define (yaml-delayed-song-write key header music)
+      (ly:make-stencil
+       `(delay-stencil-evaluation
+         ,(delay (begin
+                   (scm->yml-file (string-append key ".yml")
+                                  (extract-song-data header music
+                                                     (hash-ref chordpro-song-store key)
+                                                     key))
+                   empty-stencil))))))

private_includes/base/default_songinfo_style.ily

@@ -0,0 +1,190 @@
+\paper {
+  poetPrefix = "Worte:"
+  composerPrefix = "Weise:"
+  compositionPrefix = "Satz:"
+  adaptionTextPrefix = "Bearbeitung:"
+  adaptionMusicPrefix = "Bearbeitung:"
+  poetAndComposerEqualPrefix = "Worte und Weise:"
+  voicePrefix = "Stimme:"
+  versePrefix = "Strophe:"
+  refPrefix = "Refrain:"
+  translationAuthorPrefix = "Übersetzung:"
+  translationPrefix = "Übersetzung:"
+  pronunciationPrefix = "Aussprache:"
+  interludePrefix = "Zwischenspiel:"
+  bridgePrefix = "Bridge:"
+  author-joiner = #(lambda (author-list) (string-join author-list ", "))
+
+  authorFormat =
+    #(lambda (noDetails name trail_name birth_year death_year organization)
+        (let ((string-present (lambda (str) (and str (not (and (string? str) (string-null? str))))))
+              (render_informations (lambda (infolist) (string-append (car infolist) (if (or noDetails (null? (cdr infolist))) "" (string-append " (" (string-join (cdr infolist) ", ") ")"))))))
+            (if (or (string-present trail_name) (string-present name))
+              (render_informations (filter string-present (list
+                trail_name
+                name
+                (if (and (string-present birth_year) (string-present death_year))
+                  (ly:format "~a‒~a" birth_year death_year)
+                  (if (string-present birth_year)
+                    (ly:format "*~a" birth_year)
+                    (if (string-present death_year) (ly:format "†~a" death_year) "")))
+                organization
+              )))
+              ""
+          )))
+
+  authorContributionFormat =
+    #(lambda* (render-contribution-group render-partial-contribution-group #:key
+        (poetIds '())
+        (translatorIds '())
+        (versePoetData '())
+        (composerIds '())
+        (verseComposerData '())
+        (refComposerIds '())
+        (voiceComposerData '())
+        (compositionIds '())
+        (adaptionTextIds '())
+        (adaptionMusicIds '())
+        (bridgeIds '())
+        (interludeIds '())
+        (year_text #f)
+        (year_translation #f)
+        (year_melody #f)
+        (year_melody_meloref #f)
+        (year_composition #f)
+        (year_adaption_text #f)
+        (year_adaption_music #f)
+        (poetAndComposerEqualPrefix "")
+        (poetPrefix "")
+        (composerPrefix "")
+        (translationAuthorPrefix "")
+        (pronunciationPrefix "")
+        (compositionPrefix "")
+        (adaptionTextPrefix "")
+        (adaptionMusicPrefix "")
+        (bridgePrefix "")
+        (interludePrefix "")
+        (refPrefix ""))
+      (if (and
+            (equal? poetIds composerIds)
+            (null? translatorIds)
+            (null? versePoetData)
+            (null? verseComposerData)
+            (null? refComposerIds)
+            (null? voiceComposerData)
+            (null? compositionIds)
+            (null? adaptionTextIds)
+            (null? adaptionMusicIds)
+            (null? bridgeIds)
+            (null? interludeIds))
+        (list
+          (join-present (list
+            (render-contribution-group poetAndComposerEqualPrefix poetIds)
+            (if (equal? year_text year_melody) year_text (join-present (list year_text year_melody) "/"))
+          ) ", ")
+          #f)
+        (list
+          (if (and (null? poetIds) (null? versePoetData) (null? translatorIds)) #f
+            (string-append
+              poetPrefix
+              " "
+              (join-present (list
+                (join-present (list
+                  (render-contribution-group "" poetIds)
+                  year_text
+                ) ", ")
+                (render-partial-contribution-group 'versePrefix versePoetData)
+                (join-present (list
+                  (render-contribution-group adaptionTextPrefix adaptionTextIds)
+                  year_adaption_text
+                ) ", ")
+                (join-present (list
+                  (render-contribution-group translationAuthorPrefix translatorIds)
+                  year_translation
+                ) ", ")
+              ) "; ")
+            ))
+          (if (and
+                (null? composerIds)
+                (null? compositionIds)
+                (null? adaptionMusicIds)
+                (null? verseComposerData)
+                (null? refComposerIds)
+                (null? voiceComposerData)
+                (null? bridgeIds)
+                (null? interludeIds)) #f
+            (string-append
+              composerPrefix
+              " "
+              (join-present (list
+                (join-present (list
+                  (render-contribution-group "" composerIds)
+                  year_melody
+                ) ", ")
+                (render-partial-contribution-group 'versePrefix verseComposerData)
+                (join-present (list
+                  (render-contribution-group refPrefix refComposerIds)
+                  year_melody_meloref
+                ) ", ")
+                (render-partial-contribution-group 'voicePrefix voiceComposerData)
+                (join-present (list
+                  (render-contribution-group compositionPrefix compositionIds)
+                  year_composition
+                ) ", ")
+                (join-present (list
+                  (render-contribution-group adaptionMusicPrefix adaptionMusicIds)
+                  year_adaption_music
+                ) ", ")
+                (render-contribution-group bridgePrefix bridgeIds)
+                (render-contribution-group interludePrefix interludeIds)
+              ) "; ")
+            )))))
+
+
+  songinfoMarkup =
+    #(make-on-the-fly-markup
+      (lambda (layout props m)
+        (let* ((between-poet-and-composer-markup (chain-assoc-get 'header:between-poet-and-composer-markup props (make-hspace-markup 3)))
+              (poet-maybe-with-composer (chain-assoc-get 'songinfo:poet-maybe-with-composer props #f))
+              (composer (chain-assoc-get 'songinfo:composer props #f))
+              (copyright (chain-assoc-get 'songinfo:copyright props #f))
+              (infotext (chain-assoc-get 'songinfo:infotext props #f))
+              (translation (chain-assoc-get 'songinfo:translation props #f))
+              (pronunciation (chain-assoc-get 'songinfo:pronunciation props #f))
+              (year_text (chain-assoc-get 'songinfo:year_text props #f))
+              (year_melody (chain-assoc-get 'songinfo:year_melody props #f))
+              (poet-with-year (if (and poet-maybe-with-composer year_text) (string-append poet-maybe-with-composer ", " year_text) poet-maybe-with-composer))
+              (composer-with-year (if (and composer year_melody) (string-append composer ", " year_melody) composer))
+              (concat-markupped-strings (lambda (text)
+                (ly:regex-replace (ly:make-regex "(\\S+)(\\\\\\w+(?:\\s+\\[^\\{\\s]*|\\s*\\{[^\\}]*\\}))(\\S*)") text "\\concat {" 1 "\\line {" 2 "}" 3 "}")))
+              (string-with-paragraphs->markuplist (lambda (prefix text)
+                (if text
+                  (apply append
+                    (map
+                      (lambda (paragraph)
+                        (make-wordwrap-internal-markup-list #t
+                          #{ \markuplist { $(ly:parser-include-string (concat-markupped-strings paragraph)) } #}))
+                      (ly:regex-split (ly:make-regex "\r?\n[ \t\r\n]*\n[ \t\r\n]*") (string-append prefix text))))
+                  '())))
+              (poet-and-composer-markup-list
+                (string-with-paragraphs->markuplist "" (string-append
+                  (if poet-with-year (string-append "\n\n" poet-with-year) "")
+                  (if composer-with-year (string-append "\n\n" composer-with-year) "")
+                )))
+              (poet-and-composer-oneliner (if (and poet-with-year composer-with-year) (make-line-markup (cons (cadr poet-and-composer-markup-list) (cons between-poet-and-composer-markup (cddr poet-and-composer-markup-list)))) #f))
+              (current-line-width (chain-assoc-get 'line-width props (ly:output-def-lookup layout 'line-width))))
+          (stack-lines DOWN 0.0 (chain-assoc-get 'baseline-skip props)
+            (interpret-markup-list layout props
+              (append
+                (if (and poet-and-composer-oneliner (< (interval-length (ly:stencil-extent (interpret-markup layout props poet-and-composer-oneliner) X)) current-line-width))
+                  (list poet-and-composer-oneliner)
+                  poet-and-composer-markup-list)
+                (string-with-paragraphs->markuplist "" (string-append
+                  (if copyright (string-append "\n\n© " copyright) "")))
+                (string-with-paragraphs->markuplist "" infotext)
+                (string-with-paragraphs->markuplist (string-append (ly:output-def-lookup layout 'translationPrefix) " ") translation)
+                (string-with-paragraphs->markuplist (string-append (ly:output-def-lookup layout 'pronunciationPrefix) " ") pronunciation)
+                  )))))
+      (make-null-markup)
+    )
+}

private_includes/base/default_style.ily

@@ -3,9 +3,9 @@ songMargin = 5
 songInfoFontSize = 0
 songInfoLineWidthFraction = 0.9
 songTitleSize = 6
-songTitleFont = "LilyPond Sans"
+songTitleFont = "Liberation Sans"
-songChordFont = "LilyPond Sans"
+songChordFont = "Liberation Sans"
-songLyricFont = "LilyPond Sans"
+songLyricFont = "Liberation Sans"
 songChordFontSeries = #'bold
 songTextChordAlignment = #'left
 songScoreChordFontSize = 2
@@ -16,9 +16,21 @@ songTocColumns = 3
 globalSize = 15
 lyricSize = 1.6
 stanzaFormat = "~a."
-romanStanzaFormat = "~@r."
 refString = "Ref.:"
 refStringWithNumbers = "Ref. ~a:"
+bridgeString = "Bridge:"
+bridgeStringWithNumbers = "Bridge ~a:"
 % hübsche Wiederholungszeichen für den Liedtext
 repStart = "𝄆"
 repStop = "𝄇"
+customChordPrintings = {}
+
+\paper {
+  cueMarkup = \markup {
+    \italic
+      #(make-on-the-fly-markup (lambda (layout props m)
+        (interpret-markup layout props
+          (string-join (map (lambda (n) (format #f "~@r." n)) (chain-assoc-get 'cues props)) ", ")))
+        (make-null-markup))
+  }
+}

private_includes/base/eps_file_from_song_dir.ily

@@ -0,0 +1,28 @@
+% songfilename auch im Markup verfügbar machen
+#(define-markup-list-command (setsongfilename layout props songfilename markuplist)
+  (string? markup-list?)
+  (interpret-markup-list layout (prepend-alist-chain 'songfilename songfilename props) markuplist))
+
+#(define-markup-command (customEps layout props ysize filename)(number? string?)
+   #:properties ((songfilename ""))
+   (interpret-markup layout props
+     (let* ((defaulttitlemarkup (ly:output-def-lookup layout 'defaultTitleMarkup))
+            ;; Determine the song directory to resolve the EPS relative to.
+            ;; In TEXT the name arrives via the markup props (\setsongfilename),
+            ;; but inside MUSIC (e.g. \mark) the props do not carry it, so we
+            ;; fall back to the value stored in the score's \layout block.
+            (layout-songfilename (ly:output-def-lookup layout 'songfilename #f))
+            (songdir (cond ((not (string-null? songfilename)) songfilename)
+                           ((and (string? layout-songfilename)
+                                 (not (string-null? layout-songfilename)))
+                            layout-songfilename)
+                           (else #f)))
+            (filepath (if songdir
+                          (ly:format "~a/~a/~a" songPath songdir filename)
+                          filename)))
+       (if (file-exists? filepath)
+             (make-epsfile-markup Y ysize filepath)
+             (if defaulttitlemarkup
+                 defaulttitlemarkup
+                 (ly:format "file does not exist ~a" filepath))
+))))

private_includes/base/footer_with_songinfo.ily

@@ -10,7 +10,9 @@
         (assoc-ref author "death_year")
         (assoc-ref author "organization")
       )
-      "unbekannt")))
+      (if (string-null? authorId)
+          "unbekannt"
+          authorId))))
 
 #(define (find-author-ids-by contributionType authors)
   (if authors
@@ -19,13 +21,18 @@
 
 #(define (find-author-id-with-part-numbers contributionType authors)
   (if authors
+    (sort-list
       (filter-map (lambda (authordata)
         (let ((contributionNumbers (filter-map (lambda (contribution) (if (and (list? contribution) (equal? contributionType (car contribution))) (cadr contribution) #f)) (cdr authordata)))
               (authorId (car authordata)))
-        (if (null? contributionNumbers) #f (cons authorId contributionNumbers))
+          (if (null? contributionNumbers) #f (cons authorId (sort-list contributionNumbers <)))
         )) authors)
+      (lambda (a b) (< (cadr a) (cadr b))))
     (list)))
 
+#(define (join-present 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) ()
   (define (songinfo-from songId key)
     (let ((song (if (defined? 'SONG_DATA) (assoc-ref SONG_DATA songId) #f)))
@@ -70,7 +77,7 @@
   (define (render-contribution-group contributionPrefix authorIds)
     (if (null? authorIds)
       ""
-      (string-append contributionPrefix " " (string-join (format-authors authorIds) ", ")))
+      (string-append contributionPrefix " " ((ly:output-def-lookup layout 'author-joiner) (format-authors authorIds))))
   )
 
   (define (render-partial-contribution-group prefixLookup authorData)
@@ -79,77 +86,46 @@
       (let ((firstAuthorContributions (cdar authorData)))
         (receive (authorDataSame authorDataOther)
             (partition (lambda (authorEntry) (equal? (cdr authorEntry) firstAuthorContributions)) authorData)
-          (string-append
+          (join-present (list
             (render-contribution-group (numbered-contribution-prefix firstAuthorContributions prefixLookup) (map car authorDataSame))
-            " "
             (render-partial-contribution-group prefixLookup authorDataOther)
-          ))))
+            ) " ")))))
-  )
-
-  (define (join-present items joiner)
-    (string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner)
-  )
 
   (define (poet-and-composer-from-authors authors)
     (if authors
-      (let (
+      ((ly:output-def-lookup layout 'authorContributionFormat)
-            (poetIds (find-author-ids-by 'text authors))
+        render-contribution-group
-            (translatorIds (find-author-ids-by 'translation authors))
+        render-partial-contribution-group
-            (versePoetData (find-author-id-with-part-numbers 'verse authors))
+        #:poetIds (find-author-ids-by 'text authors)
-            (composerIds (find-author-ids-by 'melody authors))
+        #:translatorIds (find-author-ids-by 'translation authors)
-            (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
+        #:versePoetData (find-author-id-with-part-numbers 'verse authors)
-            (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
+        #:composerIds (find-author-ids-by 'melody authors)
-            (compositionIds (find-author-ids-by 'composition authors))
+        #:verseComposerData (find-author-id-with-part-numbers 'meloverse authors)
-            (bridgeIds (find-author-ids-by 'bridge authors))
+        #:refComposerIds (find-author-ids-by 'meloref authors)
-            (interludeIds (find-author-ids-by 'interlude authors))
+        #:voiceComposerData (find-author-id-with-part-numbers 'voice authors)
-            (year_text (chain-assoc-get 'header:year_text props #f))
+        #:compositionIds (find-author-ids-by 'composition authors)
-            (year_translation (chain-assoc-get 'header:year_translation props #f))
+        #:adaptionTextIds (find-author-ids-by 'adaption_text authors)
-            (year_melody (chain-assoc-get 'header:year_melody props #f))
+        #:adaptionMusicIds (find-author-ids-by 'adaption_music authors)
-            (year_composition (chain-assoc-get 'header:year_composition props #f))
+        #:bridgeIds (find-author-ids-by 'bridge authors)
-            )
+        #:interludeIds (find-author-ids-by 'interlude authors)
-        (if (and (equal? poetIds composerIds) (null? translatorIds) (null? versePoetData) (null? verseComposerData) (null? voiceComposerData) (null? compositionIds) (null? bridgeIds) (null? interludeIds))
+        #:year_text (chain-assoc-get 'header:year_text props #f)
-          (list
+        #:year_translation (chain-assoc-get 'header:year_translation props #f)
-            (join-present (list
+        #:year_melody (chain-assoc-get 'header:year_melody props #f)
-              (render-contribution-group (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) poetIds)
+        #:year_melody_meloref (chain-assoc-get 'header:year_melody_meloref props #f)
-              (if (equal? year_text year_melody) year_text (join-present (list year_text year_melody) "/"))
+        #:year_composition (chain-assoc-get 'header:year_composition props #f)
-            ) ", ")
+        #:year_adaption_text (chain-assoc-get 'header:year_adaption_text props #f)
-            #f)
+        #:year_adaption_music (chain-assoc-get 'header:year_adaption_music props #f)
-          (list
+        #:poetAndComposerEqualPrefix (ly:output-def-lookup layout 'poetAndComposerEqualPrefix)
-            (if (and (null? poetIds) (null? versePoetData) (null? translatorIds)) #f
+        #:poetPrefix (ly:output-def-lookup layout 'poetPrefix)
-              (string-append
+        #:composerPrefix (ly:output-def-lookup layout 'composerPrefix)
-                (ly:output-def-lookup layout 'poetPrefix)
+        #:translationAuthorPrefix (ly:output-def-lookup layout 'translationAuthorPrefix)
-                " "
+        #:pronunciationPrefix (ly:output-def-lookup layout 'pronunciationPrefix)
-                (join-present (list
+        #:compositionPrefix (ly:output-def-lookup layout 'compositionPrefix)
-                  (join-present (list
+        #:adaptionTextPrefix (ly:output-def-lookup layout 'adaptionTextPrefix)
-                    (render-contribution-group "" poetIds)
+        #:adaptionMusicPrefix (ly:output-def-lookup layout 'adaptionMusicPrefix)
-                    year_text
+        #:bridgePrefix (ly:output-def-lookup layout 'bridgePrefix)
-                  ) ", ")
+        #:interludePrefix (ly:output-def-lookup layout 'interludePrefix)
-                  (render-partial-contribution-group 'versePrefix versePoetData)
+        #:refPrefix (ly:output-def-lookup layout 'refPrefix))
-                  (join-present (list
-                    (render-contribution-group (ly:output-def-lookup layout 'translationPrefix) translatorIds)
-                    year_translation
-                  ) ", ")
-                ) "; ")
-              ))
-            (if (and (null? composerIds) (null? compositionIds) (null? verseComposerData) (null? voiceComposerData) (null? bridgeIds) (null? interludeIds)) #f
-              (string-append
-                (ly:output-def-lookup layout 'composerPrefix)
-                " "
-                (join-present (list
-                  (join-present (list
-                    (render-contribution-group "" composerIds)
-                    year_melody
-                  ) ", ")
-                  (render-partial-contribution-group 'versePrefix verseComposerData)
-                  (render-partial-contribution-group 'voicePrefix voiceComposerData)
-                  (join-present (list
-                    (render-contribution-group (ly:output-def-lookup layout 'compositionPrefix) compositionIds)
-                    year_composition
-                  ) ", ")
-                  (render-contribution-group (ly:output-def-lookup layout 'bridgePrefix) bridgeIds)
-                  (render-contribution-group (ly:output-def-lookup layout 'interludePrefix) interludeIds)
-                ) "; ")
-              )))))
       (list #f #f)
     )
   )
@@ -169,7 +145,7 @@
             (translation (chain-assoc-get 'header:translation props #f))
             (pronunciation (chain-assoc-get 'header:pronunciation props #f))
             (year_text (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_text props #f)))
-            (year_melody (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f))))
+            (year_melody (if (string? (cadr poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f))))
             (markup
               #:override (cons 'songinfo:poet-maybe-with-composer
                 (if (and poet-maybe-with-composer (not (and (string? poet-maybe-with-composer) (string-null? poet-maybe-with-composer)))) poet-maybe-with-composer #f))
@@ -211,13 +187,23 @@
       `(line-width . ,(* (chain-assoc-get 'header:songinfo-size-factor props songInfoLineWidthFraction) (ly:output-def-lookup layout 'line-width)))
       arg)))
 
+#(define pdf-encode (@@ (lily framework-ps) pdf-encode))
+% PDF tags
+#(define-markup-command (page-number-to-pdf-label layout props) ()
+     (ly:make-stencil
+      (list 'embedded-ps
+             (ly:format
+              "[ /Label (~a) /PAGELABEL pdfmark\n" (pdf-encode (chain-assoc-get 'page:page-number-string props "?"))))
+      empty-interval empty-interval
+      ))
+
 \paper {
   print-first-page-number = ##t
   first-page-number = #0
 
   oddFooterMarkup = \markup {
     \fill-line {
-      \line { \null }
+      \line { \page-number-to-pdf-label \null }
       \line { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo }
       \line { \if \should-print-page-number \print-pagenumber }
     }
@@ -226,7 +212,7 @@
     \fill-line {
       \line { \if \should-print-page-number \print-pagenumber }
       \line { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo }
-      \line { \null }
+      \line { \page-number-to-pdf-label \null }
     }
   }
 }

private_includes/base/include_from_song.ily

@@ -0,0 +1,15 @@
+includeFromSong =
+#(define-void-function (filename) (string?)
+  (let ((noDefaultOutputBackup noDefaultOutput))
+    (set! noDefaultOutput #t)
+    (ly:parser-parse-string (ly:parser-clone)
+      (ly:format "\\include \"~a\""
+      (string-append
+        (dirname (dirname (dirname (dirname (current-filename)))))
+        file-name-separator-string
+        "lilypond-song-includes"
+        file-name-separator-string
+        "liedbausteine"
+        file-name-separator-string
+        filename)))
+    (set! noDefaultOutput noDefaultOutputBackup)))

private_includes/base/inline_score.ily

@@ -6,3 +6,8 @@ inline-score =
     #{
       \transposable #TRANSPOSITION #music
     #})
+
+fill-midi =
+#(define-void-function (music) (ly:music?)
+   (set! INLINESCOREMUSIC #{ \INLINESCOREMUSIC #music #})
+)

private_includes/base/markup_tag_groups_hack.ily

@@ -0,0 +1,16 @@
+% We have to record the tag groups for markup, so we use the right tag groups during markup interpretiton.
+recordedTagGroups = #'()
+
+tagGroup =
+#(define-void-function (tags) (symbol-list?)
+   (let ((err (define-tag-group tags)))
+     (if err (ly:parser-error err (*location*))
+         (set! recordedTagGroups (cons tags recordedTagGroups)))))
+
+#(define-markup-command (handle-tag-groups layout props recorded-groups m) (list? markup?)
+   (resetTagGroups)
+   (for-each
+     (lambda (group)
+       (define-tag-group group))
+     recorded-groups)
+   (interpret-markup layout props m))

private_includes/base/merge_rests_engraver_override.ily

@@ -0,0 +1,86 @@
+Better_Merge_rests_engraver =
+#(lambda (context)
+  (define (has-one-or-less? lst) (or (null? lst) (null? (cdr lst))))
+  (define (has-at-least-two? lst) (not (has-one-or-less? lst)))
+  (define (all-equal? lst pred)
+    (or (has-one-or-less? lst)
+        (and (pred (car lst) (cadr lst)) (all-equal? (cdr lst) pred))))
+  (define (measure-count-eqv? a b)
+    (eqv?
+     (ly:grob-property a 'measure-count)
+     (ly:grob-property b 'measure-count)))
+
+  (define (rests-all-unpitched? rests)
+    "Returns true when all rests do not override the staff-position grob
+    property. When a rest has a position set we do not want to merge rests at
+    that position."
+    (every (lambda (rest) (null? (ly:grob-property rest 'staff-position))) rests))
+
+  (define (less-by-layer a b)
+    (<
+      (ly:grob-property b 'layer 0)
+      (ly:grob-property a 'layer 0)))
+
+  (define (merge-mmrests mmrests)
+    "Move all multimeasure rests to the single voice location."
+    (if (all-equal? mmrests measure-count-eqv?)
+        (begin
+          (for-each
+           (lambda (rest) (ly:grob-set-property! rest 'direction CENTER))
+           mmrests)
+          (for-each
+           (lambda (rest) (ly:grob-set-property! rest 'transparent #t))
+           (cdr (sort mmrests less-by-layer))))))
+
+  (define (merge-rests rests)
+    (for-each
+     (lambda (rest) (ly:grob-set-property! rest 'staff-position 0))
+     rests)
+    (for-each
+     (lambda (rest) (ly:grob-set-property! rest 'transparent #t))
+     (cdr (sort rests less-by-layer))))
+
+  (let ((mmrests '())
+        (rests '())
+        (dots '()))
+    (make-engraver
+     ((start-translation-timestep translator)
+      (set! rests '())
+      (set! mmrests '())
+      (set! dots '()))
+     (acknowledgers
+      ((dot-column-interface engraver grob source-engraver)
+       (if (not (ly:context-property context 'suspendRestMerging #f))
+           (set!
+            dots
+            (append (ly:grob-array->list (ly:grob-object grob 'dots))
+                    dots))))
+      ((rest-interface engraver grob source-engraver)
+       (cond
+        ((ly:context-property context 'suspendRestMerging #f)
+         #f)
+        ((grob::has-interface grob 'multi-measure-rest-interface)
+         (set! mmrests (cons grob mmrests)))
+        (else
+         (set! rests (cons grob rests))))))
+     ((stop-translation-timestep translator)
+      (let (;; get a list of the rests 'duration-lengths, 'duration-log does
+            ;; not take dots into account
+            (durs
+             (map
+              (lambda (g)
+                (ly:duration->moment
+                 (ly:prob-property
+                  (ly:grob-property g 'cause)
+                  'duration)))
+              rests)))
+        (if (and
+             (has-at-least-two? rests)
+             (all-equal? durs equal?)
+             (rests-all-unpitched? rests))
+            (begin
+              (merge-rests rests)
+              ;; ly:grob-suicide! works nicely for dots, as opposed to rests.
+              (if (pair? dots) (for-each ly:grob-suicide! (cdr dots)))))
+        (if (has-at-least-two? mmrests)
+            (merge-mmrests mmrests)))))))

private_includes/base/scm/yaml_parser.scm

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

private_includes/base/scm/yaml_writer.scm

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

private_includes/base/swing_style.ily

@@ -1,4 +1,4 @@
-swing = \mark \markup {
+swing = \textMark \markup {
   \line \general-align #Y #DOWN {
     \score {
       \new Staff \with {
@@ -47,7 +47,7 @@ swing = \mark \markup {
   }
 }
 
-swingOff = \mark \markup {
+swingOff = \textMark \markup {
   \line \general-align #Y #DOWN {
     \score {
       \new Staff \with {
@@ -99,7 +99,7 @@ swingOff = \mark \markup {
 \include "swing.ly"
 
 swingMusic =
-#(define-music-function (parser location music) (ly:music?)
+#(define-music-function (music) (ly:music?)
   (define (partial-duration-length m)
     (let ((name (ly:music-property m 'name))
           (es (ly:music-property m 'elements))

private_includes/base/title_with_category_images.ily

@@ -0,0 +1,90 @@
+#(define-markup-command (bookTitleMarkupCustom layout props)()
+   (interpret-markup layout props
+     (make-column-markup
+       (list
+         (make-vspace-markup (chain-assoc-get 'header:titletopspace props 0))
+         (make-customEps-markup (chain-assoc-get 'header:titlesize props 3.5) "titel.eps")
+     ))
+))
+
+#(define-markup-command (category-image layout props size category)(number? string?)
+   (interpret-markup layout props
+     (if noStandaloneOutput
+       (make-epsfileref-markup Y size
+         (category-image-path category))
+       (make-epsfile-markup Y size
+         (category-image-path category)))))
+
+#(define showCategoryImages (if (defined? 'showCategoryImages) showCategoryImages #t))
+
+#(define-markup-command (category-images layout props)()
+   (interpret-markup layout props
+     (if showCategoryImages
+       (make-line-markup (map (lambda (category) (make-category-image-markup 5 category))
+           (string-tokenize (chain-assoc-get 'header:categories props ""))))
+       (make-null-markup))))
+
+#(define pdf-encode (@@ (lily framework-ps) pdf-encode))
+% PDF tags
+% Erzeugt ein PDF-Lesezeichen (Outline-Eintrag) auf der aktuellen Seite.
+% count = Anzahl der direkten Unterpunkte, die (in Seitenreihenfolge) direkt
+%   nachfolgen. 0 = Blatt-Eintrag (kein /Count), >0 = aufgeklappt,
+%   <0 = zugeklappt (Betrag = Anzahl direkter Kinder).
+#(define (make-pdf-toc-stencil title count)
+  (if (string-null? title)
+     empty-stencil
+     (ly:make-stencil
+      (list 'embedded-ps
+             (ly:format
+              "[~a/Action /GoTo /View [/XYZ -4 currentpagedevice /PageSize get 1 get 4 add null] /Title (~a) /OUT pdfmark"
+              (if (= count 0) "" (ly:format "/Count ~a " count))
+              (pdf-encode title)))
+      empty-interval empty-interval
+      ;'(0 . 0) '(0 . 0)
+      )))
+
+% Einzelner (Blatt-)Eintrag im PDF-Inhaltsverzeichnis.
+#(define-markup-command (title-to-pdf-toc layout props title) (string?)
+  (make-pdf-toc-stencil title 0))
+
+% Kapitel-Eintrag mit verschachtelten Unterpunkten.
+% count = Anzahl der direkt nachfolgenden Einträge, die diesem Kapitel
+%   untergeordnet werden sollen (positiv = aufgeklappt, negativ = zugeklappt).
+#(define-markup-command (chapter-to-pdf-toc layout props count title) (integer? string?)
+  (make-pdf-toc-stencil title count))
+
+#(define-markup-command (build-full-title layout props right)(boolean?)
+   (interpret-markup layout (prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props)
+     (let* ((title (chain-assoc-get 'header:title props ""))
+            (starttext (chain-assoc-get 'header:starttext props #f))
+            (pdfbookmark (if starttext (string-append starttext " | " title) title))
+            (chaptertitle (chain-assoc-get 'header:chaptertitle props #f))
+            (chaptercount (chain-assoc-get 'header:chaptercount props 0))
+            (title-markup (ly:output-def-lookup layout (if right 'oddTitleLineMarkup 'evenTitleLineMarkup))))
+     (if title
+       ;; Ist dieses Lied das erste eines Kapitels, wird der Kapitel-Eintrag
+       ;; unmittelbar vor dem Lied-Eintrag ausgegeben, damit die pdfmark-/OUT-
+       ;; Reihenfolge (Elternteil vor Kindern) im PDF-Stream garantiert stimmt.
+       (if (and (string? chaptertitle) (not (string-null? chaptertitle)))
+         (markup #:chapter-to-pdf-toc chaptercount chaptertitle
+                 #:title-to-pdf-toc pdfbookmark title-markup)
+         (markup #:title-to-pdf-toc pdfbookmark title-markup))
+       make-null-markup)
+     )))
+
+\paper {
+  bookTitleMarkup = \markup \null
+  scoreTitleMarkup = \markup \null
+  oddHeaderMarkup = \markup { \if \on-first-page-of-part \build-full-title ##t }
+  evenHeaderMarkup = \markup { \if \on-first-page-of-part \build-full-title ##f }
+  oddTitleLineMarkup = \markup { \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \category-images } }
+  evenTitleLineMarkup = \markup { \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } }
+  defaultTitleMarkup = \markup {
+    \override #'(baseline-skip . 3.5)
+    \center-column {
+      \override #`(font-name . ,songTitleFont) { \fontsize #songTitleSize \fromproperty #'header:title }
+      \large \bold \fromproperty #'header:subtitle
+      \smaller \bold \fromproperty #'header:subsubtitle
+    }
+  }
+}

private_includes/base/transposition.ily

@@ -2,7 +2,12 @@ TRANSPOSITION = #(cons #f #f)
 
 transposeGlobal =
 #(define-void-function (from to) (ly:pitch? ly:pitch?)
-   (set! TRANSPOSITION (cons from to)))
+   (if (not (car TRANSPOSITION))
+       (set! TRANSPOSITION (cons from to))
+       (let ((current_to (cdr TRANSPOSITION))
+             (interval (ly:pitch-diff to from)))
+         (set! TRANSPOSITION (cons (car TRANSPOSITION) 
+                                    (ly:pitch-transpose current_to interval))))))
 
 transposable =
 #(define-music-function (fromto music) (pair? ly:music?)

private_includes/base/verses_with_chords.ily

@@ -60,19 +60,20 @@
 
 % Text über Text mittig darstellen
 #(define-markup-command (textup layout props text uptext) (markup? markup?)
+   #:properties ((verselayout generalLayout)
+                 (verse-text-chord-distance songTextChordDistance))
    "Markup über Text mittig darstellen."
-   (let ((verselayout (chain-assoc-get 'verselayout props generalLayout)))
    (interpret-markup layout props
      #{\markup {
        \size-box-to-box-style-dependent ##t ##f
-         \general-align #X #LEFT \override #`(direction . ,UP) \override #'(baseline-skip . 1.0) \dir-column \chord-alignment-style-dependent {
+         \general-align #X #LEFT \override #`(direction . ,UP) \override #'(baseline-skip . 1) \dir-column \chord-alignment-style-dependent {
-           \pad-to-box #'(0 . 0) #'(0 . 2.0) { #text }
+           \pad-to-box #'(0 . 0) #`(0 . ,(- verse-text-chord-distance 0.8)) { #text }
-           \size-box-to-box ##f ##t #uptext \score { \chords { g4:m a } \layout { \verselayout } }
+           \size-box-to-box ##f ##t #uptext \score { \chords { g4:m a } \layout { $verselayout #(customized-layout verselayout) } }
          }
          #text
        }
      #}
-   )))
+   ))
 
 #(define-markup-command (anchor-x-between layout props arga argb)
    (markup? markup?)
@@ -82,16 +83,15 @@
             (ly:stencil-aligned-to m X (- (/ (* la 2) l) 1))
      ))
 
-#(define-markup-command (stanza-raw layout props arg)
+#(define-markup-command (stanza-raw layout props arg) (string-or-music?)
-   (string-or-music?)
+   #:properties ((verselayout generalLayout))
-   (let ((verselayout (chain-assoc-get 'verselayout props generalLayout)))
    (interpret-markup layout props
      (if (and (string? arg) (string-null? arg))
          " "
          #{\markup
-           \score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \set stanza = #arg #}) "" } } \layout { \verselayout } }
+           \score { \new Lyrics { \lyricmode { #(if (ly:music? arg) arg #{ \set stanza = #arg #}) "" } } \layout { $verselayout #(customized-layout verselayout) } }
          #}
-     ))))
+     )))
 
 #(define-markup-command (stanza layout props arg)
    (string-or-music?)
@@ -141,7 +141,7 @@
        (make-wrap-newline-markup
                (ly:regex-replace (ly:make-regex "\\(( *)([^,()]*)( *),([^)]*)\\)")
                  (ly:regex-replace (ly:make-regex "(([^ \n]*\\([^()]*,[^()]+\\)[^ \n(]*)+)") (handle-custom-newlines custom-verse-breaks verse) " \\concat { " 1 " } ")
-                "\\textup \\line { \"" 1 "\" " 2 " \"" 3 "\" } \\score { " transp " \\chords { s4 " 4 " } \\layout { \\verselayout } }")
+                "\\textup \\line { \"" 1 "\" " 2 " \"" 3 "\" } \\score { " transp " \\chords { s4 " 4 " } \\layout { $verselayout #(customized-layout verselayout) } }")
                 )
      ))))
 
@@ -182,7 +182,19 @@
      ((if reverses fold fold-right) (lambda (element filled-list)
               (cons element (if (null? filled-list) '() (cons markup-between filled-list))))
         '() elements))
-   (let* ((column-item-count (ceiling (/ (length versegroup) verse-cols)))
+   ;; Dokumentposition fuer den ChordPro-/Data-Collector: jede Gruppe nimmt
+   ;; sich eine Sequenznummer, jeder Vers traegt seine Position innerhalb
+   ;; der Gruppe in den Props -- die Spalten-Verteilung unten verschraenkt
+   ;; sonst die Interpretationsreihenfolge.
+   (set! chordpro-doc-seq-counter (1+ chordpro-doc-seq-counter))
+   (let* ((doc-seq chordpro-doc-seq-counter)
+          (versegroup (index-map
+                       (lambda (index item)
+                         (make-override-markup
+                          (cons 'chordpro-doc-order (cons doc-seq index))
+                          item))
+                       versegroup))
+          (column-item-count (ceiling (/ (length versegroup) verse-cols)))
           (column-data (make-list verse-cols)))
     (let columnize-list ((index 0) (items versegroup))
       (if (not (null? items))
@@ -203,32 +215,32 @@
 
 #(define-markup-command (pad-left layout props amount arg)
   (number? markup?)
-  (let* ((m (interpret-markup layout props arg))
-         (x (ly:stencil-extent m X))
-         (y (ly:stencil-extent m Y)))
     (ly:stencil-translate
-      (ly:make-stencil (ly:stencil-expr m)
+      (interpret-markup layout props (make-pad-x-left-markup amount arg))
-                       (cons (- (car x) amount) (cdr x))
+      `(,amount . 0)))
-                       y)
-      `(,amount . 0))))
 
-#(define-markup-command (pad-right layout props amount arg)
+#(define-markup-command (score-equal-height-with-indents layout props lines)
-  (number? markup?)
+  (markup-list?)
-  (let* ((m (interpret-markup layout props arg))
-         (x (ly:stencil-extent m X))
-         (y (ly:stencil-extent m Y)))
-      (ly:make-stencil (ly:stencil-expr m)
-                       (cons (car x) (+ (cdr x) amount))
-                       y)))
-
-#(define-markup-command (score-equal-height layout props reference-height lines)
-  (number? markup-list?)
   #:category music
-  #:properties ((baseline-skip))
+  #:properties ((intraverse-vspace 0)
-    (stack-stencils Y DOWN baseline-skip
+                (verse-line-height songTextLineHeigth)
-      (map
+                (line-indents '()))
-        (lambda (line) (ly:make-stencil (ly:stencil-expr line) (ly:stencil-extent line X) `(,(/ reference-height -2.0) . ,(/ reference-height 2.0))))
+    (let ((indents-max-index (- (length line-indents) 1)))
-        (interpret-markup-list layout props lines))))
+      (stack-stencils Y DOWN intraverse-vspace
+        (index-map
+          (lambda (index line)
+            (let ((stil
+                    (ly:make-stencil
+                      (ly:stencil-expr line)
+                      (ly:stencil-extent line X)
+                      `(,(/ verse-line-height -2.0) . ,(/ verse-line-height 2.0)))))
+              (if (<= index indents-max-index)
+                (ly:stencil-translate-axis
+                  stil
+                  (list-ref line-indents index)
+                  X)
+                stil)))
+          (interpret-markup-list layout props lines)))))
 
 #(define-public (custom-lyric-text::print grob)
   "Allow interpretation of tildes as lyric tieing marks."
@@ -236,40 +248,143 @@
   (let ((text (ly:grob-property grob 'text)))
 
     (grob-interpret-markup grob (if (string? text)
-                                    (make-pad-right-markup -0.1 (make-tied-lyric-markup text))
+                                    (make-pad-x-right-markup -0.1 (make-tied-lyric-markup text))
                                     text))))
 
+Chord_lyrics_spacing_engraver =
+#(lambda (ctx)
+   (let ((last-lyric-syllable #f)
+         (lyric-width-since-last-chord 0)
+         (music-columns-for-last-syllable 0)
+         (last-printed-chord #f)
+         (chord-width-since-last-lyric 0)
+         (lyrics-seen-since-break #f)
+         (have-a-rest #f)
+         (stanza #f)
+         (place-at-right-edge
+          (lambda (grob anchor padding)
+            (let ((anchor-width (interval-length (ly:grob-extent anchor anchor X))))
+              (ly:grob-set-parent! grob X anchor)
+              (ly:grob-set-property! grob 'X-offset (+ padding anchor-width))
+              ))))
+     (make-engraver
+      (listeners
+       ((multi-measure-rest-event engraver event)
+        (set! have-a-rest #t)
+        )
+       ((rest-event engraver event)
+        (set! have-a-rest #t)
+        )
+       ((lyric-event engraver event)
+        (set! have-a-rest #f)
+        (set! music-columns-for-last-syllable 0)
+        )
+       ((break-event engraver event)
+        (set! last-lyric-syllable #f)
+        (set! lyric-width-since-last-chord 0)
+        (set! music-columns-for-last-syllable 0)
+        (set! last-printed-chord #f)
+        (set! chord-width-since-last-lyric 0)
+        (set! lyrics-seen-since-break #f)
+        ))
+      (acknowledgers
+       ((musical-paper-column-interface this-engraver grob source-engraver)
+        (set! music-columns-for-last-syllable (+ 1 music-columns-for-last-syllable))
+        )
+       ((lyric-syllable-interface this-engraver grob source-engraver)
+        (let ((syllable-width (interval-length (ly:grob-extent grob grob X))))
+          (set! lyric-width-since-last-chord (+ lyric-width-since-last-chord syllable-width))
+          )
+        (if (> chord-width-since-last-lyric 0)
+            (if lyrics-seen-since-break
+                (ly:grob-set-property! grob 'extra-spacing-width
+                                       (cons (- chord-width-since-last-lyric) (cdr (ly:grob-property grob 'extra-spacing-width '(0 . 0)))))
+                (if last-printed-chord
+                  (let ((gap-for-starting-rest 2.0))
+                    (if stanza (ly:grob-set-property! stanza 'padding (+ 1 gap-for-starting-rest)))
+                    (ly:grob-set-parent! grob X last-printed-chord)
+                    (ly:grob-set-property! grob 'X-offset gap-for-starting-rest)
+                    )))
+            )
+        (set! last-lyric-syllable grob)
+        (set! chord-width-since-last-lyric 0)
+        (set! lyrics-seen-since-break #t)
+        )
+       ((chord-name-interface this-engraver grob source-engraver)
+        (if (not (and
+                  (boolean? (ly:grob-property grob 'begin-of-line-visible))
+                  (ly:grob-property grob 'begin-of-line-visible)
+                  lyrics-seen-since-break))
+            (let* ((last-printed-chord-width (if last-printed-chord (interval-length (ly:grob-extent last-printed-chord last-printed-chord X)) 0))
+                   (chord-overwidth (- last-printed-chord-width lyric-width-since-last-chord))
+                   (chord-gap 0.5))
+              (if have-a-rest
+                  (let ((chord-width (interval-length (ly:grob-extent grob grob X))))
+                    (if last-lyric-syllable
+                        (if (and last-printed-chord (> chord-overwidth 0))
+                          (place-at-right-edge grob last-printed-chord chord-gap)
+                          (place-at-right-edge grob last-lyric-syllable 0))
+                        (if last-printed-chord
+                            (place-at-right-edge grob last-printed-chord chord-gap)))
+                    (set! chord-width-since-last-lyric (+ chord-width-since-last-lyric chord-width chord-gap))
+                    ))
+              (if (and last-lyric-syllable last-printed-chord (> chord-overwidth 0))
+                      (ly:grob-set-property! last-lyric-syllable 'extra-spacing-width
+                                             (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! last-printed-chord grob)
+              (set! last-lyric-syllable #f)
+              )
+            (ly:grob-set-property! grob 'X-extent '(+inf.0 . -inf.0))
+            )
+        )
+        ((stanza-number-interface this-engraver grob source-engraver)
+          (set! stanza grob)
+          )
+       )
+      )))
+
 #(define-markup-command (chordlyrics layout props lyrics) (ly:music?)
    #:properties ((verse-chords #{#})
                  (verse-reference-voice #{#})
                  (verse-break-voice #{#})
-                 (verse-line-height songTextLineHeigth)
                  (verse-text-chord-distance songTextChordDistance)
-                 (intraverse-vspace 0)
                  (transposition (cons #f #f))
                  (verselayout generalLayout))
   "Vers mit Akkorden"
+  ;; Dem ChordPro-Collector sagen, zu welchem Lied dieser Vers gehoert
+  ;; (Buch: songfilename aus den Props via \setsongfilename; Einzellied:
+  ;; Fallback-Key aus layout_bottom). Die Score-Interpretation darunter
+  ;; laeuft synchron, der Engraver liest den Key in initialize. Die Props
+  ;; braucht er zum Aufloesen von Markup-Silben (tags-to-keep).
+  (set! chordpro-active-song-key (chordpro-resolve-song-key props))
+  (set! chordpro-active-props props)
+  ;; Dokumentposition: von \group-verses gestempelt; ausserhalb einer
+  ;; Gruppe nimmt sich der Vers selbst eine Sequenznummer.
+  (set! chordpro-active-doc-order
+    (or (chain-assoc-get 'chordpro-doc-order props #f)
+        (begin
+          (set! chordpro-doc-seq-counter (1+ chordpro-doc-seq-counter))
+          (cons chordpro-doc-seq-counter 0))))
   (interpret-markup layout props
     #{
       \markup {
-        \override #`(baseline-skip . ,intraverse-vspace)
+        \score-equal-height-with-indents \score-lines {
-        \score-equal-height #verse-line-height \score-lines {
-          \transposable #transposition
           <<
-            \new Devnull { #verse-break-voice }
+            \new Devnull { #(music-clone verse-break-voice) }
-            \new NullVoice = "dummyvoice" { #verse-reference-voice }
+            \new NullVoice = "dummyvoice" { #(music-clone verse-reference-voice) }
-            #(music-clone verse-chords)
+            \transposable #transposition #(music-clone verse-chords)
             \new Lyrics \lyricsto "dummyvoice" { #lyrics }
           >>
           \layout {
-            \verselayout
+            $verselayout
-            #(let
+            #(customized-layout verselayout)
-              ((custom-size (ly:output-def-lookup verselayout 'size #f)))
-              (if custom-size (layout-set-staff-size custom-size)))
             ragged-right = ##t
             \context {
               \Lyrics
               \override VerticalAxisGroup.nonstaff-relatedstaff-spacing.basic-distance = #verse-text-chord-distance
+              \override VerticalAxisGroup.nonstaff-relatedstaff-spacing.padding = #(- verse-text-chord-distance songTextChordDistance)
               \override LyricText.parent-alignment-X = #LEFT
               \override LyricText.self-alignment-X = #LEFT
               \override LyricText.word-space = 0.8
@@ -288,10 +403,17 @@
               % \override SpacingSpanner.strict-note-spacing = ##t
               \override SpacingSpanner.uniform-stretching = ##t
               \override SpacingSpanner.spacing-increment = 0
+              % \override SpacingSpanner.packed-spacing = ##t
+              \consists \Chord_lyrics_spacing_engraver
+              % ChordPro engraver in Score context to collect all data
+              \consists \ChordPro_score_collector
               \remove Bar_number_engraver
               \remove Mark_engraver
+              \remove Jump_engraver
               \remove Volta_engraver
               \remove Parenthesis_engraver
+              \remove Metronome_mark_engraver
+              \remove Text_mark_engraver
             }
             \context {
               \Staff
@@ -313,13 +435,7 @@
               \remove Tie_engraver
               \remove Dynamic_engraver
               \remove Note_heads_engraver
-            }
+              \remove Script_engraver
-            \context {
-              \NullVoice
-              \consists Rest_engraver
-              \omit Rest
-             % \undo \omit NoteHead
-             % \hide NoteHead
             }
           }
         }

private_includes/book/book_include.ily

@@ -0,0 +1,638 @@
+#(define song-list '())
+#(define song-number 0)
+
+#(define (files-in-directory dirname)
+      ;;; Generate list containing filenames
+      (let ((dir (opendir dirname)))
+        (let next ((f (readdir dir))
+    	       (files '()))
+          (cond ((eof-object? f)
+    	     (closedir dir)
+    	     files)
+    	    (else
+    	     (next (readdir dir) (if (ly:regex-match? (ly:regex-exec (ly:make-regex "^(0|\\.)") f)) files (cons f files))))))))
+
+#(define (file-to-stats filename)
+   (set! song-list (cons filename song-list)))
+
+
+#(define additional-page-switch-label-list '())
+#(define additional-page-numbers #f)
+
+normalPageNumbers =
+#(define-void-function (parser location) ()
+  (set! additional-page-numbers #f)
+)
+additionalPageNumbers =
+#(define-void-function (parser location) ()
+  (set! additional-page-numbers #t)
+)
+
+#(define (real-page-number layout label)
+  (let ((table (ly:output-def-lookup layout 'label-page-table)))
+        (if (list? table)
+            (assoc-get label table)
+            #f))
+  )
+
+#(define display-pages-list '())
+#(define (build-display-pages-list layout)
+  (if (null? display-pages-list)
+    (let calculate-display-page ((switch-label-list additional-page-switch-label-list))
+      (let* ((label (caar switch-label-list))
+             (is-additional (cdar switch-label-list))
+             (real-page (real-page-number layout label))
+             (rest-switch-label-list (cdr switch-label-list))
+             (display-page (if (null? rest-switch-label-list)
+               (if is-additional (- real-page 1) real-page)
+               (let* ((previous-label (caar rest-switch-label-list))
+                      (previous-is-additional (cdar rest-switch-label-list))
+                      (previous-display-page (calculate-display-page rest-switch-label-list)))
+                  (+ previous-display-page
+                    (if previous-is-additional
+                      (if is-additional 0 1)
+                      (if is-additional
+                          (- (- real-page (real-page-number layout previous-label)) 1)
+                          (- real-page (real-page-number layout previous-label)))
+                    )
+                  )
+               )
+             ))
+      )
+      (set! display-pages-list (acons label display-page display-pages-list))
+      display-page
+    )))
+  display-pages-list
+)
+
+% Fuer Zusatzseiten: Label der ersten Seite des zusammenhaengenden
+% Zusatzseiten-Blocks, zu dem label gehoert (bestimmt den Buchstaben-Suffix a, b, ...).
+#(define (earliest-additional-label label)
+  (let find-earliest-additional-label
+       ((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list)))
+       (if (cdadr rest-additional-page-switch-label-list)
+           (find-earliest-additional-label (cdr rest-additional-page-switch-label-list))
+           (caar rest-additional-page-switch-label-list))))
+
+% Sichtbare Seitenzahl der Seite mit diesem Label: normalerweise eine Zahl,
+% auf Zusatzseiten ein String mit Buchstaben-Suffix (z.B. "12a"); gleiche
+% Logik wie custom-page-number unten.
+#(define (visible-page-value layout label)
+  (let ((display-page (assq-ref (build-display-pages-list layout) label)))
+    (if (assq-ref additional-page-switch-label-list label)
+        (ly:format "~a~a" display-page
+          (string (integer->char (+ 97 (- (real-page-number layout label)
+                                          (real-page-number layout (earliest-additional-label label)))))))
+        display-page)))
+
+% TODO:
+% Eigentlich können wir das direkt in oddFooderMarkup und evenFooterMarkup aufrufen
+% vermutlich sogar ohne den delay kram. Wir sollten außerdem einfach nur die property
+% page:page-number-string setzen dann klappts auch mit PDF Seiten
+#(define-markup-command (custom-page-number layout props label real-current-page-number)
+  (symbol? number?)
+  #:category other
+  "
+@cindex referencing page number, in text
+
+Reference to a page number.  @var{label} is the label set on the referenced
+page (using the @code{\\label} command), @var{gauge} a markup used to estimate
+the maximum width of the page number, and @var{default} the value to display
+when @var{label} is not found.
+
+(If the current book or bookpart is set to use roman numerals for page numbers,
+the reference will be formatted accordingly -- in which case the @var{gauge}'s
+width may require additional tweaking.)"
+  (let* ((gauge-stencil (interpret-markup layout props "XXX"))
+         (x-ext (ly:stencil-extent gauge-stencil X))
+         (y-ext (ly:stencil-extent gauge-stencil Y)))
+    (ly:stencil-outline
+     (ly:make-stencil
+      `(delay-stencil-evaluation
+        ,(delay (ly:stencil-expr
+                 (let* ((display-page (assq-ref (build-display-pages-list layout) label))
+                        (real-current-page (if (negative? real-current-page-number) (real-page-number layout label) real-current-page-number))
+                        (number-type (ly:output-def-lookup layout 'page-number-type))
+                        (page-markup
+                          (if (assq-ref additional-page-switch-label-list label)
+                              (make-concat-markup (list (number-format number-type display-page)
+                                (make-char-markup (+ 97 (- real-current-page (real-page-number layout
+                                  (earliest-additional-label label)))))))
+                              (number-format number-type (+ display-page (- real-current-page (real-page-number layout label))))
+                          ))
+                        (page-stencil (interpret-markup layout props page-markup))
+                        (gap (- (interval-length x-ext)
+                                (interval-length (ly:stencil-extent page-stencil X)))))
+                   (interpret-markup layout props
+                                     (make-line-markup
+                                      (list
+                                       (make-hspace-markup gap)
+                                       page-markup)))))))
+      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 =
+#(define-void-function (filename) (string?)
+     #{
+     \bookOutputName #filename
+     #}
+    (ly:parser-parse-string (ly:parser-clone)
+      (ly:format "\\include \"~a/~a/~a.ly\"" songPath filename filename))
+    ;; ChordPro: Titel/Autoren dieses Lieds im Render-Collector-Store
+    ;; registrieren -- basicSongInfo haelt direkt nach dem Include genau
+    ;; dieses Lied. Der Key ist der Liedname; die Collector-Daten (Verse,
+    ;; Akkorde) kommen spaeter beim Rendern ueber \setsongfilename unter
+    ;; demselben Key dazu. Unabhaengig von chordpro-export-enabled, damit
+    ;; sowohl der Pro-Song-Export (der die Flag braucht) als auch
+    ;; \write-book-chordpro (das nur explizit aufgerufen werden muss) auf
+    ;; vollstaendige Metadaten zugreifen koennen.
+    (chordpro-register-song-metadata filename HEADER)
+    (let ((label (gensym "index")))
+      (set! additional-page-switch-label-list
+        (acons label additional-page-numbers additional-page-switch-label-list))
+      (set! song-list
+        (acons (string->symbol filename)
+          `(
+            (label . ,label)
+            (header . ,HEADER)
+            (music . ,MUSIC)
+            (layout . ,LAYOUT)
+            (text-pages . ,(map (lambda (text)
+                      #{ \markuplist \setsongfilename $filename $text #})
+                      TEXT_PAGES))
+          )
+          song-list))
+    ))
+
+blankpage =
+#(define-void-function () ()
+    (set! song-list
+      (acons 'emptyPage
+        '()
+        song-list)))
+
+imagepage =
+#(define-void-function (xsize filename) (number? string?)
+    (set! song-list
+      (acons 'imagePage
+        `((xsize . ,xsize)
+          (filename . ,filename))
+        song-list)))
+
+markuppage =
+#(define-void-function (mkup) (markup?)
+    (set! song-list
+      (acons 'markupPage
+        `((markup . ,mkup))
+        song-list)))
+
+#(define chapters '())
+
+songsChapter =
+#(define-void-function (title) (string?)
+    (set! chapters
+      (cons (cons title (length song-list)) chapters)))
+
+#(define-markup-command (pagecenter layout props stuff)(markup?)
+   (interpret-markup layout props
+     (let ((halfpaperheight (/ (ly:output-def-lookup layout 'paper-height) 2))
+           (halfstuffheight (/ (interval-length (ly:stencil-extent (interpret-markup layout props stuff) Y)) 2)))
+       (make-fill-line-markup (list (make-pad-to-box-markup '(0 . 0) (cons (- (- halfpaperheight halfstuffheight)) (+ halfpaperheight halfstuffheight)) stuff)))
+   )))
+
+songs =
+#(define-void-function () ()
+ (let* ((ordered (reverse song-list))
+        (total (length ordered))
+        ;; Ein Lied erzeugt nur dann einen PDF-Outline-Eintrag (/OUT), wenn
+        ;; title oder starttext gesetzt sind (siehe build-full-title). Nur solche
+        ;; Lieder duerfen als Kapitel-Kinder gezaehlt werden -- sonst wird die
+        ;; /Count zu hoch und der erste Folgeeintrag (z.B. ein spaeteres Kapitel)
+        ;; rutscht faelschlich als Kind mit hinein.
+        (emits-bookmark?
+          (lambda (e)
+            (and (not (eq? (car e) 'emptyPage))
+                 (not (eq? (car e) 'imagePage))
+                 (not (eq? (car e) 'markupPage))
+                 (let ((vars (extract-and-check-vars-from-header
+                               (assq-ref (cdr e) 'header) '(title starttext))))
+                   (if (or (assq-ref vars 'title) (assq-ref vars 'starttext)) #t #f)))))
+        (count-bookmark-songs
+          (lambda (start end)
+            (let loop ((i 0) (l ordered) (c 0))
+              (cond ((or (null? l) (>= i end)) c)
+                    ((< i start) (loop (+ i 1) (cdr l) c))
+                    (else (loop (+ i 1) (cdr l) (if (emits-bookmark? (car l)) (+ c 1) c)))))))
+        ;; chapters: (title . start-index). start-index = Anzahl der song-list-
+        ;; Eintraege beim Aufruf von songsChapter = Index in `ordered`, ab dem
+        ;; das Kapitel beginnt.
+        (chapters-asc (sort chapters (lambda (a b) (< (cdr a) (cdr b)))))
+        ;; pending: aufsteigende Liste von (start title count); count = Anzahl
+        ;; der Lesezeichen-Lieder von diesem Kapitel bis zum Beginn des naechsten.
+        (pending
+          (let loop ((chs chapters-asc) (acc '()))
+            (if (null? chs)
+                (reverse acc)
+                (let* ((title (caar chs))
+                       (start (cdar chs))
+                       (end (if (null? (cdr chs)) total (cdadr chs)))
+                       (cnt (count-bookmark-songs start end)))
+                  (loop (cdr chs) (cons (list start title cnt) acc))))))
+        ;; Aktuell aktives Kapitel (Titel-String) waehrend des Durchlaufs. Wird
+        ;; gesetzt, sobald ein Kapitel aktiviert (aus `pending` entfernt) wird --
+        ;; egal ob auf einer Seite (chapter-prefixed-markup) oder auf dem ersten
+        ;; Song. Jeder danach folgende Song erhaelt dieses Kapitel als
+        ;; chapterref-Header-Feld, woraus toc_include.ily den Kapitel-Index baut.
+        (current-chapter #f)
+        ;; Stellt einer beliebigen Seite (markup-/image-/emptyPage) den Kapitel-
+        ;; Eintrag (chapter-to-pdf-toc) bei, falls an Position `this-index` ein
+        ;; Kapitel faellig ist, und entfernt es aus `pending`. So fuehrt die
+        ;; Kapitel-Referenz zur ersten Seite nach dem \songsChapter -- egal
+        ;; welcher Seitentyp das ist. Der Eintrag wird als unsichtbares Overlay
+        ;; (\combine) beigelegt, damit er das Seitenlayout nicht veraendert;
+        ;; \with-dimensions gibt dem sonst extent-losen pdfmark einen minimalen
+        ;; Extent, damit er auch auf leeren Seiten nicht verworfen wird.
+        (chapter-prefixed-markup
+          (lambda (this-index base-markup)
+            (if (and (pair? pending) (<= (car (car pending)) this-index))
+                (let ((cnt (caddr (car pending)))
+                      (title (cadr (car pending))))
+                  (set! pending (cdr pending))
+                  (set! current-chapter title)
+                  (make-combine-markup
+                    base-markup
+                    (make-with-dimensions-markup '(0 . 0) '(0 . 0.1)
+                      (make-chapter-to-pdf-toc-markup cnt title))))
+                base-markup)))
+        (index 0))
+ (for-each (lambda (songitems)
+   (let ((this-index index))
+     (set! index (+ index 1))
+     (ly:book-add-bookpart! (ly:parser-lookup '$current-book)
+      (let ((filename (car songitems))
+            (songvars (cdr songitems)))
+        (if (eq? filename 'emptyPage)
+            #{ \bookpart { \markup { $(chapter-prefixed-markup this-index (make-null-markup)) } } #}
+        (if (eq? filename 'markupPage)
+            ;; Kapitelanfang auf einer markuppage: Kapitel-Eintrag wird dieser
+            ;; Seite beigelegt (siehe chapter-prefixed-markup).
+            #{ \bookpart { \markup { $(chapter-prefixed-markup this-index (assq-ref songvars 'markup)) } } #}
+        (if (eq? filename 'imagePage)
+            (let* ((xsize (assq-ref songvars 'xsize))
+                   (filename (ly:format "~a/~a" imagePagePath (assq-ref songvars 'filename)))
+                   (img-markup #{ \markup { \pagecenter { \epsfile #X #xsize #filename } } #}))
+            #{ \bookpart {
+                 \paper {
+                   %{
+                   inner-margin = 0
+                   outer-margin = 0
+                   binding-offset = 0
+                   top-margin = 0
+                   bottom-margin = 0
+                   %}
+                   print-page-number = ##f
+                   last-bottom-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
+                   page-count = 1
+                }
+                \markup { $(chapter-prefixed-markup this-index img-markup) }
+            } #}
+            )
+            ;; Ist ein Kapitel faellig (Start <= aktuelle Position) und dies ein
+            ;; echtes Lied, wird die Kapitelinfo an dieses Lied gehaengt und aus
+            ;; `pending` entfernt.
+            (let* ((newnumber (+ 1 song-number))
+                   (chaptertitle (if (and (pair? pending) (<= (car (car pending)) this-index))
+                                     (cadr (car pending)) #f))
+                   (chaptercount (if chaptertitle (caddr (car pending)) 0))
+                   ;; Startet das Kapitel erst auf diesem Song (nicht schon auf
+                   ;; einer vorangehenden Seite), wird current-chapter jetzt
+                   ;; gesetzt und pending entfernt -- vor dem Bau des Headers,
+                   ;; damit chapterref bereits das neue Kapitel enthaelt.
+                   (_ (if chaptertitle
+                          (begin (set! current-chapter chaptertitle)
+                                 (set! pending (cdr pending)))))
+                   (header #{ \bookpart { $(assq-ref songvars 'header) \header {
+                     songfilename = $(symbol->string filename)
+                     myindexlabel = #(assq-ref songvars 'label)
+                     songnumber = #(number->string newnumber)
+                     chaptertitle = #chaptertitle
+                     chaptercount = #chaptercount
+                     chapterref = #current-chapter
+                   } } #})
+                   (music (assq-ref songvars 'music))
+                   (layout (assq-ref songvars 'layout))
+                   (text-pages (assq-ref songvars 'text-pages))
+                   (label (assq-ref songvars 'label)))
+            (set! song-number newnumber)
+            ;; ChordPro_music_collector (Strophen unter den Noten, siehe
+            ;; chordpro.ily) braucht den Song-Key beim tatsaechlichen
+            ;; Interpretieren dieses Songs' Hauptscore. Im Buch ist DAS
+            ;; NICHT synchron zu dieser for-each-Schleife -- LilyPond
+            ;; interpretiert die \score-Bloecke aller Lieder gesammelt fuer
+            ;; das Seitenlayout, oft NACHDEM die Schleife schon beim
+            ;; naechsten (oder letzten) Lied angelangt ist. Ein globaler
+            ;; chordpro-active-song-key waere zu diesem Zeitpunkt also auf
+            ;; ein ANDERES Lied gesetzt -- die gesammelten Strophen landen
+            ;; dann fälschlich im Store-Eintrag des zuletzt verarbeiteten
+            ;; 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 {
+                  $header
+                  \headerToTOC #header #label
+                  \score {
+                    $score-music
+                    $song-layout
+                  }
+                  $(add-text-pages text-pages)
+                }
+              #})))))))))
+   ordered
+   )))
+
+#(define (boernel-stats)
+   (let (
+          (songs (map (lambda (song) (symbol->string (car song))) (alist-delete 'emptyPage song-list)))
+          (opticalline "---------------------------------------------------------"))
+   (ly:warning (string-join (list
+     opticalline
+     (string-concatenate (list "Inkludiert: " (number->string (length songs)) " Lieder\n"))
+     ;(string-join songs "\n")
+     "Nicht inkludiert:"
+     opticalline
+     (string-join (sort-list (lset-difference string=? (files-in-directory songPath) songs) string<?) "\n")
+     opticalline
+     ) "\n" )
+)))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Include Images once and reference them:
+#(define bbox-regexp
+  (ly:make-regex "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
+
+#(define (get-postscript-bbox string)
+  "Extract the bbox from STRING, or return #f if not present."
+  (let*
+      ((match (ly:regex-exec bbox-regexp string)))
+
+    (if match
+        (map (lambda (x)
+               (string->number (ly:regex-match-substring match x)))
+             (cdr (iota 5)))
+
+        #f)))
+
+
+#(define eps-references '())
+
+#(define-public (eps-file-ref->stencil axis size just-embed file-name)
+  (let*
+      ((already-embedded (assq (string->symbol file-name) eps-references))
+       (counter (if already-embedded (cadr already-embedded) (if (null-list? eps-references) 1 (+ 1 (cadar eps-references)))))
+       (form-name (ly:format "IDForm~a" counter))
+       (data-name (ly:format "ImageData~a" counter))
+       (eps-content (ly:gulp-file file-name))
+       (contents (ly:format "~a execform" form-name))
+       (bbox (if already-embedded (cddr already-embedded) (get-postscript-bbox (car (string-split eps-content #\nul)))))
+       (bbox-size (if (= axis X)
+                      (- (list-ref bbox 2) (list-ref bbox 0))
+                      (- (list-ref bbox 3) (list-ref bbox 1))
+                      ))
+       (factor (if (< 0 bbox-size)
+                   (exact->inexact (/ size bbox-size))
+                   0))
+       (scaled-bbox
+        (map (lambda (x) (* factor x)) bbox))
+       ;; We need to shift the whole eps to (0,0), otherwise it will appear
+       ;; displaced in lilypond (displacement will depend on the scaling!)
+       (translate-string (ly:format "~a ~a translate" (- (list-ref bbox 0)) (- (list-ref bbox 1))))
+       (clip-rect-string (ly:format
+                          "~a ~a ~a ~a rectclip"
+                          (list-ref bbox 0)
+                          (list-ref bbox 1)
+                          (- (list-ref bbox 2) (list-ref bbox 0))
+                          (- (list-ref bbox 3) (list-ref bbox 1)))))
+
+    (if (not already-embedded) (set! eps-references
+                                     (acons (string->symbol file-name) (cons counter bbox) eps-references)))
+    (if bbox
+        (ly:make-stencil
+         (list
+          'embedded-ps
+          (string-append
+           (if (and already-embedded (not just-embed)) "" (ly:format
+            "
+/~a
+currentfile
+<< /Filter /SubFileDecode
+   /DecodeParms << /EODCount 0 /EODString (*EOD*) >>
+>> /ReusableStreamDecode filter
+~a
+*EOD*
+def
+
+/~a
+<< /FormType 1
+   /BBox [~a ~a ~a ~a]
+   /Matrix [ 1 0 0 1 0 0]
+   /PaintProc
+   { pop
+       /ostate save def
+         /showpage {} def
+         /setpagedevice /pop load def
+         ~a 0 setfileposition ~a cvx exec
+       ostate restore
+   } bind
+>> def
+" data-name eps-content form-name (list-ref bbox 0) (list-ref bbox 1) (list-ref bbox 2) (list-ref bbox 3) data-name data-name))
+           (if just-embed "" (ly:format
+            "
+gsave
+currentpoint translate
+BeginEPSF
+~a dup scale
+~a
+~a
+%%BeginDocument: ~a
+~a
+%%EndDocument
+EndEPSF
+grestore
+"         factor translate-string  clip-rect-string file-name contents
+))))
+         ;; Stencil starts at (0,0), since we have shifted the eps, and its
+         ;; size is exactly the size of the scaled bounding box
+         (if just-embed '(0 . 0) (cons 0 (- (list-ref scaled-bbox 2) (list-ref scaled-bbox 0))))
+         (if just-embed '(0 . 0) (cons 0 (- (list-ref scaled-bbox 3) (list-ref scaled-bbox 1)))))
+
+        (ly:make-stencil "" '(0 . 0) '(0 . 0)))
+    ))
+
+#(define-markup-command (epsfileref layout props axis size file-name)
+  (number? number? string?)
+  #:category graphic
+  "
+@cindex inlining an Encapsulated PostScript image
+
+Inline an EPS image.  The image is scaled along @var{axis} to
+@var{size}.
+
+@lilypond[verbatim,quote]
+\\markup {
+  \\general-align #Y #DOWN {
+    \\epsfile #X #20 #\"context-example.eps\"
+    \\epsfile #Y #20 #\"context-example.eps\"
+  }
+}
+@end lilypond"
+  (if (ly:get-option 'safe)
+      (interpret-markup layout props "not allowed in safe")
+      (eps-file-ref->stencil axis size #f file-name)
+      ))
+
+#(define-markup-command (epsfileembed layout props file-name)
+  (string?)
+  #:category graphic
+  "
+@cindex inlining an Encapsulated PostScript image
+
+Inline an EPS image.  The image is scaled along @var{axis} to
+@var{size}.
+
+@lilypond[verbatim,quote]
+\\markup {
+  \\general-align #Y #DOWN {
+    \\epsfile #X #20 #\"context-example.eps\"
+    \\epsfile #Y #20 #\"context-example.eps\"
+  }
+}
+@end lilypond"
+  (if (ly:get-option 'safe)
+      (interpret-markup layout props "not allowed in safe")
+      (eps-file-ref->stencil X 30 #t file-name)
+      ))

private_includes/book/toc_include.ily

@@ -56,24 +56,14 @@
 
 #(let ((index-item-list (list)))
    (set! add-index-item!
-   (lambda* (markup-symbol text sorttext #:optional (label (gensym "index")))
+   (lambda* (markup-symbol textoptions sorttext #:optional (label (gensym "index")))
        (set! index-item-list
        ;; We insert index items sorted from the beginning on and do
        ;; not sort them later - this saves pretty much computing time
-       (insert-alphabetical-sorted! (list label markup-symbol text
+       (insert-alphabetical-sorted! (list label markup-symbol textoptions
-        ;; this crazy hack is necessary because lilypond depends on guile 1.8 atm
-        ;; and so the cool unicode conversion functions cannot be used
           (ly:string-substitute " " ""
-          (ly:string-substitute "…" ""
+          (ly:string-substitute "." ""
-          (ly:string-substitute "Č" "C"
+          (transliterate-de sorttext))))
-          (ly:string-substitute "Đ" "D"
-          (ly:string-substitute "Т" "T"
-          (ly:string-substitute "Ä" "Ae"
-          (ly:string-substitute "ä" "ae"
-          (ly:string-substitute "Ö" "O"
-          (ly:string-substitute "ö" "oe"
-          (ly:string-substitute "Ü" "U"
-          (ly:string-substitute "ü" "ue" sorttext))))))))))))
         index-item-list))
        (make-music 'EventChord
          'page-marker #t
@@ -91,20 +81,20 @@
           (cons (car ilist) (insert-alphabetical-sorted! iitem (cdr ilist))))))
 
 % code for category index
-#(define*-public (add-category-index-item! categories markup-symbol text #:optional label) #f)
+#(define*-public (add-category-index-item! categories markup-symbol textoptions #:optional label) #f)
 #(define-public (category-index-items) #f)
 
 #(let ((category-index-hash (make-hash-table)))
    (set! add-category-index-item!
-   (lambda* (categories markup-symbol text #:optional (label (gensym "index")))
+   (lambda* (categories markup-symbol textoptions #:optional (label (gensym "index")))
      (for-each (lambda (category)
             (let* ((catsym (string->symbol category))
                    (catlist (hashq-ref category-index-hash catsym
-                              (list (list label 'indexCategoryMarkup category)))))
+                              (list (list label 'indexCategoryMarkup `(((combine-with-next . #t) (rawtext . ,category))))))))
               (if (assq catsym category-names)
                 (hashq-set! category-index-hash catsym
-                  (cons (list label markup-symbol text) catlist))
+                  (cons (list label markup-symbol textoptions) catlist))
-                (ly:error "song: <~a> category ~a is not defined!" (markup->string text) category))))
+                (ly:error "song: <~a> category ~a is not defined!" (markup->string (chain-assoc-get 'rawtext textoptions)) category))))
        categories)
        (make-music 'EventChord
          'page-marker #t
@@ -120,13 +110,13 @@
 
 #(let ((author-index-hash (make-hash-table)))
    (set! add-author-index-item!
-   (lambda* (authorIDs markup-symbol text #:optional (label (gensym "index")))
+   (lambda* (authorIDs markup-symbol textoptions #:optional (label (gensym "index")))
      (for-each (lambda (authorID)
             (let* ((authorsym (string->symbol authorID))
                    (authorlist (hashq-ref author-index-hash authorsym
-                              (list (list label 'indexAuthorMarkup authorID)))))
+                              (list (list label 'indexAuthorMarkup `(((combine-with-next . #t) (rawtext . ,authorID))))))))
                 (hashq-set! author-index-hash authorsym
-                  (cons (list label markup-symbol text) authorlist))
+                  (cons (list label markup-symbol textoptions) authorlist))
                 ))
        authorIDs)
        (make-music 'EventChord
@@ -142,6 +132,37 @@
                 author-index-hash)
               (lambda (a b) (string-ci<? (car a) (car b))))))))
 
+% code for chapter index
+% Anders als bei Kategorien/Autoren ergibt sich die Kapitelzugehoerigkeit nicht
+% aus dem Song-Header, sondern aus dem \songsChapter, das dem Song vorangeht
+% (in book_include.ily als Header-Feld chapterref an jeden Song gehaengt).
+% Die Kapitel behalten hier ihre Auftritts-Reihenfolge (nicht alphabetisch),
+% ebenso die Songs innerhalb eines Kapitels ihre Song-Reihenfolge.
+#(define*-public (add-chapter-index-item! chapter markup-symbol textoptions #:optional label) #f)
+#(define-public (chapter-index-items) #f)
+
+#(let ((chapter-index-hash (make-hash-table))
+       (chapter-order '()))
+   (set! add-chapter-index-item!
+   (lambda* (chapter markup-symbol textoptions #:optional (label (gensym "index")))
+     (let* ((chaptersym (string->symbol chapter))
+            (existing (hashq-ref chapter-index-hash chaptersym #f))
+            (chapterlist (or existing
+                           (begin
+                             (set! chapter-order (cons chaptersym chapter-order))
+                             (list (list label 'indexChapterMarkup `(((combine-with-next . #t) (rawtext . ,chapter))))))))
+            )
+       (hashq-set! chapter-index-hash chaptersym
+         (cons (list label markup-symbol textoptions) chapterlist)))
+       (make-music 'EventChord
+         'page-marker #t
+         'page-label label
+         'elements (list (make-music 'LabelEvent
+         'page-label label)))))
+   (set! chapter-index-items (lambda ()
+          (append-map (lambda (chaptersym) (reverse (hashq-ref chapter-index-hash chaptersym (list))))
+            (reverse chapter-order)))))
+
 
 #(define-markup-command (with-link-symbol-ref layout props symbol arg)
    (symbol? markup?)
@@ -166,22 +187,24 @@
      (markup #:override (cons 'baseline-skip 3.5) (if catname (make-left-column-markup (string-split (cadr catname) #\newline)) category)))))
 
 #(define-markup-command (index-item-with-pattern layout props)()
+    #:properties ((index:text "")
+                  (index:alternative #f)
+                  (index:page #f)
+                  (line-width))
     (let* (
-            (text (chain-assoc-get 'index:text props))
-            (page (chain-assoc-get 'index:page props))
             (width (-
-                     (chain-assoc-get 'line-width props)
+                     line-width
                      (interval-length (ly:stencil-extent (interpret-markup layout props "XXXX") X))))
             (lines-reversed
-                (if (markup? text)
-                    (list text)
               (reverse (map (lambda (stil) (markup #:stencil stil))
                 (wordwrap-string-internal-markup-list layout
-                        (cons (if (chain-assoc-get 'alternative text)
+                  (prepend-alist-chain 'line-width width
-                                (list (cons 'line-width width) (cons 'font-shape 'italic))
+                    (if index:alternative
-                                (list (cons 'line-width width))) props) #f
+                        (prepend-alist-chain 'font-shape 'italic props)
-                        (chain-assoc-get 'rawtext text))))))
+                        props))
-            (last-line-with-dots (make-fill-with-pattern-markup 1 RIGHT "." (car lines-reversed) page))
+                  #f
+                  index:text))))
+            (last-line-with-dots (make-fill-with-pattern-markup 1 RIGHT "." (car lines-reversed) index:page))
             (lines-without-dots (cdr lines-reversed))
             (target-line-size-markup
                  (make-column-markup
@@ -203,7 +226,7 @@
 
 \paper {
   indexItemMarkup = \markup {
-    \index-item-with-pattern
+    \sans \index-item-with-pattern
   }
   indexSectionMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
     \sans \bold \fontsize #3 \fromproperty #'index:text
@@ -223,42 +246,62 @@
         (make-null-markup))
     \vspace #.4
   }
+  indexChapterMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
+    \vspace #1
+    \sans \bold \fontsize #3 \fromproperty #'index:text
+    \vspace #.4
+  }
 }
 
 #(define (prepare-item-markup items layout)
-   (map (lambda (index-item)
+  (define (single-item-markup index-item)
-         (let ((label (car index-item))
+    (let* ((label (car index-item))
            (index-markup (cadr index-item))
-               (text (caddr index-item)))
+           (textoptions (caddr index-item))
+           (text (chain-assoc-get 'rawtext textoptions))
+           (alternative (chain-assoc-get 'alternative textoptions))
+           (songnumber (chain-assoc-get 'songnumber textoptions)))
       (markup #:override (cons 'index:label label)
         #:override (cons 'index:page (markup #:custom-page-number label -1))
         #:override (cons 'index:text text)
+        #:override (cons 'index:alternative alternative)
+        #:override (cons 'index:songnumber songnumber)
         (ly:output-def-lookup layout index-markup))))
-       (items)))
+  (if (null? items)
+      items
+      (let* ((index-item (car items))
+             (combine-with-next (chain-assoc-get 'combine-with-next (caddr index-item) #f))
+             (restitems (cdr items))
+             (item-markup (single-item-markup index-item)))
+        (if (and combine-with-next (not (null? restitems)))
+            (cons (make-column-markup (list item-markup (single-item-markup (car restitems)))) (prepare-item-markup (cdr restitems) layout))
+            (cons item-markup (prepare-item-markup restitems layout))))
+      ))
 
 #(define-markup-list-command (index-in-columns-with-title layout props index-type title-markup) (symbol? markup?)
   ( _i "Outputs index alphabetical sorted or in categories" )
     (let ((items (case index-type
             ((alphabetical) index-items)
             ((categories) category-index-items)
-            ((authors) author-index-items)))
+            ((authors) author-index-items)
+            ((chapters) chapter-index-items)))
           (title (interpret-markup layout props title-markup)))
       (cons title
       (interpret-markup-list layout props
         (make-columnlayout-markup-list songTocColumns 2
           (let ((h (- (ly:output-def-lookup layout 'paper-height) 12)))
             (cons (- h (interval-length (ly:stencil-extent title Y))) h))
-          (prepare-item-markup items layout))))))
+          (prepare-item-markup (items) layout))))))
 
 indexItem =
 #(define-music-function (parser location sorttext text) (string? markup?)
    "Add a line to the alphabetical index, using the @code{indexItemMarkup} paper variable markup."
-   (add-index-item! 'indexItemMarkup text sorttext))
+   (add-index-item! 'indexItemMarkup (prepend-alist-chain 'rawtext text '()) sorttext))
 
 indexSection =
 #(define-music-function (parser location sorttext text) (string? markup?)
    "Add a section line to the alphabetical index, using @code{indexSectionMarkup} paper variable markup. This can be used to divide the alphabetical index into different sections, for example one section for each first letter."
-   (add-index-item! 'indexSectionMarkup 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)
   (let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0)))
@@ -277,32 +320,41 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
             (versePoetData (find-author-id-with-part-numbers 'verse authors))
             (composerIds (find-author-ids-by 'melody authors))
             (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
+            (refComposerIds (find-author-ids-by 'meloref authors))
             (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
             (compositionIds (find-author-ids-by 'composition authors))
+            (adaptionIds (find-author-ids-by 'adaption authors))
             (bridgeIds (find-author-ids-by 'bridge authors))
             (interludeIds (find-author-ids-by 'interlude authors)))
         (delete-duplicates
-          (append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) (map car voiceComposerData) compositionIds bridgeIds interludeIds))
+          (append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) refComposerIds (map car voiceComposerData) compositionIds adaptionIds bridgeIds interludeIds))
     ))
     (let*
       (
-       (extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle altalttitle categorytitle categories authors)))
+       (extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors songnumber chapterref)))
        (title (assq-ref extractedheadervars 'title))
        (starttext (assq-ref extractedheadervars 'starttext))
        (alttitle (assq-ref extractedheadervars 'alttitle))
-       (altalttitle (assq-ref extractedheadervars 'altalttitle))
        (categorytitle (assq-ref extractedheadervars 'categorytitle))
        (categories (assq-ref extractedheadervars 'categories))
        (authors (assq-ref extractedheadervars 'authors))
-       (add-to-toc! (lambda (toctitle tocmarkup)
+       (songnumber (assq-ref extractedheadervars 'songnumber))
-                      (add-index-item! 'indexItemMarkup tocmarkup toctitle label)))
+       (chapterref (assq-ref extractedheadervars 'chapterref))
+       (textoptions (lambda (text alternative) `(((rawtext . ,text) (alternative . ,alternative) (songnumber . ,songnumber)))))
+       (add-to-toc! (lambda (toctitle alternative)
+                      (add-index-item! 'indexItemMarkup (textoptions toctitle alternative) toctitle label)))
        )
-           (if categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (cons (list (cons 'rawtext (if categorytitle categorytitle title))) '()) label))
+           (if categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
-           (if authors (add-author-index-item! (all-author-ids authors) 'indexItemMarkup (cons (list (cons 'rawtext (if categorytitle categorytitle title))) '()) label))
+           (if authors (add-author-index-item! (all-author-ids authors) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
-           (if starttext (add-to-toc! starttext (cons (list (cons 'rawtext starttext) (cons 'alternative #t)) '())))
+           (if chapterref (add-chapter-index-item! chapterref 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
-           (if alttitle (add-to-toc! alttitle (cons (list (cons 'rawtext alttitle) (cons 'alternative #t)) '())))
+           (if starttext (add-to-toc! starttext #t))
-           (if altalttitle (add-to-toc! altalttitle (cons (list (cons 'rawtext altalttitle) (cons 'alternative #t)) '())))
+           (if alttitle
-           (if title (add-to-toc! title (cons (list (cons 'rawtext title)) '())) #{ #})
+               (if (list? alttitle)
+                   (for-each (lambda (alt)
+                                (add-to-toc! alt #t))
+                             alttitle)
+                   (add-to-toc! alttitle #t)))
+           (if title (add-to-toc! title #f) #{ #})
     ))
 
 
@@ -318,6 +370,9 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
 #(define csv-write sxml->csv)
 
 #(define-markup-command (write-toc-csv layout props) ()
+  ;; Dateiname wie bei \write-book-yaml/\write-book-chordpro: der
+  ;; Ausgabename des Buchs mit angehaengtem .csv statt fest "toc.csv".
+  (define csv-filename (string-append (ly:parser-output-name) ".csv"))
   (define (csv-escape field)
     (if (string-null? field)
         field
@@ -353,9 +408,9 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
     (let ((song-lines (map (lambda (song)
             (let* ((filename (symbol->string (car song)))
                    (songvars (cdr song))
-                   (page-number (number->string (assoc-get (assq-ref songvars 'label) labelPageTable)))
+                   (page-number (assoc-get (assq-ref songvars 'label) labelPageTable))
                    (extractedheadervars (extract-and-check-vars-from-header (assq-ref songvars 'header)
-                      '(title starttext alttitle altalttitle categorytitle categories authors year_text year_melody year_translation year_composition 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)
                      (let ((extracted (assq-ref extractedheadervars varsym)))
                        (if extracted extracted ""))))
@@ -365,8 +420,11 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
                    (versePoetData (find-author-id-with-part-numbers 'verse authors))
                    (composerIds (find-author-ids-by 'melody authors))
                    (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
+                   (refComposerIds (find-author-ids-by 'meloref authors))
                    (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
                    (compositionIds (find-author-ids-by 'composition authors))
+                   (adaptionTextIds (find-author-ids-by 'adaption_text authors))
+                   (adaptionMusicIds (find-author-ids-by 'adaption_music authors))
                    (bridgeIds (find-author-ids-by 'bridge authors))
                    (interludeIds (find-author-ids-by 'interlude authors)))
               (map csv-escape
@@ -375,25 +433,30 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
                   page-number
                   (headervar-or-empty 'title)
                   (headervar-or-empty 'starttext)
-                  (headervar-or-empty 'alttitle)
+                  (let ((alttitle-value (headervar-or-empty 'alttitle)))
-                  (headervar-or-empty 'altalttitle)
+                    (if (list? alttitle-value)
+                        (string-join alttitle-value ", ")  ; Wenn eine Liste, dann zusammenfügen
+                        alttitle-value))  ; Wenn kein Liste, den originalen Wert verwenden
+
                   (headervar-or-empty 'categorytitle)
                   (headervar-or-empty 'categories)
-                  (format-authors (append poetIds (map car versePoetData)))
+                  (format-authors (append poetIds adaptionTextIds (map car versePoetData)))
                   (format-authors translatorIds)
-                  (format-authors (append composerIds compositionIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
+                  (format-authors (append composerIds compositionIds adaptionMusicIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData) refComposerIds))
                   (headervar-or-empty 'year_text)
                   (headervar-or-empty 'year_melody)
                   (headervar-or-empty 'year_translation)
                   (headervar-or-empty 'year_composition)
+                  (headervar-or-empty 'year_adaption_text)
+                  (headervar-or-empty 'year_adaption_music)
                   (headervar-or-empty 'copyright)
                   (headervar-or-empty 'source)
                   (format-info-paragraphs (headervar-or-empty 'infotext))
                   (format-info-paragraphs (headervar-or-empty 'translation))
                   (format-info-paragraphs (headervar-or-empty 'pronunciation))
               ))))
-            (alist-delete 'imagePage (alist-delete 'emptyPage song-list)))))
+            (alist-delete 'markupPage (alist-delete 'imagePage (alist-delete 'emptyPage song-list))))))
-    (call-with-output-file "toc.csv"
+    (call-with-output-file csv-filename
       (lambda (port)
        (csv-write (cons '(
         "filename"
@@ -401,7 +464,6 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
         "title"
         "starttext"
         "alttitle"
-        "altalttitle"
         "categorytitle"
         "categories"
         "poets"
@@ -411,6 +473,8 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
         "year_melody"
         "year_translation"
         "year_composition"
+        "year_adaption_text"
+        "year_adaption_music"
         "copyright"
         "source"
         "infotext"
@@ -421,6 +485,6 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
   ; we use a delayed stencil to have all the page references available
   (ly:make-stencil
     `(delay-stencil-evaluation
-      ,(delay (let* ((table (ly:output-def-lookup layout 'label-page-table)))
+      ,(delay (let* ((table (ly:output-def-lookup layout 'label-page-string-table)))
         (generate-toc-csv (if (list? table) table '()))
         empty-stencil)))))

private_includes/book/transliteration.ily

@@ -0,0 +1,65 @@
+#(define (transliterate-de str)
+   "Gesamte Transliteration: entfernt Diakritika, ersetzt Sonderzeichen, ergibt ASCII-String."
+
+   (define (remove-diacritics s)
+     (string-join
+       (map (lambda (ch)
+             (let ((code (char->integer ch)))
+               ;; Unicode-Bereich 0300–036F = Combining Diacritical Marks
+               (if (and (>= code #x0300) (<= code #x036F))
+                   ""
+                   (string ch))))
+           (string->list (string-normalize-nfkd s)))
+       ""))
+
+   (define transliteration-table
+     '(
+      ;; Deutsche Umlaute & ß
+      ("ä" . "ae") ("ö" . "oe") ("ü" . "ue")
+      ("Ä" . "Ae") ("Ö" . "Oe") ("Ü" . "Ue")
+      ("ß" . "ss")
+
+      ;; Balkan & mitteleuropäische Sonderzeichen
+      ("Č" . "C") ("č" . "c")
+      ("Š" . "S") ("š" . "s")
+      ("Ž" . "Z") ("ž" . "z")
+      ("Đ" . "D") ("đ" . "d")
+      ("Ł" . "L") ("ł" . "l")
+      ("Ø" . "O") ("ø" . "o")
+      ("Æ" . "Ae") ("æ" . "ae")
+      ("Œ" . "Oe") ("œ" . "oe")
+
+      ;; Kyrillische Buchstaben mit lateinischen Pendants
+      ("А" . "A") ("а" . "a")
+      ("Б" . "B") ("б" . "b")
+      ("В" . "V") ("в" . "v")
+      ("Г" . "G") ("г" . "g")
+      ("Д" . "D") ("д" . "d")
+      ("Е" . "E") ("е" . "e")
+      ("З" . "Z") ("з" . "z")
+      ("И" . "I") ("и" . "i")
+      ("К" . "K") ("к" . "k")
+      ("Л" . "L") ("л" . "l")
+      ("М" . "M") ("м" . "m")
+      ("Н" . "N") ("н" . "n")
+      ("О" . "O") ("о" . "o")
+      ("П" . "P") ("п" . "p")
+      ("Р" . "R") ("р" . "r")
+      ("С" . "S") ("с" . "s")
+      ("Т" . "T") ("т" . "t")
+      ("У" . "U") ("у" . "u")
+      ("Ф" . "F") ("ф" . "f")
+      ("Х" . "Kh") ("х" . "kh")
+      ("Ц" . "Ts") ("ц" . "ts")
+      ("Ч" . "Ch") ("ч" . "ch")
+      ("Ш" . "Sh") ("ш" . "sh")
+      ("Щ" . "Sch") ("щ" . "sch")
+      ("Я" . "Ja") ("я" . "ja")
+      ("Ю" . "Ju") ("ю" . "ju")
+      ("Й" . "J") ("й" . "j")
+    ))
+
+  (remove-diacritics
+    (fold (lambda (pair acc)
+          (ly:string-substitute (car pair) (cdr pair) acc))
+        str transliteration-table)))

public_includes/book_top.ily

@@ -0,0 +1,4 @@
+\include "../private_includes/book/book_include.ily"
+\include "../private_includes/book/transliteration.ily"
+\include "../private_includes/book/toc_include.ily"
+\include "../private_includes/book/appendix.ily"

public_includes/layout_bottom.ily

@@ -0,0 +1,153 @@
+MUSIC = { \transposable #TRANSPOSITION \MUSIC }
+
+LAYOUT = \layout {
+  \LAYOUT
+  #(customized-layout LAYOUT)
+}
+
+verselayout = \layout {
+  \LAYOUT
+  \context {
+    \ChordNames
+    \override ChordName.font-size = \songTextChordFontSize
+  }
+}
+
+TEXT = \markuplist {
+  \override #`(transposition . ,TRANSPOSITION)
+  \override #`(verselayout . ,verselayout)
+  \override #`(verse-chords . ,#{ \chords { \verseChords } #})
+  \override #`(verse-reference-voice . ,#{ \global \firstVoice  #})
+  \handle-tag-groups \recordedTagGroups
+  \TEXT
+}
+
+#(define TEXT_PAGES
+  (map
+    (lambda (text) #{
+      \markuplist {
+        \override #`(transposition . ,TRANSPOSITION)
+        \override #`(verselayout . ,verselayout)
+        \override #`(verse-chords . ,#{ \chords { \verseChords } #})
+        \override #`(verse-reference-voice . ,#{ \global \firstVoice  #})
+        \handle-tag-groups \recordedTagGroups
+        #text
+      }
+    #})
+  (if
+    (and
+      (defined? 'TEXT_PAGES)
+      (pair? TEXT_PAGES))
+    TEXT_PAGES
+    (list TEXT))))
+
+%% Add invisible ChordPro write trigger to last TEXT_PAGES markuplist
+#(when (and (defined? 'chordpro-export-enabled) chordpro-export-enabled (pair? TEXT_PAGES))
+  (let* ((last-index (- (length TEXT_PAGES) 1))
+         (last-page (list-ref TEXT_PAGES last-index))
+         (modified-last-page #{
+           \markuplist {
+             #last-page
+             \chordpro-delayed-write
+           }
+         #}))
+    (set! TEXT_PAGES
+      (append (list-head TEXT_PAGES last-index)
+              (list modified-last-page)))))
+
+#(define (add-text-pages text-pages)
+  (if (pair? text-pages)
+    (begin
+      (add-score (car text-pages))
+      (for-each
+        (lambda (text)
+          (add-music (pageBreak))
+          (add-score text))
+        (cdr text-pages)))))
+
+#(if (not noStandaloneOutput)
+(begin
+  (let ((header (ly:book-header HEADER)) (paper (ly:book-paper HEADER)))
+    (if header (set! $defaultheader header))
+    (if paper (set! $defaultpaper paper))
+  )
+
+  ;; Meta-Daten des Liedes als YAML neben die Ausgabedatei schreiben
+  ;; (<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)
+    (set! chordpro-default-song-key (ly:parser-output-name))
+    (chordpro-register-song-metadata chordpro-default-song-key HEADER))
+
+  ;; 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 #{
+      \score {
+        \MUSIC
+        \layout { \LAYOUT }
+      }#}))
+  (add-text-pages TEXT_PAGES)
+
+  (add-score #{
+    \score {
+      \unfoldRepeats { \MUSIC \INLINESCOREMUSIC }
+      \midi {
+        \context {
+          \Staff
+          \remove "Staff_performer"
+        }
+        \context {
+          \Voice
+          \consists "Staff_performer"
+        }
+      }
+    }#})
+))

public_includes/layout_top.ily

@@ -1,6 +1,5 @@
-\version "2.25.8"
 #(ly:set-option 'relative-includes #t)
 
 #(define noDefaultOutput #t)
 
-\include "all_base_includes.ly"
+\include "../private_includes/base/all.ily"

public_includes/pool_bottom.ily

@@ -4,4 +4,4 @@ HEADER = \bookpart {
     \basicSongInfo
   }
 }
-\include #(if noDefaultOutput "void.ly" "standalone_output.ly")
+\include #(if noDefaultOutput "../private_includes/void.ily" "layout_bottom.ily")

public_includes/pool_top.ily

@@ -2,4 +2,4 @@
 
 #(define noDefaultOutput (if (defined? 'noDefaultOutput) noDefaultOutput #f))
 
-\include #(if noDefaultOutput "void.ly" "all_base_includes.ly")
+\include #(if noDefaultOutput "../private_includes/void.ily" "../private_includes/base/all.ily")

scm/json_parser.scm

@@ -1,482 +0,0 @@
-;;; (json parser) --- Guile JSON implementation.
-
-;; Copyright (C) 2013-2020 Aleix Conchillo Flaque <aconchillo@gmail.com>
-;;
-;; This file is part of guile-json.
-;;
-;; guile-json is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3 of the License, or
-;; (at your option) any later version.
-;;
-;; guile-json is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with guile-json. If not, see https://www.gnu.org/licenses/.
-
-;;; Commentary:
-
-;; JSON module for Guile
-
-;;; Code:
-
-(define-module (json parser)
-  #:use-module (ice-9 rdelim)
-  #:use-module (ice-9 streams)
-  #:use-module (rnrs io ports)
-  #:export (json->scm
-            json-string->scm
-            json-seq->scm
-            json-seq-string->scm))
-
-;;
-;; Miscellaneuos helpers
-;;
-
-(define (json-exception port)
-  (throw 'json-invalid port))
-
-(define (digit? c)
-  (case c
-    ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) #t)
-    (else #f)))
-
-(define (whitespace? c)
-  (case c
-    ((#\sp #\ht #\lf #\cr) #t)
-    (else #f)))
-
-(define (control-char? ch)
-  (<= (char->integer ch) #x1F))
-
-(define (skip-whitespaces port)
-  (let ((ch (peek-char port)))
-    (cond
-     ((whitespace? ch)
-      (read-char port)
-      (skip-whitespaces port))
-     (else *unspecified*))))
-
-(define (expect-string port expected return)
-  (let loop ((n 0))
-    (cond
-     ;; All characters match.
-     ((= n (string-length expected)) return)
-     ;; Go to next characters.
-     ((eqv? (read-char port) (string-ref expected n))
-      (loop (+ n 1)))
-     ;; Anything else is an error.
-     (else (json-exception port)))))
-
-(define (expect-delimiter port delimiter)
-  (let ((ch (read-char port)))
-    (cond
-     ((not (eqv? ch delimiter)) (json-exception port))
-     ;; Unexpected EOF.
-     ((eof-object? ch) (json-exception port)))))
-
-(define (skip-record-separators port)
-  (when (eqv? #\rs (peek-char port))
-    (read-char port)
-    (skip-record-separators port)))
-
-;;
-;; Number parsing helpers
-;;
-
-(define (expect-digit port)
-  (let ((ch (peek-char port)))
-    (cond
-     ((not (digit? ch)) (json-exception port))
-     ;; Unexpected EOF.
-     ((eof-object? ch) (json-exception port)))))
-
-;; Read + or -, and return 1 or -1 respectively. If something different is
-;; found, return 1.
-(define (read-sign port)
-  (let ((ch (peek-char port)))
-    (cond
-     ((eqv? ch #\+)
-      (read-char port)
-      1)
-     ((eqv? ch #\-)
-      (read-char port)
-      -1)
-     (else 1))))
-
-(define (read-digit-value port)
-  (let ((ch (read-char port)))
-    (cond
-     ((eqv? ch #\0) 0)
-     ((eqv? ch #\1) 1)
-     ((eqv? ch #\2) 2)
-     ((eqv? ch #\3) 3)
-     ((eqv? ch #\4) 4)
-     ((eqv? ch #\5) 5)
-     ((eqv? ch #\6) 6)
-     ((eqv? ch #\7) 7)
-     ((eqv? ch #\8) 8)
-     ((eqv? ch #\9) 9)
-     (else (json-exception port)))))
-
-;; Read digits [0..9].
-(define (read-digits port)
-  (expect-digit port)
-  (let loop ((ch (peek-char port)) (number 0))
-    (cond
-     ((digit? ch)
-      (let ((value (read-digit-value port)))
-        (loop (peek-char port) (+ (* number 10) value))))
-     (else number))))
-
-(define (read-digits-fraction port)
-  (expect-digit port)
-  (let loop ((ch (peek-char port)) (number 0) (length 0))
-    (cond
-     ((digit? ch)
-      (let ((value (read-digit-value port)))
-        (loop (peek-char port) (+ (* number 10) value) (+ length 1))))
-     (else
-      (/ number (expt 10 length))))))
-
-(define (read-exponent port)
-  (let ((ch (peek-char port)))
-    (cond
-     ((or (eqv? ch #\e) (eqv? ch #\E))
-      (read-char port)
-      (let ((sign (read-sign port))
-            (digits (read-digits port)))
-        (if (<= digits 1000) ;; Some maximum exponent.
-            (expt 10 (* sign digits))
-            (json-exception port))))
-     (else 1))))
-
-(define (read-fraction port)
-  (let ((ch (peek-char port)))
-    (cond
-     ((eqv? ch #\.)
-      (read-char port)
-      (read-digits-fraction port))
-     (else 0))))
-
-(define (read-positive-number port)
-  (let* ((number
-          (let ((ch (peek-char port)))
-            (cond
-             ;; Numbers that start with 0 must be a fraction.
-             ((eqv? ch #\0)
-              (read-char port)
-              0)
-             ;; Otherwise read more digits.
-             (else (read-digits port)))))
-         (fraction (read-fraction port))
-         (exponent (read-exponent port))
-         (result (* (+ number fraction) exponent)))
-    (if (and (zero? fraction) (>= exponent 1))
-        result
-        (exact->inexact result))))
-
-(define (json-read-number port)
-  (let ((ch (peek-char port)))
-    (cond
-     ;; Negative numbers.
-     ((eqv? ch #\-)
-      (read-char port)
-      (expect-digit port)
-      (* -1 (read-positive-number port)))
-     ;; Positive numbers.
-     ((digit? ch)
-      (read-positive-number port))
-     ;; Anything else is an error.
-     (else (json-exception port)))))
-
-;;
-;; Object parsing helpers
-;;
-
-(define (read-pair port null ordered)
-  ;; Read key.
-  (let ((key (json-read-string port)))
-    (skip-whitespaces port)
-    (let ((ch (peek-char port)))
-      (cond
-       ;; Skip colon and read value.
-       ((eqv? ch #\:)
-        (read-char port)
-        (cons key (json-read port null ordered)))
-       ;; Anything other than colon is an error.
-       (else (json-exception port))))))
-
-(define (json-read-object port null ordered)
-  (expect-delimiter port #\{)
-  (let loop ((pairs '()) (added #t))
-    (skip-whitespaces port)
-    (let ((ch (peek-char port)))
-      (cond
-       ;; End of object.
-       ((eqv? ch #\})
-        (read-char port)
-        (cond
-         (added (if ordered (reverse! pairs) pairs))
-         (else (json-exception port))))
-       ;; Read one pair and continue.
-       ((eqv? ch #\")
-        (let ((pair (read-pair port null ordered)))
-          (loop (cons pair pairs) #t)))
-       ;; Skip comma and read more pairs.
-       ((eqv? ch #\,)
-        (read-char port)
-        (cond
-         (added (loop pairs #f))
-         (else (json-exception port))))
-       ;; Invalid object.
-       (else (json-exception port))))))
-
-;;
-;; Array parsing helpers
-;;
-
-(define (json-read-array port null ordered)
-  (expect-delimiter port #\[)
-  (skip-whitespaces port)
-  (cond
-   ;; Special case when array is empty.
-   ((eqv? (peek-char port) #\])
-    (read-char port)
-    #())
-   (else
-    ;; Read first element in array.
-    (let loop ((values (list (json-read port null ordered))))
-      (skip-whitespaces port)
-      (let ((ch (peek-char port)))
-        (cond
-         ;; Unexpected EOF.
-         ((eof-object? ch) (json-exception port))
-         ;; Handle comma (if there's a comma there should be another element).
-         ((eqv? ch #\,)
-          (read-char port)
-          (loop (cons (json-read port null ordered) values)))
-         ;; End of array.
-         ((eqv? ch #\])
-          (read-char port)
-          (list->vector (reverse! values)))
-         ;; Anything else other than comma and end of array is wrong.
-         (else (json-exception port))))))))
-
-;;
-;; String parsing helpers
-;;
-
-(define (read-hex-digit->integer port)
-  (let ((ch (read-char port)))
-    (cond
-     ((eqv? ch #\0) 0)
-     ((eqv? ch #\1) 1)
-     ((eqv? ch #\2) 2)
-     ((eqv? ch #\3) 3)
-     ((eqv? ch #\4) 4)
-     ((eqv? ch #\5) 5)
-     ((eqv? ch #\6) 6)
-     ((eqv? ch #\7) 7)
-     ((eqv? ch #\8) 8)
-     ((eqv? ch #\9) 9)
-     ((or (eqv? ch #\A) (eqv? ch #\a)) 10)
-     ((or (eqv? ch #\B) (eqv? ch #\b)) 11)
-     ((or (eqv? ch #\C) (eqv? ch #\c)) 12)
-     ((or (eqv? ch #\D) (eqv? ch #\d)) 13)
-     ((or (eqv? ch #\E) (eqv? ch #\e)) 14)
-     ((or (eqv? ch #\F) (eqv? ch #\f)) 15)
-     (else (json-exception port)))))
-
-(define (read-unicode-value port)
-  (+ (* 4096 (read-hex-digit->integer port))
-      (* 256 (read-hex-digit->integer port))
-      (* 16 (read-hex-digit->integer port))
-      (read-hex-digit->integer port)))
-
-;; Unicode codepoint with surrogates is:
-;;   10000 + (high - D800) + (low - DC00)
-;; which is equivalent to:
-;;  (high << 10) + low - 35FDC00
-;; see
-;;   https://github.com/aconchillo/guile-json/issues/58#issuecomment-662744070
-(define (json-surrogate-pair->unicode high low)
-  (+ (* high #x400) low #x-35FDC00))
-
-(define (read-unicode-char port)
-  (let ((codepoint (read-unicode-value port)))
-    (cond
-     ;; Surrogate pairs. `codepoint` already contains the higher surrogate
-     ;; (between D800 and DC00) . At this point we are expecting another
-     ;; \uXXXX that holds the lower surrogate (between DC00 and DFFF).
-     ((and (>= codepoint #xD800) (< codepoint #xDC00))
-      (expect-string port "\\u" #f)
-      (let ((low-surrogate (read-unicode-value port)))
-        (if (and (>= low-surrogate #xDC00) (< low-surrogate #xE000))
-            (integer->char (json-surrogate-pair->unicode codepoint low-surrogate))
-            (json-exception port))))
-     ;; Reserved for surrogates (we just need to check starting from the low
-     ;; surrogates).
-     ((and (>= codepoint #xDC00) (< codepoint #xE000))
-      (json-exception port))
-     (else (integer->char codepoint)))))
-
-(define (read-control-char port)
-  (let ((ch (read-char port)))
-    (cond
-     ((eqv? ch #\") #\")
-     ((eqv? ch #\\) #\\)
-     ((eqv? ch #\/) #\/)
-     ((eqv? ch #\b) #\bs)
-     ((eqv? ch #\f) #\ff)
-     ((eqv? ch #\n) #\lf)
-     ((eqv? ch #\r) #\cr)
-     ((eqv? ch #\t) #\ht)
-     ((eqv? ch #\u) (read-unicode-char port))
-     (else (json-exception port)))))
-
-(define (json-read-string port)
-  (expect-delimiter port #\")
-  (let loop ((chars '()) (ch (read-char port)))
-    (cond
-     ;; Unexpected EOF.
-     ((eof-object? ch) (json-exception port))
-     ;; Unescaped control characters are not allowed.
-     ((control-char? ch) (json-exception port))
-     ;; End of string.
-     ((eqv? ch #\") (reverse-list->string chars))
-     ;; Escaped characters.
-     ((eqv? ch #\\)
-      (loop (cons (read-control-char port) chars) (read-char port)))
-     ;; All other characters.
-     (else
-      (loop (cons ch chars) (read-char port))))))
-
-;;
-;; Booleans and null parsing helpers
-;;
-
-(define (json-read-true port)
-  (expect-string port "true" #t))
-
-(define (json-read-false port)
-  (expect-string port "false" #f))
-
-(define (json-read-null port null)
-  (expect-string port "null" null))
-
-;;
-;; Main parser functions
-;;
-
-(define (json-read port null ordered)
-  (skip-whitespaces port)
-  (let ((ch (peek-char port)))
-    (cond
-     ;; Unexpected EOF.
-     ((eof-object? ch) (json-exception port))
-     ;; Read JSON values.
-     ((eqv? ch #\t) (json-read-true port))
-     ((eqv? ch #\f) (json-read-false port))
-     ((eqv? ch #\n) (json-read-null port null))
-     ((eqv? ch #\{) (json-read-object port null ordered))
-     ((eqv? ch #\[) (json-read-array port null ordered))
-     ((eqv? ch #\") (json-read-string port))
-     ;; Anything else should be a number.
-     (else (json-read-number port)))))
-
-;;
-;; Public procedures
-;;
-
-(define* (json->scm #:optional (port (current-input-port))
-                    #:key (null 'null) (ordered #f) (concatenated #f))
-  "Parse a JSON document into native. Takes one optional argument,
-@var{port}, which defaults to the current input port from where the JSON
-document is read. It also takes a few of keyword arguments: @{null}: value for
-JSON's null, it defaults to the 'null symbol, @{ordered} to indicate whether
-JSON objects order should be preserved or not (the default) and @{concatenated}
-which can be used to tell the parser that more JSON documents might come after a
-properly parsed document."
-  (let loop ((value (json-read port null ordered)))
-    ;; Skip any trailing whitespaces.
-    (skip-whitespaces port)
-    (cond
-     ;; If we reach the end the parsing succeeded.
-     ((eof-object? (peek-char port)) value)
-     ;; If there's anything else other than the end, check if user wants to keep
-     ;; parsing concatenated valid JSON documents, otherwise parser fails.
-     (else
-      (cond (concatenated value)
-            (else (json-exception port)))))))
-
-(define* (json-string->scm str #:key (null 'null) (ordered #f))
-  "Parse a JSON document into native. Takes a string argument,
-@var{str}, that contains the JSON document. It also takes a couple of keyword
-argument: @{null}: value for JSON's null, it defaults to the 'null symbol and
-@{ordered} to indicate whether JSON objects order should be preserved or
-not (the default)."
-  (call-with-input-string str (lambda (p) (json->scm p #:null null #:ordered ordered))))
-
-(define* (json-seq->scm #:optional (port (current-input-port))
-                        #:key (null 'null) (ordered #f)
-                        (handle-truncate 'skip) (truncated-object 'truncated))
-  "Lazy parse a JSON text sequence from the port @var{port}.
-This procedure returns a stream of parsed documents. The optional argument
-@var{port} defines the port to read from and defaults to the current input
-port. It also takes a few keyword arguments: @{null}: value for JSON's null
-(defaults to the 'null symbol), @{ordered} to indicate whether JSON objects
-order should be preserved or not (the default), @{handle-truncate}: defines how
-to handle data loss, @{truncated-object}: used to replace unparsable
-objects. Allowed values for @{handle-truncate} argument are 'throw (throw an
-exception), 'stop (stop parsing and end the stream), 'skip (default, skip
-corrupted fragment and return the next entry), 'replace (skip corrupted fragment
-and return @{truncated-object} instead)."
-  (letrec ((handle-truncation
-            (case handle-truncate
-              ((throw) json-exception)
-              ((stop) (const (eof-object)))
-              ((skip)
-               (lambda (port)
-                 (read-delimited "\x1e" port 'peek)
-                 (read-entry port)))
-              ((replace)
-               (lambda (port)
-                 (read-delimited "\x1e" port 'peek)
-                 truncated-object))))
-           (read-entry
-            (lambda (port)
-              (let ((ch (read-char port)))
-                (cond
-                 ((eof-object? ch) ch)
-                 ((not (eqv? ch #\rs))
-                  (handle-truncation port))
-                 (else
-                  (skip-record-separators port)
-                  (catch 'json-invalid
-                    (lambda ()
-                      (let ((next (json-read port null ordered)))
-                        (if (eqv? #\lf (peek-char port))
-                            (begin
-                              (read-char port)
-                              next)
-                            (handle-truncation port))))
-                    (lambda (_ port)
-                      (handle-truncation port)))))))))
-    (port->stream port read-entry)))
-
-(define* (json-seq-string->scm str #:key (null 'null) (ordered #f)
-                               (handle-truncate 'skip) (truncated-object 'truncated))
-  "Lazy parse a JSON text sequence from the string @var{str}.
-This procedure returns a stream of parsed documents and also takes the same
-keyword arguments as @code{json-seq->scm}."
-  (call-with-input-string str
-    (lambda (p)
-      (json-seq->scm p #:null null #:ordered ordered
-                     #:handle-truncate handle-truncate
-                     #:truncated-object truncated-object))))
-
-;;; (json parser) ends here

scm/yaml_parser.scm

@@ -1,12 +0,0 @@
-(use-modules (ice-9 popen) (ice-9 textual-ports) (json parser))
-
-(define (yml-file->scm filename)
-  (let* ((python_cmd (string-append "import sys, yaml, json; print(json.dumps(yaml.safe_load(open('" filename "'))))"))
-          ; WTF? On Windows there is "py" and we need to specify the encoding, on linux there is "python3" or "python"
-          ; but "python3" seems to work better. Be sure you have PyYAML installed.
-          (pipe (open-pipe* OPEN_READ (if windows? "py" "python3") "-X" "utf8" "-c" python_cmd))
-          (json (get-string-all pipe)))
-    (close-pipe pipe)
-    (json-string->scm json)))
-
-(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))

standalone_output.ly

@@ -1,60 +0,0 @@
-% set the speed of the midi music
-#(define midiQuarterNoteSpeed (if (defined? 'midiQuarterNoteSpeed) midiQuarterNoteSpeed 90))
-
-MUSIC = { \transposable #TRANSPOSITION \MUSIC }
-
-verselayout = \layout {
-  \LAYOUT
-  \context {
-    \ChordNames
-    \override ChordName.font-size = \songTextChordFontSize
-  }
-}
-
-LAYOUT = \layout {
-  \LAYOUT
-  #(let
-    ((custom-size (ly:output-def-lookup LAYOUT 'size #f)))
-    (if custom-size (layout-set-staff-size custom-size)))
-}
-
-TEXT = \markuplist {
-  \override #`(transposition . ,TRANSPOSITION)
-  \override #`(verselayout . ,verselayout)
-  \override #`(verse-chords . ,#{ \chords { \verseChords } #})
-  \override #`(verse-reference-voice . ,#{ \global \firstVoice  #})
-  \TEXT
-}
-
-#(if (not noStandaloneOutput)
-(begin
-  (let ((header (ly:book-header HEADER)) (paper (ly:book-paper HEADER)))
-    (if header (set! $defaultheader header))
-    (if paper (set! $defaultpaper paper))
-  )
-  (add-score #{
-    \score {
-      \MUSIC
-      \layout { \LAYOUT }
-    }#})
-  (add-score TEXT)
-  (add-score #{
-    \score {
-      \unfoldRepeats { \MUSIC \INLINESCOREMUSIC }
-      \midi {
-        \context {
-          \Score
-          % Tempo des midi files
-          tempoWholesPerMinute = #(/ midiQuarterNoteSpeed 4)
-        }
-        \context {
-          \Staff
-          \remove "Staff_performer"
-        }
-        \context {
-          \Voice
-          \consists "Staff_performer"
-        }
-      }
-    }#})
-))

styles.ly

@@ -1,16 +0,0 @@
-#(define bookStyle
-  (if (not (defined? 'bookStyle))
-      #f
-      bookStyle))
-
-#(define songStyle
-  (if (not (defined? 'songStyle))
-      (if (not (defined? 'defaultSongStyle)) 'default defaultSongStyle)
-      songStyle))
-
-#(if (not (boolean? bookStyle))
-         (set! songStyle bookStyle))
-
-#(define (bock-style layout props)
-  "Whether we have bockstyle or not"
-  (eq? songStyle 'bock))

title_with_category_images.ly

@@ -1,66 +0,0 @@
-#(define-markup-command (bookTitleMarkupCustom layout props)()
-   (interpret-markup layout
-     (prepend-alist-chain 'defaultmarkup #{
-\markup {
-  \override #'(baseline-skip . 3.5)
-  \center-column {
-    \override #`(font-name . ,songTitleFont) { \fontsize #songTitleSize \fromproperty #'header:title }
-    \large \bold \fromproperty #'header:subtitle
-    \smaller \bold \fromproperty #'header:subsubtitle
-  }
-}
-                           #}
-     (prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props))
-     (make-column-markup
-       (list
-         (make-vspace-markup (chain-assoc-get 'header:titletopspace props 0))
-         (make-customEps-markup (chain-assoc-get 'header:titlesize props 3.5) "titel.eps")
-     ))
-))
-
-#(define-markup-command (category-image layout props size category)(number? string?)
-   (interpret-markup layout props
-     (if noStandaloneOutput
-       (make-epsfileref-markup Y size
-         (category-image-path category))
-       (make-epsfile-markup Y size
-         (category-image-path category)))))
-
-#(define showCategoryImages (if (defined? 'showCategoryImages) showCategoryImages #t))
-
-#(define-markup-command (category-images layout props)()
-   (interpret-markup layout props
-     (if showCategoryImages
-       (make-line-markup (map (lambda (category) (make-category-image-markup 5 category))
-           (string-tokenize (chain-assoc-get 'header:categories props ""))))
-       (make-null-markup))))
-
-#(define pdf-encode (@@ (lily framework-ps) pdf-encode))
-% PDF tags
-#(define-markup-command (title-to-pdf-toc layout props title) (string?)
-     (ly:make-stencil
-      (list 'embedded-ps
-             (ly:format
-              "[/Action /GoTo /View [/XYZ -4 currentpagedevice /PageSize get 1 get 4 add null] /Title (~a) /OUT pdfmark" (pdf-encode title)))
-      empty-interval empty-interval
-      ;'(0 . 0) '(0 . 0)
-      ))
-
-#(define-markup-command (title-with-category-images layout props right)(boolean?)
-   (interpret-markup layout props
-     (let* ((title (chain-assoc-get 'header:title props ""))
-            (starttext (chain-assoc-get 'header:starttext props #f))
-            (pdfbookmark (if starttext (string-append starttext " | " title) title)))
-     (if title
-       (if right
-         #{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \category-images } } #}
-         #{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } } #})
-      #{ \markup { " " } #})
-     )))
-
-\paper {
-  bookTitleMarkup = \markup \null
-  scoreTitleMarkup = \markup \null
-  oddHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##t }
-  evenHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##f }
-}