fix pdf page numbering

private_includes/base/all.ily

@@ -19,12 +19,12 @@
         (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 "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"

private_includes/base/basic_format_and_style_settings.ily

@@ -44,7 +44,7 @@ generalLayout = \layout {
   \context {
     \Staff
     \accidentalStyle modern-voice-cautionary
-    \consists Merge_rests_engraver
+    \consists \Better_Merge_rests_engraver
   }
   \context {
     \Score
@@ -67,6 +67,7 @@ generalLayout = \layout {
     % 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
@@ -83,12 +84,14 @@ 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 Accidental.color = #grey
   \override NoteHead.layer = 1
+  \override Rest.layer = 1
   \override Dots.layer = 1
   \override Stem.layer = 1
   \override Flag.layer = 1
@@ -98,6 +101,7 @@ secondVoiceStyle = {
 
 firstVoiceStyle = {
   \override NoteHead.color = #black
+  \override Rest.color = #black
   \override Dots.color = #black
   \override Stem.color = #black
   \override Flag.color = #black

private_includes/base/default_songinfo_style.ily

@@ -2,11 +2,14 @@
   poetPrefix = "Worte:"
   composerPrefix = "Weise:"
   compositionPrefix = "Satz:"
-  adaptionPrefix = "Bearbeitung:"
+  adaptionTextPrefix = "Bearbeitung Text:"
+  adaptionMusicPrefix = "Bearbeitung Musik:"
   poetAndComposerEqualPrefix = "Worte und Weise:"
   voicePrefix = "Stimme:"
   versePrefix = "Strophe:"
+  translationAuthorPrefix = "Übersetzung:"
   translationPrefix = "Übersetzung:"
+  pronunciationPrefix = "Aussprache:"
   interludePrefix = "Zwischenspiel:"
   bridgePrefix = "Bridge:"
 
@@ -42,8 +45,6 @@
               (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)))
               (string-with-paragraphs->markuplist (lambda (prefix text)
                 (if text
                   (apply append
@@ -51,22 +52,26 @@
                       (lambda (paragraph)
                         (make-wordwrap-internal-markup-list #t
                           #{ \markuplist { $(ly:parser-include-string paragraph) } #}))
-                      (ly:regex-split (ly:make-regex "\n[ \t\n]*\n[ \t\n]*") text)))
-                  '()))))
+                      (ly:regex-split (ly:make-regex "\n[ \t\n]*\n[ \t\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)
-                  (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
+                  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 "Übersetzung: " translation)
-                (string-with-paragraphs->markuplist "Aussprache: " pronunciation)
+                (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/footer_with_songinfo.ily

@@ -102,16 +102,28 @@
             (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
             (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
             (compositionIds (find-author-ids-by 'composition authors))
-            (adaptionIds (find-author-ids-by 'adaption 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))
             (year_text (chain-assoc-get 'header:year_text props #f))
             (year_translation (chain-assoc-get 'header:year_translation props #f))
             (year_melody (chain-assoc-get 'header:year_melody props #f))
             (year_composition (chain-assoc-get 'header:year_composition props #f))
-            (year_adaption (chain-assoc-get 'header:year_adaption props #f))
+            (year_adaption_text (chain-assoc-get 'header:year_adaption_text props #f))
+            (year_adaption_music (chain-assoc-get 'header:year_adaption_music props #f))
             )
-        (if (and (equal? poetIds composerIds) (null? translatorIds) (null? versePoetData) (null? verseComposerData) (null? voiceComposerData) (null? compositionIds) (null? adaptionIds) (null? bridgeIds) (null? interludeIds))
+        (if (and
+              (equal? poetIds composerIds)
+              (null? translatorIds)
+              (null? versePoetData)
+              (null? verseComposerData)
+              (null? voiceComposerData)
+              (null? compositionIds)
+              (null? adaptionTextIds)
+              (null? adaptionMusicIds)
+              (null? bridgeIds)
+              (null? interludeIds))
           (list
             (join-present (list
               (render-contribution-group (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) poetIds)
@@ -130,12 +142,23 @@
                   ) ", ")
                   (render-partial-contribution-group 'versePrefix versePoetData)
                   (join-present (list
-                    (render-contribution-group (ly:output-def-lookup layout 'translationPrefix) translatorIds)
+                    (render-contribution-group (ly:output-def-lookup layout 'translationAuthorPrefix) translatorIds)
                     year_translation
                   ) ", ")
+                  (join-present (list
+                    (render-contribution-group (ly:output-def-lookup layout 'adaptionTextPrefix) adaptionTextIds)
+                    year_adaption_text
+                  ) ", ")
                 ) "; ")
               ))
-            (if (and (null? composerIds) (null? compositionIds) (null? adaptionIds) (null? verseComposerData) (null? voiceComposerData) (null? bridgeIds) (null? interludeIds)) #f
+            (if (and
+                  (null? composerIds)
+                  (null? compositionIds)
+                  (null? adaptionMusicIds)
+                  (null? verseComposerData)
+                  (null? voiceComposerData)
+                  (null? bridgeIds)
+                  (null? interludeIds)) #f
               (string-append
                 (ly:output-def-lookup layout 'composerPrefix)
                 " "
@@ -151,8 +174,8 @@
                     year_composition
                   ) ", ")
                   (join-present (list
-                    (render-contribution-group (ly:output-def-lookup layout 'adaptionPrefix) adaptionIds)
-                    year_adaption
+                    (render-contribution-group (ly:output-def-lookup layout 'adaptionMusicPrefix) adaptionMusicIds)
+                    year_adaption_music
                   ) ", ")
                   (render-contribution-group (ly:output-def-lookup layout 'bridgePrefix) bridgeIds)
                   (render-contribution-group (ly:output-def-lookup layout 'interludePrefix) interludeIds)
@@ -219,13 +242,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 }
     }
@@ -234,7 +267,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/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/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

private_includes/base/scm/yaml_parser.scm

@@ -1,25 +1,154 @@
-(if (not windows?) (use-modules (ice-9 popen)))
-(use-modules (ice-9 textual-ports) (json parser))
+(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1))
 
-; We use Python to convert the data yamls like the authors.yml to json, that we can parse in scheme.
-; Windows does not like Pipes, so we use a tmpfile instead.
-; Be sure you have PyYAML installed. On Windows that could be done for example like "py -m pip install PyYAML"
+;; Hauptparsingfunktion
 (define (yml-file->scm filename)
-  (if windows?
-    (let* ((port (make-tmpfile #f))
-            (tmpfilepath (port-filename port))
-            (ignore (close-port port))
-            (python_code (string-append "import sys, yaml, json; f = open(r'" tmpfilepath "', 'w'); f.write(json.dumps(yaml.safe_load(open(r'" filename "')))); f.close()"))
-            (status (system (string-append (search-executable '("python3" "python" "py")) " -X utf8 -c \"" python_code "\"")))
-            (readport (open-file tmpfilepath "r" #:encoding "UTF-8"))
-            (json (get-string-all readport)))
-      (close-port readport)
-      (delete-file tmpfilepath)
-      (json-string->scm (if (status:exit-val status) json "{}")))
-    (let* ((python_code (string-append "import sys, yaml, json; print(json.dumps(yaml.safe_load(open(r'" filename "'))))"))
-            (pipe (open-pipe (string-append "PYTHONHOME='' " (search-executable '("python3" "python" "py")) " -X utf8 -c \"" python_code "\"") OPEN_READ))
-            (json (get-string-all pipe)))
-      (close-pipe pipe)
-      (json-string->scm json))))
+
+  ;; Utility: Zeile einlesen
+  (define (read-lines filename)
+    (call-with-input-file filename
+      (lambda (port)
+        (let loop ((lines '()))
+          (let ((line (read-line port)))
+            (if (eof-object? line)
+                (reverse lines)
+                (let ((clean (string-trim line)))
+                  (if (or (string=? clean "---") (string-null? clean))
+                      (loop lines) ;; Ignoriere "---" oder leere Zeile
+                      (loop (cons line lines))))))))))
+
+  ;; Einrückung bestimmen (Anzahl Leerzeichen am Anfang)
+  (define (line-indent line)
+    (let ((match (string-match "^ *" line)))
+      (if match
+          (match:end match)  ; Anzahl der Leerzeichen = Position nach Leerzeichen
+          0)))               ; Falls kein Match → 0
+
+  ;; Kommentar entfernen
+  (define (strip-comment line)
+    (let ((m (string-match "#.*" line)))
+      (if m
+          (string-trim-right (string-take line (match:start m)))
+          line)))
+
+  ;; Hilfsfunktion: Whitespace entfernen
+  (define (clean-line line)
+    (string-trim (strip-comment line)))
+
+  ;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)?
+  (define (blank-or-comment? line)
+    (string-null? (clean-line line)))
+
+  ;; Skalare Werte interpretieren
+  (define (parse-scalar str)
+    (define (strip-quotes s)
+      (cond
+       ((and (string-prefix? "\"" s) (string-suffix? "\"" s))
+        (string-drop-right (string-drop s 1) 1))
+       ((and (string-prefix? "'" s) (string-suffix? "'" s))
+        (string-drop-right (string-drop s 1) 1))
+       (else s)))
+    (let ((s (strip-quotes (string-trim str))))
+      (cond
+       ((string=? s "{}") '())  ;; leere Map
+       ((string=? s "[]") '())  ;; leere Liste
+       ((string-match "^[0-9]+$" s) (string->number s))
+       ((string=? s "true") #t)
+       ((string=? s "false") #f)
+       ((string=? s "null") '())
+       (else s))))
+
+
+  ;; Hilfsfunktion: Zeilen mit gleicher oder höherer Einrückung sammeln
+  (define (take-indented lines min-indent)
+    (let loop ((ls lines) (acc '()))
+      (if (null? ls)
+          (reverse acc)
+          (let ((line (car ls)))
+            (if (or (blank-or-comment? line)
+                    (>= (line-indent line) min-indent))
+                (loop (cdr ls) (cons line acc))
+                (reverse acc))))))
+
+  ;; Hilfsfunktion: N Zeilen überspringen
+  (define (drop lst n)
+    (let loop ((l lst) (i n))
+      (if (or (zero? i) (null? l))
+          l
+          (loop (cdr l) (- i 1)))))
+
+  ;; Listenparsing: Liest Zeilen mit `-` als Listeneinträge
+  (define (parse-list lines current-indent)
+    (let loop ((ls lines) (result '()))
+      (if (null? ls)
+          (reverse result)
+          (let* ((line (clean-line (car ls))))
+            (if (string-match "^-" line)
+                (let* ((indent (line-indent (car ls)))
+                       (item-str (string-trim (string-drop line 1)))
+                       (next-lines (cdr ls)))
+                  (if (or (null? next-lines)
+                          (> (line-indent (car next-lines)) indent))
+                      ;; Verschachtelter Inhalt
+                      (let* ((sub (take-indented next-lines (+ indent 2)))
+                             (parsed (if (null? sub)
+                                         (parse-scalar item-str)
+                                         (parse-lines sub (+ indent 2))))
+                             (remaining (drop next-lines (length sub))))
+                        (loop remaining (cons parsed result)))
+                      ;; Einfacher Skalar
+                      (loop next-lines (cons (parse-scalar item-str) result))))
+                ;; Nicht mehr Teil der Liste
+                (reverse result))))))
+
+  ;; Hauptparser für Key-Value oder Listen
+  (define (parse-lines lines current-indent)
+    (let loop ((ls lines) (result '()))
+      (if (null? ls)
+          (reverse result)
+          (let* ((raw-line (car ls))
+                 (line (clean-line raw-line)))
+            (cond
+             ;; Kommentar oder leere Zeile
+             ((blank-or-comment? raw-line)
+              (loop (cdr ls) result))
+
+             ;; Liste
+             ((string-match "^- " line)
+              (let ((list-lines (take-indented ls current-indent)))
+                (let ((parsed-list (parse-list list-lines current-indent)))
+                  (loop (drop ls (length list-lines))
+                        (cons parsed-list result)))))
+
+             ;; Key: Value
+             ((string-match "^[^:]+:" line)
+              (let* ((kv (string-split line #\:))
+                     (key (string-trim (car kv)))
+                     (value-str (string-trim (string-join (cdr kv) ":")))
+                     (next-lines (cdr ls)))
+                (if (string-null? value-str)
+                    ;; Wert auf nachfolgender Einrückungsebene
+                    (let* ((sub (take-indented next-lines (+ current-indent 2)))
+                           (parsed (parse-lines sub (+ current-indent 2)))
+                           (remaining (drop next-lines (length sub))))
+                      (loop remaining
+                            (cons (cons key parsed) result)))
+                    ;; Einfacher Key:Value
+                    (loop next-lines
+                          (cons (cons key (parse-scalar value-str)) result)))))
+
+             ;; Fehlerhafte Zeile
+             (else
+               ;; Vermeide Fehlermeldung für Leerzeilen oder leere Objekte
+               (if (or (string-null? (string-trim line))
+                       (member line '("{}" "[]")))
+                   (loop (cdr ls) result)
+                   (begin
+                     (format (current-error-port)
+                             "Syntaxfehler: Ungültige Zeile: ~a\n" raw-line)
+                     (loop (cdr ls) result))))
+             )))))
+
+  (let ((lines (read-lines filename)))
+    (parse-lines lines 0)))
 
 (define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))

private_includes/base/title_with_category_images.ily

@@ -28,13 +28,15 @@
 #(define pdf-encode (@@ (lily framework-ps) pdf-encode))
 % PDF tags
 #(define-markup-command (title-to-pdf-toc layout props title) (string?)
+  (if (string-null? title)
+     empty-stencil
      (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

private_includes/base/verses_with_chords.ily

@@ -280,6 +280,7 @@
             \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

private_includes/book/book_include.ily

@@ -65,7 +65,10 @@ additionalPageNumbers =
   display-pages-list
 )
 
-
+% 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
@@ -89,9 +92,10 @@ width may require additional tweaking.)"
         ,(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 'arabic display-page)
+                              (make-concat-markup (list (number-format number-type display-page)
                                 (make-char-markup (+ 97 (- real-current-page (real-page-number layout
                                   (let find-earliest-additional-label
                                        ((rest-additional-page-switch-label-list (member (cons label #t) additional-page-switch-label-list)))
@@ -99,7 +103,7 @@ width may require additional tweaking.)"
                                            (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))))
+                              (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)

private_includes/book/toc_include.ily

@@ -56,11 +56,11 @@
 
 #(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 " " ""
@@ -92,20 +92,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 `(((rawtext . ,category))))))))
               (if (assq catsym category-names)
                 (hashq-set! category-index-hash catsym
-                  (cons (list label markup-symbol text) catlist))
-                (ly:error "song: <~a> category ~a is not defined!" (markup->string text) category))))
+                  (cons (list label markup-symbol textoptions) catlist))
+                (ly:error "song: <~a> category ~a is not defined!" (markup->string (chain-assoc-get 'rawtext textoptions)) category))))
        categories)
        (make-music 'EventChord
          'page-marker #t
@@ -121,13 +121,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 `(((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
@@ -381,7 +381,8 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
                    (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
                    (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
                    (compositionIds (find-author-ids-by 'composition authors))
-                   (adaptionIds (find-author-ids-by 'adaption 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
@@ -397,14 +398,15 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
 
                   (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 adaptionIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
+                  (format-authors (append composerIds compositionIds adaptionMusicIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
                   (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)
+                  (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))
@@ -429,7 +431,8 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
         "year_melody"
         "year_translation"
         "year_composition"
-        "year_adaption"
+        "year_adaption_text"
+        "year_adaption_music"
         "copyright"
         "source"
         "infotext"