native scheme yaml parser

private_includes/base/all.ily

@@ -24,7 +24,6 @@
 #(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 \Better_Merge_rests_engraver
+    \consists Merge_rests_engraver
   }
   \context {
     \Score
@@ -67,7 +67,6 @@ 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
@@ -84,14 +83,12 @@ 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
@@ -101,7 +98,6 @@ 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/footer_with_songinfo.ily

@@ -242,23 +242,13 @@
       `(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 { \page-number-to-pdf-label \null }
+      \line { \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 }
     }
@@ -267,7 +257,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 { \page-number-to-pdf-label \null }
+      \line { \null }
     }
   }
 }

private_includes/base/merge_rests_engraver_override.ily

@@ -1,86 +0,0 @@
-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

@@ -1,154 +1,152 @@
 (use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1))
 
+;; 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))))
+
 ;; Hauptparsingfunktion
 (define (yml-file->scm filename)
-
-  ;; 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)))
 
+;; 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))))
+           )))))
+
 (define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))

private_includes/base/title_with_category_images.ily

@@ -28,15 +28,13 @@
 #(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,7 +280,6 @@
             \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,10 +65,7 @@ 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
@@ -92,10 +89,9 @@ 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 number-type display-page)
+                              (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)))
@@ -103,7 +99,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 number-type (+ display-page (- real-current-page (real-page-number layout label))))
+                              (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)