1 Commits

Author SHA1 Message Date
4ded2286d8 native scheme yaml parser 2025-09-19 23:26:18 +02:00
9 changed files with 153 additions and 381 deletions

View File

@@ -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"

View File

@@ -44,7 +44,7 @@ generalLayout = \layout {
\context {
\Staff
\accidentalStyle modern-voice-cautionary
\consists \Better_Merge_rests_engraver
\consists Merge_rests_engraver
}
\context {
\Score
@@ -67,13 +67,10 @@ 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
\override Beam.layer = 2
\override Slur.layer = 2
\override Tie.layer = 2
\override Accidental.layer = 2
}
}
@@ -86,34 +83,25 @@ 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
}

View File

@@ -52,7 +52,7 @@
(lambda (paragraph)
(make-wordwrap-internal-markup-list #t
#{ \markuplist { $(ly:parser-include-string paragraph) } #}))
(ly:regex-split (ly:make-regex "\r?\n[ \t\r\n]*\n[ \t\r\n]*") (string-append prefix 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

View File

@@ -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 }
}
}
}

View File

@@ -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)))))))

View File

@@ -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)))

View File

@@ -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

View File

@@ -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 #{#})
@@ -387,7 +280,6 @@ Chord_lyrics_spacing_engraver =
\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
@@ -406,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
@@ -441,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)
}
}
}

View File

@@ -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)