native scheme yaml parser

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/verses_with_chords.ily

@@ -253,113 +253,6 @@
                                     (make-pad-right-markup -0.1 (make-tied-lyric-markup text))
                                     text))))
 
-Chord_lyrics_spacing_engraver =
-#(lambda (ctx)
-   (let ((last-note-head #f)
-         (note-head-extended #f)
-         (last-lyric-syllable-width 0)
-         (lyric-width-since-last-chord 0)
-         (notes-on-syllable-count 0)
-         (last-chord-name #f)
-         (remaining-chord-width 0)
-         (last-rest #f)
-         (rest-count 0)
-         (multi-measure-rest-count 0)
-         (stanza-shift 0))
-     (make-engraver
-      (listeners
-       ((multi-measure-rest-event engraver event)
-        (set! multi-measure-rest-count (+ multi-measure-rest-count 1))
-        )
-       ((break-event engraver event)
-        (set! last-note-head #f)
-        (set! note-head-extended #f)
-        (set! last-lyric-syllable-width 0)
-        (set! lyric-width-since-last-chord 0)
-        (set! notes-on-syllable-count 0)
-        (set! last-chord-name #f)
-        (set! remaining-chord-width 0)
-        (set! last-rest #f)
-        (set! rest-count 0)
-        (set! multi-measure-rest-count 0)
-        (set! stanza-shift 0)
-        ))
-      (acknowledgers
-       ((note-head-interface this-engraver grob source-engraver)
-        (if (and (> rest-count 0) (not last-note-head))
-            (let ((rest-spacing-on-line-start 1.2))
-              (ly:grob-set-property! grob 'minimum-X-extent (cons (- rest-spacing-on-line-start) 0))
-              (set! stanza-shift rest-spacing-on-line-start)
-              ))
-        (set! notes-on-syllable-count (+ 1 notes-on-syllable-count))
-        (set! last-note-head grob)
-        (set! note-head-extended #f)
-        (set! last-rest #f)
-        (set! rest-count 0)
-        (set! multi-measure-rest-count 0)
-        )
-       ((lyric-syllable-interface this-engraver grob source-engraver)
-        (set! remaining-chord-width (max 0 (- remaining-chord-width lyric-width-since-last-chord)))
-        (set! last-lyric-syllable-width (- (cdr (ly:grob-extent grob grob X)) 0.2))
-        (set! lyric-width-since-last-chord (+ lyric-width-since-last-chord last-lyric-syllable-width))
-        (if last-note-head (set! notes-on-syllable-count 1))
-        )
-       ((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)))
-            (let ((on-a-rest (> rest-count 0)))
-              (if (not on-a-rest)
-                  (set! notes-on-syllable-count (- notes-on-syllable-count 1)))
-              (if (and last-chord-name (= multi-measure-rest-count 1) (> lyric-width-since-last-chord remaining-chord-width))
-                  (ly:grob-set-property! last-chord-name 'extra-spacing-width (cons -0.1 (+ 0.1 (- lyric-width-since-last-chord remaining-chord-width)))))
-              (if last-note-head
-                  (let* ((last-note-min-x-extent (ly:grob-property last-note-head 'minimum-X-extent))
-                         (last-note-min-x-lower (if (pair? last-note-min-x-extent) (car last-note-min-x-extent) 0))
-                         (last-note-min-x-upper (if (pair? last-note-min-x-extent) (cdr last-note-min-x-extent) 0)))
-                    (if on-a-rest
-                        (begin
-                         (if (not note-head-extended)
-                             (begin
-                              (ly:grob-set-property! last-note-head 'minimum-X-extent
-                                                     (cons last-note-min-x-lower (- last-lyric-syllable-width -2 (* 2.2 rest-count))))
-                              (set! note-head-extended #t)
-                              ))
-                         (ly:grob-set-property! last-rest 'minimum-X-extent (cons 0 2))
-                         )
-                        (if (and (> lyric-width-since-last-chord 0)
-                                 (> remaining-chord-width lyric-width-since-last-chord))
-                            (ly:grob-set-property! last-note-head 'minimum-X-extent
-                                                   (cons (- -1.2 (- remaining-chord-width lyric-width-since-last-chord)) last-note-min-x-upper))
-                            (let* ((width-per-note-head 0.5)
-                                   (note-width-since-last-chord (* width-per-note-head notes-on-syllable-count)))
-                              (if (> remaining-chord-width note-width-since-last-chord)
-                                  (ly:grob-set-property! last-note-head 'minimum-X-extent
-                                                         (cons (- note-width-since-last-chord remaining-chord-width) last-note-min-x-upper))
-                                  )
-                              )
-                            )
-                        )))
-              (set! last-chord-name grob)
-              (set! remaining-chord-width
-                    (if (and on-a-rest (equal? (ly:prob-property (ly:grob-property grob 'cause) 'duration) (ly:prob-property (ly:grob-property last-rest 'cause) 'duration)))
-                        0
-                        (cdr (ly:grob-extent grob grob X))))
-              (set! lyric-width-since-last-chord 0)
-              (set! notes-on-syllable-count (if on-a-rest 0 1))
-              ))
-        )
-       ((rest-interface this-engraver grob source-engraver)
-        (set! rest-count (+ 1 rest-count))
-        (set! last-rest grob)
-        (set! multi-measure-rest-count 0)
-        )
-       ((stanza-number-interface this-engraver grob source-engraver)
-        (ly:grob-set-property! grob 'padding (+ 1 stanza-shift)))
-       ))))
-
-%#(ly:set-option 'debug-skylines #t)
-
 #(define-markup-command (chordlyrics layout props lyrics) (ly:music?)
    #:properties ((verse-chords #{#})
                  (verse-reference-voice #{#})
@@ -405,8 +298,6 @@ Chord_lyrics_spacing_engraver =
              % \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
               \remove Bar_number_engraver
               \remove Mark_engraver
               \remove Jump_engraver
@@ -440,10 +331,9 @@ Chord_lyrics_spacing_engraver =
               \NullVoice
               \consists Rest_engraver
               \omit Rest
-              \override Rest.X-extent = #'(0 . 0)
               \undo \omit NoteHead
               \hide NoteHead
-              \override NoteHead.X-extent = #'(0 . 0.5)
+              \override NoteHead.X-extent = #'(0 . 0)
             }
           }
         }