Compare commits
	
		
			62 Commits
		
	
	
		
			eca352b6d0
			...
			secondVoic
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
| aa0e3816d0 | |||
| 3b0c320839 | |||
| 12abf0a5f7 | |||
| a01e95f31d | |||
| 90feb6dfbb | |||
| ede5568962 | |||
| 66b5c37755 | |||
| cd5e38aabc | |||
| ca129eec79 | |||
| f824b23311 | |||
| 5ef4ee78ae | |||
| 45e751fa24 | |||
| 9fb2d96765 | |||
| 8ce3af93c7 | |||
| 19f6046333 | |||
| a288248da3 | |||
| 7a65d056d6 | |||
| 53c41bf5dc | |||
| c49dba89f7 | |||
| 195110923a | |||
| 8d0ddcee06 | |||
| c47ceb443e | |||
| 377beeab57 | |||
| cb4b74d4f7 | |||
| 616034baca | |||
| 34c9c5a932 | |||
| 57bcf94167 | |||
| 9a9ef8e8df | |||
| 531e459af1 | |||
| fc1bc74b10 | |||
| d47ae1a66d | |||
| 37ee497f89 | |||
| 41bd881014 | |||
| 00a7b0ebc8 | |||
| 760ca71ba7 | |||
| 17074e2db6 | |||
| 654f619fba | |||
| cc4fc9f297 | |||
| d2dbf3448a | |||
| 140bc611d1 | |||
| eccd9b8730 | |||
| 900f4e1d06 | |||
| 7d01bd769c | |||
| a0e70b4c4b | |||
| 04a01d3b3f | |||
| 07b598db06 | |||
| a61becaf5e | |||
| f0f4b0c180 | |||
| b6bead747d | |||
| 4dbdb72d30 | |||
| aa8b9526fa | |||
| 3cb0e00e8f | |||
| 152d56fe3f | |||
| 883c32701c | |||
| 7b97e04fab | |||
| e4b65aafcb | |||
| bf7e959100 | |||
| ddd4888041 | |||
| a368a3c589 | |||
| e6725b84d4 | |||
| 
						 | 
					b41e2a62a4 | ||
| 15c27c271f | 
@@ -1,29 +0,0 @@
 | 
				
			|||||||
#(define noStandaloneOutput (if (defined? 'noStandaloneOutput) noStandaloneOutput #f))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
#(if (defined? 'LAYOUT) #f
 | 
					 | 
				
			||||||
  (let ((scmdir (string-append (dirname (current-filename)) file-name-separator-string "scm" file-name-separator-string)))
 | 
					 | 
				
			||||||
    (load (string-append scmdir "json_parser.scm"))
 | 
					 | 
				
			||||||
    (load (string-append scmdir "resolve_inherits.scm"))
 | 
					 | 
				
			||||||
    (load (string-append scmdir "yaml_parser.scm"))))
 | 
					 | 
				
			||||||
#(define AUTHOR_DATA (if (defined? 'AUTHOR_DATA) AUTHOR_DATA (parse-yml-file "../../lilypond-song-includes/data/authors.yml")))
 | 
					 | 
				
			||||||
#(define SONG_DATA (if (defined? 'SONG_DATA) SONG_DATA (parse-yml-file "../../lilypond-song-includes/data/songs.yml")))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
\include "basic_format_and_style_settings.ly"
 | 
					 | 
				
			||||||
\include "eps_file_from_song_dir.ly"
 | 
					 | 
				
			||||||
\include "title_with_category_images.ly"
 | 
					 | 
				
			||||||
\include "chord_settings.ly"
 | 
					 | 
				
			||||||
\include "transposition.ly"
 | 
					 | 
				
			||||||
\include "verses_with_chords.ly"
 | 
					 | 
				
			||||||
\include "arrows_in_scores.ly"
 | 
					 | 
				
			||||||
\include "swing_style.ly"
 | 
					 | 
				
			||||||
\include "inline_score.ly"
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
% reset important variables
 | 
					 | 
				
			||||||
LAYOUT = \layout { \generalLayout }
 | 
					 | 
				
			||||||
HEADER = {}
 | 
					 | 
				
			||||||
MUSIC = {}
 | 
					 | 
				
			||||||
TEXT = \markuplist {""}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
verseChords = {}
 | 
					 | 
				
			||||||
firstVoice = {}
 | 
					 | 
				
			||||||
global = {}
 | 
					 | 
				
			||||||
							
								
								
									
										49
									
								
								private_includes/base/all.ily
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										49
									
								
								private_includes/base/all.ily
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,49 @@
 | 
				
			|||||||
 | 
					#(define include_dir_not_added? (if (defined? 'include_dir_not_added?) include_dir_not_added? #t))
 | 
				
			||||||
 | 
					#(if include_dir_not_added?
 | 
				
			||||||
 | 
					   (let* ((common-include-dir (dirname (dirname (dirname (current-filename))))))
 | 
				
			||||||
 | 
					      (ly:parser-append-to-include-path common-include-dir)
 | 
				
			||||||
 | 
					      (set! include_dir_not_added? #f)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					#(define noStandaloneOutput (if (defined? 'noStandaloneOutput) noStandaloneOutput #f))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					#(define windows? (string-prefix-ci? "windows" (utsname:sysname (uname))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					#(if (defined? 'LAYOUT) #f
 | 
				
			||||||
 | 
					  (let ((scm-load (lambda (filename) (load (
 | 
				
			||||||
 | 
					    string-append
 | 
				
			||||||
 | 
					      ; on windows the detection of absolute pathes is broken (cause they start with a drive letter and not with a /)
 | 
				
			||||||
 | 
					      ; so we have to use relative pathes for load. That works in frescobaldi, but not if you call lilypond from command line,
 | 
				
			||||||
 | 
					      ; with a relative path to the .ly file, so we use absolute pathes on posix systems, where it works.
 | 
				
			||||||
 | 
					      (if windows?
 | 
				
			||||||
 | 
					        ""
 | 
				
			||||||
 | 
					        (string-append (dirname (current-filename)) file-name-separator-string))
 | 
				
			||||||
 | 
					      "scm" file-name-separator-string filename
 | 
				
			||||||
 | 
					    )))))
 | 
				
			||||||
 | 
					    (scm-load "resolve_inherits.scm")
 | 
				
			||||||
 | 
					    (scm-load "yaml_parser.scm")))
 | 
				
			||||||
 | 
					#(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"
 | 
				
			||||||
 | 
					\include "chord_settings.ily"
 | 
				
			||||||
 | 
					\include "transposition.ily"
 | 
				
			||||||
 | 
					\include "verses_with_chords.ily"
 | 
				
			||||||
 | 
					\include "arrows_in_scores.ily"
 | 
				
			||||||
 | 
					\include "swing_style.ily"
 | 
				
			||||||
 | 
					\include "inline_score.ily"
 | 
				
			||||||
 | 
					\include "custom_indentation.ily"
 | 
				
			||||||
 | 
					\include "include_from_song.ily"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					% reset important variables
 | 
				
			||||||
 | 
					LAYOUT = \layout { \generalLayout }
 | 
				
			||||||
 | 
					HEADER = {}
 | 
				
			||||||
 | 
					MUSIC = {}
 | 
				
			||||||
 | 
					TEXT = \markuplist {}
 | 
				
			||||||
 | 
					TEXT_PAGES = #f
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					verseChords = {}
 | 
				
			||||||
 | 
					firstVoice = {}
 | 
				
			||||||
 | 
					global = {}
 | 
				
			||||||
@@ -1,10 +1,10 @@
 | 
				
			|||||||
\language "deutsch"
 | 
					\language "deutsch"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
\include "default_style.ly"
 | 
					\include "default_style.ily"
 | 
				
			||||||
\include "default_songinfo_style.ly"
 | 
					\include "default_songinfo_style.ily"
 | 
				
			||||||
\include "footer_with_songinfo.ly"
 | 
					\include "footer_with_songinfo.ily"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
\include #(if (defined? 'customStyleOverridesFile) customStyleOverridesFile "void.ly")
 | 
					\include #(if (defined? 'customStyleOverridesFile) customStyleOverridesFile "../void.ily")
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(set-default-paper-size songFormatAndSize)
 | 
					#(set-default-paper-size songFormatAndSize)
 | 
				
			||||||
#(set-global-staff-size globalSize)
 | 
					#(set-global-staff-size globalSize)
 | 
				
			||||||
@@ -24,6 +24,11 @@
 | 
				
			|||||||
  markup-system-spacing = #'((basic-distance . 1))
 | 
					  markup-system-spacing = #'((basic-distance . 1))
 | 
				
			||||||
  score-markup-spacing = #'((padding . 2))
 | 
					  score-markup-spacing = #'((padding . 2))
 | 
				
			||||||
  top-markup-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
 | 
					  top-markup-spacing = #'((basic-distance . 0) (minimum-distance . 0) (padding . 0))
 | 
				
			||||||
 | 
					  refMarkupFormatter = #(lambda (layout props stanzanumbers)
 | 
				
			||||||
 | 
					    (interpret-markup layout props
 | 
				
			||||||
 | 
					    (if (null? stanzanumbers)
 | 
				
			||||||
 | 
					        refString
 | 
				
			||||||
 | 
					        (ly:format refStringWithNumbers (string-join (map (lambda (stanzanumber) (ly:format "~a" stanzanumber)) stanzanumbers) ", ")))))
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
generalLayout = \layout {
 | 
					generalLayout = \layout {
 | 
				
			||||||
@@ -38,8 +43,8 @@ generalLayout = \layout {
 | 
				
			|||||||
  }
 | 
					  }
 | 
				
			||||||
  \context {
 | 
					  \context {
 | 
				
			||||||
    \Staff
 | 
					    \Staff
 | 
				
			||||||
    \accidentalStyle modern
 | 
					    \accidentalStyle modern-voice-cautionary
 | 
				
			||||||
    \consists Merge_rests_engraver
 | 
					    \consists \Better_Merge_rests_engraver
 | 
				
			||||||
  }
 | 
					  }
 | 
				
			||||||
  \context {
 | 
					  \context {
 | 
				
			||||||
    \Score
 | 
					    \Score
 | 
				
			||||||
@@ -62,10 +67,12 @@ generalLayout = \layout {
 | 
				
			|||||||
    % ich will lines breaken wie ich will!
 | 
					    % ich will lines breaken wie ich will!
 | 
				
			||||||
    \remove "Forbid_line_break_engraver"
 | 
					    \remove "Forbid_line_break_engraver"
 | 
				
			||||||
    \override NoteHead.layer = 2
 | 
					    \override NoteHead.layer = 2
 | 
				
			||||||
 | 
					    \override Rest.layer = 2
 | 
				
			||||||
    \override Dots.layer = 2
 | 
					    \override Dots.layer = 2
 | 
				
			||||||
    \override Stem.layer = 2
 | 
					    \override Stem.layer = 2
 | 
				
			||||||
    \override Flag.layer = 2
 | 
					    \override Flag.layer = 2
 | 
				
			||||||
    \override Beam.layer = 2
 | 
					    \override Beam.layer = 2
 | 
				
			||||||
 | 
					    \override Accidental.layer = 2
 | 
				
			||||||
  }
 | 
					  }
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -77,23 +84,29 @@ textp = \lyricmode { \markup { \raise #1 \musicglyph #"rests.3" } }
 | 
				
			|||||||
% zweite Stimme alles grau
 | 
					% zweite Stimme alles grau
 | 
				
			||||||
secondVoiceStyle = {
 | 
					secondVoiceStyle = {
 | 
				
			||||||
  \override NoteHead.color = #grey
 | 
					  \override NoteHead.color = #grey
 | 
				
			||||||
 | 
					  \override Rest.color = #grey
 | 
				
			||||||
  \override Dots.color = #grey
 | 
					  \override Dots.color = #grey
 | 
				
			||||||
  \override Stem.color = #grey
 | 
					  \override Stem.color = #grey
 | 
				
			||||||
  \override Flag.color = #grey
 | 
					  \override Flag.color = #grey
 | 
				
			||||||
  \override Beam.color = #grey
 | 
					  \override Beam.color = #grey
 | 
				
			||||||
 | 
					  \override Accidental.color = #grey
 | 
				
			||||||
  \override NoteHead.layer = 1
 | 
					  \override NoteHead.layer = 1
 | 
				
			||||||
 | 
					  \override Rest.layer = 1
 | 
				
			||||||
  \override Dots.layer = 1
 | 
					  \override Dots.layer = 1
 | 
				
			||||||
  \override Stem.layer = 1
 | 
					  \override Stem.layer = 1
 | 
				
			||||||
  \override Flag.layer = 1
 | 
					  \override Flag.layer = 1
 | 
				
			||||||
  \override Beam.layer = 1
 | 
					  \override Beam.layer = 1
 | 
				
			||||||
 | 
					  \override Accidental.layer = 1
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
firstVoiceStyle = {
 | 
					firstVoiceStyle = {
 | 
				
			||||||
  \override NoteHead.color = #black
 | 
					  \override NoteHead.color = #black
 | 
				
			||||||
 | 
					  \override Rest.color = #black
 | 
				
			||||||
  \override Dots.color = #black
 | 
					  \override Dots.color = #black
 | 
				
			||||||
  \override Stem.color = #black
 | 
					  \override Stem.color = #black
 | 
				
			||||||
  \override Flag.color = #black
 | 
					  \override Flag.color = #black
 | 
				
			||||||
  \override Beam.color = #black
 | 
					  \override Beam.color = #black
 | 
				
			||||||
 | 
					  \override Accidental.color = #black
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
% Deprecated: einzelne Noten innerhalb von \secondVoiceStyle mit schwarzem statt grauem Kopf
 | 
					% Deprecated: einzelne Noten innerhalb von \secondVoiceStyle mit schwarzem statt grauem Kopf
 | 
				
			||||||
@@ -112,23 +125,30 @@ override-stanza =
 | 
				
			|||||||
#}
 | 
					#}
 | 
				
			||||||
)
 | 
					)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
stanza =
 | 
					#(define (stanza . stanzanumbers)
 | 
				
			||||||
#(define-music-function (parser location stanzanumber) (number?)
 | 
					 | 
				
			||||||
#{
 | 
					#{
 | 
				
			||||||
  \once \override StanzaNumber.layer = 23 % set this to signal that there is a real stanza and no repeat signs
 | 
					  \once \override StanzaNumber.layer = 23 % set this to signal that there is a real stanza and no repeat signs
 | 
				
			||||||
  \applyContext
 | 
					  \applyContext
 | 
				
			||||||
  #(lambda (context)
 | 
					  #(lambda (context)
 | 
				
			||||||
    (let* ((stanzanumber (ly:assoc-get 'forced-spacing (ly:context-grob-definition context 'StanzaNumber) stanzanumber))
 | 
					    (let* ((stanzanumber-override (ly:assoc-get 'forced-spacing (ly:context-grob-definition context 'StanzaNumber) #f))
 | 
				
			||||||
           (stanzastyle (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber)))
 | 
					           (stanza-style (ly:assoc-get 'style (ly:context-grob-definition context 'StanzaNumber)))
 | 
				
			||||||
           (formattedStanzaNumber (format #f (if (eq? stanzastyle 'roman) romanStanzaFormat stanzaFormat) stanzanumber)))
 | 
					           (stanza-format (lambda (stanzanumber) (format #f (if (eq? stanza-style 'roman) romanStanzaFormat stanzaFormat) stanzanumber))))
 | 
				
			||||||
        (ly:context-set-property! context 'stanza formattedStanzaNumber)))
 | 
					        (ly:context-set-property! context 'stanza
 | 
				
			||||||
 | 
					          (string-join (map stanza-format
 | 
				
			||||||
 | 
					                            (if stanzanumber-override (list stanzanumber-override) stanzanumbers))
 | 
				
			||||||
 | 
					                        ", "))))
 | 
				
			||||||
#}
 | 
					#}
 | 
				
			||||||
)
 | 
					)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
ref = {
 | 
					ref =
 | 
				
			||||||
  \once \override StanzaNumber.layer = 23 % set this to signal that there is a real stanza and no repeat signs
 | 
					#(define-music-function (stanzanumbers lyrics) ((number-list? (list)) ly:music?)
 | 
				
			||||||
  \set stanza = \refString
 | 
					#{ \lyricmode {
 | 
				
			||||||
}
 | 
					    \once \override StanzaNumber.layer = 23 % set this to signal that there is a real stanza and no repeat signs
 | 
				
			||||||
 | 
					    \set stanza = #(make-on-the-fly-markup (lambda (layout props m) ((ly:output-def-lookup layout 'refMarkupFormatter) layout props stanzanumbers)) (make-null-markup))
 | 
				
			||||||
 | 
					    #lyrics
 | 
				
			||||||
 | 
					  }
 | 
				
			||||||
 | 
					#}
 | 
				
			||||||
 | 
					)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
% prints a repStart Sign as stanza if the tag 'repeats is kept.
 | 
					% prints a repStart Sign as stanza if the tag 'repeats is kept.
 | 
				
			||||||
% if there was a stanza already set by the stanza function with StanzaNumber.layer = 23 we set that also as stanza.
 | 
					% if there was a stanza already set by the stanza function with StanzaNumber.layer = 23 we set that also as stanza.
 | 
				
			||||||
@@ -178,9 +198,62 @@ alt =
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
updown =
 | 
					updown =
 | 
				
			||||||
#(define-music-function (parser location word) (string?)
 | 
					#(define-music-function (parser location word) (string?)
 | 
				
			||||||
 | 
					(let ((first-char (string-take word 1))
 | 
				
			||||||
 | 
					      (rest (substring word 1 (string-length word))))
 | 
				
			||||||
#{
 | 
					#{
 | 
				
			||||||
  \lyricmode {
 | 
					  \lyricmode {
 | 
				
			||||||
    \tag #'up { \markup { #(string-capitalize word) } }
 | 
					    \markup {
 | 
				
			||||||
    \tag #'down { \markup { #(string-downcase word) } }
 | 
					      \tag #'up #(string-append (string-capitalize first-char) rest)
 | 
				
			||||||
 | 
					      \tag #'down #(string-append (string-downcase first-char) rest)
 | 
				
			||||||
 | 
					    }
 | 
				
			||||||
  }
 | 
					  }
 | 
				
			||||||
#})
 | 
					#}))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					dottedExtender = {
 | 
				
			||||||
 | 
					  \override LyricExtender.style = #'dotted-line
 | 
				
			||||||
 | 
					  \override LyricExtender.thickness = 2
 | 
				
			||||||
 | 
					  \override LyricExtender.Y-offset = 0.1
 | 
				
			||||||
 | 
					  \override LyricExtender.stencil =
 | 
				
			||||||
 | 
					    #(lambda (grob)
 | 
				
			||||||
 | 
					      (let* ((stil (ly:lyric-extender::print grob))
 | 
				
			||||||
 | 
					             (nostil (null? stil))
 | 
				
			||||||
 | 
					             (x-ext (if nostil 0 (ly:stencil-extent stil X))))
 | 
				
			||||||
 | 
					         (if nostil
 | 
				
			||||||
 | 
					           stil
 | 
				
			||||||
 | 
					           (make-connected-line
 | 
				
			||||||
 | 
					             (list
 | 
				
			||||||
 | 
					               (cons (car x-ext) 0)
 | 
				
			||||||
 | 
					               (cons (cdr x-ext) 0))
 | 
				
			||||||
 | 
					             grob))))
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					melisOff = \set ignoreMelismata = ##t
 | 
				
			||||||
 | 
					melisOn = \unset ignoreMelismata
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					cue =
 | 
				
			||||||
 | 
					#(define-music-function (zahlen) (number-list?)
 | 
				
			||||||
 | 
					  #{
 | 
				
			||||||
 | 
					      \tag #'cues {
 | 
				
			||||||
 | 
					        \tweak self-alignment-X #LEFT
 | 
				
			||||||
 | 
					        \mark
 | 
				
			||||||
 | 
					          #(make-on-the-fly-markup
 | 
				
			||||||
 | 
					            (lambda (layout props m) (interpret-markup layout (prepend-alist-chain 'cues zahlen props) (ly:output-def-lookup layout 'cueMarkup)))
 | 
				
			||||||
 | 
					            (make-null-markup))
 | 
				
			||||||
 | 
					      }
 | 
				
			||||||
 | 
					  #})
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					#(define-markup-command (ruf-style layout props text) (string?)
 | 
				
			||||||
 | 
					   (interpret-markup layout props
 | 
				
			||||||
 | 
					                     (markup #:italic (string-append "(" text ")"))))
 | 
				
			||||||
 | 
					rufWithMarkup =
 | 
				
			||||||
 | 
					#(define-music-function (text) (markup?)
 | 
				
			||||||
 | 
					   #{
 | 
				
			||||||
 | 
					     \lyricmode {
 | 
				
			||||||
 | 
					       \once \override StanzaNumber.font-series = #'normal
 | 
				
			||||||
 | 
					       \once \override StanzaNumber.direction = 1
 | 
				
			||||||
 | 
					       \set stanza = #text
 | 
				
			||||||
 | 
					     }
 | 
				
			||||||
 | 
					   #})
 | 
				
			||||||
 | 
					ruf =
 | 
				
			||||||
 | 
					#(define-music-function (text) (string?)
 | 
				
			||||||
 | 
					   (rufWithMarkup (make-ruf-style-markup text)))
 | 
				
			||||||
@@ -38,31 +38,47 @@ shiftChords = #(define-music-function (parser location xshift chords) (number? l
 | 
				
			|||||||
	$chords
 | 
						$chords
 | 
				
			||||||
#})
 | 
					#})
 | 
				
			||||||
 | 
					
 | 
				
			||||||
altChord = #(define-music-function (parser location mainchord altchord) (ly:music? ly:music?)
 | 
					altChord =
 | 
				
			||||||
(define (chord-namer in-pitches bass inversion context)
 | 
					#(define-music-function (parser location mainchord altchord) (ly:music? ly:music?)
 | 
				
			||||||
#{
 | 
					  (let* ((remove-point-and-click
 | 
				
			||||||
  \markup {
 | 
					           (lambda (grob)
 | 
				
			||||||
    \translate #'(-0.5 . 0)
 | 
					             (ly:grob-set-property! grob 'cause #f)
 | 
				
			||||||
    \score {
 | 
					             (ly:text-interface::print grob)))
 | 
				
			||||||
      \chords { #mainchord \klamm #altchord }
 | 
					         (chord-name (lambda (in-pitches bass inversion context) #{
 | 
				
			||||||
      \layout {
 | 
					           \markup {
 | 
				
			||||||
        \LAYOUT
 | 
					             \translate #'(-0.5 . 0)
 | 
				
			||||||
        \context {
 | 
					             \score {
 | 
				
			||||||
          \ChordNames
 | 
					               \chords { \transposable #(cons (car (music-pitches mainchord)) (car in-pitches)) { #(music-clone mainchord) \klamm #(music-clone altchord) } }
 | 
				
			||||||
          \override ChordName.extra-spacing-width = #'(0 . 0.3)
 | 
					               \layout {
 | 
				
			||||||
        }
 | 
					                 \LAYOUT
 | 
				
			||||||
        \context {
 | 
					                 \context {
 | 
				
			||||||
          \Score
 | 
					                   \ChordNames
 | 
				
			||||||
          \override SpacingSpanner.spacing-increment = 0
 | 
					                   \override ChordName.extra-spacing-width = #'(0 . 0.3)
 | 
				
			||||||
        }
 | 
					                   \override ChordName.stencil = #remove-point-and-click
 | 
				
			||||||
      }
 | 
					                 }
 | 
				
			||||||
    }
 | 
					                 \context {
 | 
				
			||||||
  }
 | 
					                   \Score
 | 
				
			||||||
#})
 | 
					                   \override SpacingSpanner.spacing-increment = 0
 | 
				
			||||||
#{
 | 
					                 }
 | 
				
			||||||
  \once \set chordNameFunction = #chord-namer
 | 
					               }
 | 
				
			||||||
	#mainchord
 | 
					             }
 | 
				
			||||||
#})
 | 
					           }#})))
 | 
				
			||||||
 | 
					    #{
 | 
				
			||||||
 | 
					      \once \set chordNameFunction = #chord-name
 | 
				
			||||||
 | 
					      #mainchord
 | 
				
			||||||
 | 
					    #}))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					% Akkorde werden so transponiert, dass sie passen, wenn man mit Kapo im angegebenen Bund spielt
 | 
				
			||||||
 | 
					capoTranspose =
 | 
				
			||||||
 | 
					#(define-music-function (fret chords) (number? ly:music?)
 | 
				
			||||||
 | 
					  (define semi->pitch
 | 
				
			||||||
 | 
					    (make-semitone->pitch
 | 
				
			||||||
 | 
					      (music-pitches
 | 
				
			||||||
 | 
					        #{ h b a gis g fis f e es d cis c #})))
 | 
				
			||||||
 | 
					  (transpose
 | 
				
			||||||
 | 
					    (ly:pitch-transpose (semi->pitch fret) (ly:make-pitch 0 0))
 | 
				
			||||||
 | 
					    (ly:make-pitch 0 0)
 | 
				
			||||||
 | 
					    chords))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
% kleine Mollakkorde und Alteration ausgeschrieben
 | 
					% kleine Mollakkorde und Alteration ausgeschrieben
 | 
				
			||||||
#(define (note-name->german-markup-nosym pitch lowercase?)
 | 
					#(define (note-name->german-markup-nosym pitch lowercase?)
 | 
				
			||||||
@@ -100,11 +116,42 @@ altChord = #(define-music-function (parser location mainchord altchord) (ly:musi
 | 
				
			|||||||
% additional bass notes should get uppercased
 | 
					% additional bass notes should get uppercased
 | 
				
			||||||
#(define (bassnote-name->german-markup-nosym pitch lowercase?)(note-name->german-markup-nosym pitch #f))
 | 
					#(define (bassnote-name->german-markup-nosym pitch lowercase?)(note-name->german-markup-nosym pitch #f))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					defaultChordPrintings = {
 | 
				
			||||||
 | 
					  <c g>-\markup { \super "5" }
 | 
				
			||||||
 | 
					  %% Dur
 | 
				
			||||||
 | 
					  <c e g a>-\markup { \super "6" } %Standardverhalten
 | 
				
			||||||
 | 
					  <c e a >-\markup { \super "6(no5)" }
 | 
				
			||||||
 | 
					  <c e g a d'>-\markup { \super "6/9" }
 | 
				
			||||||
 | 
					  <c e g b d'>-\markup { \super "9" } %Standardverhalten
 | 
				
			||||||
 | 
					  <c e g b d' f'>-\markup { \super "11" } %Standardverhalten
 | 
				
			||||||
 | 
					  <c e g b d' a'>-\markup { \super "13" }
 | 
				
			||||||
 | 
					  %add chords
 | 
				
			||||||
 | 
					  <c e g d'>-\markup { \super "add9" }
 | 
				
			||||||
 | 
					  <c e g f'>-\markup { \super "add11" }
 | 
				
			||||||
 | 
					  <c e g a'>-\markup { \super "add13" }
 | 
				
			||||||
 | 
					  %major chords
 | 
				
			||||||
 | 
					  <c e g h d'>-\markup { \super "maj9" }
 | 
				
			||||||
 | 
					  %% Moll
 | 
				
			||||||
 | 
					  <c es g a>-\markup { \super "6" } %Standardverhalten
 | 
				
			||||||
 | 
					  <c es a >-\markup { \super "6(no5)" }
 | 
				
			||||||
 | 
					  <c es g a d'>-\markup { \super "6/9" }
 | 
				
			||||||
 | 
					  <c es g b d'>-\markup { \super "9" } %Standardverhalten
 | 
				
			||||||
 | 
					  <c es g b d' f'>-\markup { \super "11" } %Standardverhalten
 | 
				
			||||||
 | 
					  <c es g b d' a'>-\markup { \super "13" }
 | 
				
			||||||
 | 
					  %add chords
 | 
				
			||||||
 | 
					  <c es g d'>-\markup { \super "add9" }
 | 
				
			||||||
 | 
					  <c es g f'>-\markup { \super "add11" }
 | 
				
			||||||
 | 
					  <c es g a'>-\markup { \super "add13" }
 | 
				
			||||||
 | 
					  %major chords
 | 
				
			||||||
 | 
					  <c es g h d'>-\markup { \super "maj9" }
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define chordNameExceptions
 | 
					#(define chordNameExceptions
 | 
				
			||||||
  (if (defined? 'customChordPrintings)
 | 
					  (append
 | 
				
			||||||
  (sequential-music-to-chord-exceptions customChordPrintings #t)
 | 
					    (if (defined? 'customChordPrintings)
 | 
				
			||||||
  '()))
 | 
					      (sequential-music-to-chord-exceptions customChordPrintings #t)
 | 
				
			||||||
 | 
					      '())
 | 
				
			||||||
 | 
					    (sequential-music-to-chord-exceptions defaultChordPrintings #t)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
generalLayout = \layout {
 | 
					generalLayout = \layout {
 | 
				
			||||||
  \generalLayout
 | 
					  \generalLayout
 | 
				
			||||||
							
								
								
									
										135
									
								
								private_includes/base/custom_indentation.ily
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										135
									
								
								private_includes/base/custom_indentation.ily
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,135 @@
 | 
				
			|||||||
 | 
					% https://lsr.di.unimi.it/LSR/Snippet?id=1098
 | 
				
			||||||
 | 
					%%%%%%%% HEADER %%%%%%%%
 | 
				
			||||||
 | 
					%
 | 
				
			||||||
 | 
					% this code was prompted by
 | 
				
			||||||
 | 
					% https://lists.gnu.org/archive/html/lilypond-user/2019-07/msg00139.html
 | 
				
			||||||
 | 
					% and offers a pseudoIndent hack suitable for general use
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					% keywords:
 | 
				
			||||||
 | 
					% indent short-indent indentation system line
 | 
				
			||||||
 | 
					% mid-score temporarily arbitrary individual single just only once
 | 
				
			||||||
 | 
					% coda margin
 | 
				
			||||||
 | 
					% mouse's tale acrostic mesostic spine
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					%%%%%%%% PSEUDOINDENT FUNCTIONS %%%%%%%%
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					% these two functions are for indenting individual systems
 | 
				
			||||||
 | 
					% - to left-indent a system, apply \pseudoIndent before the music continues
 | 
				
			||||||
 | 
					% - \pseudoIndents is similar, but lets you also indent on the right
 | 
				
			||||||
 | 
					% - both provide an option for changing that system's instrument names
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					% N.B. these functions
 | 
				
			||||||
 | 
					% - assume application to non-ragged lines (generally the default)
 | 
				
			||||||
 | 
					% - include a manual \break to ensure application at line start
 | 
				
			||||||
 | 
					% - misbehave if called more than once at the same line start
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					% the parameters of the (full) pseudoIndents function are:
 | 
				
			||||||
 | 
					% 1: name-tweaks
 | 
				
			||||||
 | 
					%      usually omitted; accepts replacement \markup for instrument names
 | 
				
			||||||
 | 
					%      as an ordered list; starred elements leave their i-names unchanged.
 | 
				
			||||||
 | 
					% 2: left-indent
 | 
				
			||||||
 | 
					%      additional left-indentation, in staff-space units; can be negative,
 | 
				
			||||||
 | 
					%      but avoid a total indentation which implies (unsupported) stretching.
 | 
				
			||||||
 | 
					% 3: right-indent
 | 
				
			||||||
 | 
					%      amount of right-indentation, in staff-space units; can be negative.
 | 
				
			||||||
 | 
					%      - not offered by the (reduced) pseudoIndent function
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					pseudoIndents = % inline alternative to a new \score, also with right-indent
 | 
				
			||||||
 | 
					#(define-music-function (name-tweaks left-indent right-indent)
 | 
				
			||||||
 | 
					  ((markup-list? '()) number? number?)
 | 
				
			||||||
 | 
					  (define (warn-stretched p1 p2) (ly:input-warning (*location*) (G_
 | 
				
			||||||
 | 
					    " pseudoIndents ~s ~s is stretching staff; expect distorted layout") p1 p2))
 | 
				
			||||||
 | 
					  (let* (
 | 
				
			||||||
 | 
					    (narrowing (+ left-indent right-indent)) ; of staff implied by args
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    (set-staffsymbol! (lambda (staffsymbol-grob) ; change staff to new width
 | 
				
			||||||
 | 
					      (let* (
 | 
				
			||||||
 | 
					        (left-bound (ly:spanner-bound staffsymbol-grob LEFT))
 | 
				
			||||||
 | 
					        (left-moment (ly:grob-property left-bound 'when))
 | 
				
			||||||
 | 
					        (capo? (moment<=? left-moment ZERO-MOMENT)) ; in first system of score
 | 
				
			||||||
 | 
					        (layout (ly:grob-layout staffsymbol-grob))
 | 
				
			||||||
 | 
					        (lw (ly:output-def-lookup layout 'line-width)) ; debugging info
 | 
				
			||||||
 | 
					        (indent (ly:output-def-lookup layout (if capo? 'indent 'short-indent)))
 | 
				
			||||||
 | 
					        (old-stil (ly:staff-symbol::print staffsymbol-grob))
 | 
				
			||||||
 | 
					        (staffsymbol-x-ext (ly:stencil-extent old-stil X))
 | 
				
			||||||
 | 
					        ;; >=2.19.16's first system has old-stil already narrowed [2]
 | 
				
			||||||
 | 
					        ;; compensate for this (ie being not pristine) when calculating
 | 
				
			||||||
 | 
					        ;; - old leftmost-x (its value is needed when setting so-called 'width)
 | 
				
			||||||
 | 
					        ;; - the new width and position (via local variable narrowing_)
 | 
				
			||||||
 | 
					        (ss-t (ly:staff-symbol-line-thickness staffsymbol-grob))
 | 
				
			||||||
 | 
					        (pristine? (<= 0 (car staffsymbol-x-ext) ss-t)) ; would expect half
 | 
				
			||||||
 | 
					        (leftmost-x (+ indent (if pristine? 0 narrowing)))
 | 
				
			||||||
 | 
					        (narrowing_ (if pristine? narrowing 0)) ; uses 0 if already narrowed
 | 
				
			||||||
 | 
					        (old-width (+ (interval-length staffsymbol-x-ext) ss-t))
 | 
				
			||||||
 | 
					        (new-width (- old-width narrowing_))
 | 
				
			||||||
 | 
					        (new-rightmost-x (+ leftmost-x new-width)) ; and set! this immediately
 | 
				
			||||||
 | 
					        (junk (ly:grob-set-property! staffsymbol-grob 'width new-rightmost-x))
 | 
				
			||||||
 | 
					        (in-situ-stil (ly:staff-symbol::print staffsymbol-grob))
 | 
				
			||||||
 | 
					        (new-stil (ly:stencil-translate-axis in-situ-stil narrowing_ X))
 | 
				
			||||||
 | 
					       ;(new-stil (stencil-with-color new-stil red)) ; for when debugging
 | 
				
			||||||
 | 
					        (new-x-ext (ly:stencil-extent new-stil X)))
 | 
				
			||||||
 | 
					      (ly:grob-set-property! staffsymbol-grob 'stencil new-stil)
 | 
				
			||||||
 | 
					      (ly:grob-set-property! staffsymbol-grob 'X-extent new-x-ext)
 | 
				
			||||||
 | 
					      )))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    (set-X-offset! (lambda (margin-grob) ; move grob across to line start
 | 
				
			||||||
 | 
					      (let* (
 | 
				
			||||||
 | 
					        (old (ly:grob-property-data margin-grob 'X-offset))
 | 
				
			||||||
 | 
					        (new (lambda (grob) (+ (if (procedure? old) (old grob) old) narrowing))))
 | 
				
			||||||
 | 
					      (ly:grob-set-property! margin-grob 'X-offset new))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    (tweak-text! (lambda (i-name-grob mkup) ; tweak both instrumentname texts
 | 
				
			||||||
 | 
					      (if (and (markup? mkup) (not (string=? (markup->string mkup) "*")))
 | 
				
			||||||
 | 
					      (begin
 | 
				
			||||||
 | 
					        (ly:grob-set-property! i-name-grob 'long-text mkup)
 | 
				
			||||||
 | 
					        (ly:grob-set-property! i-name-grob 'text mkup)
 | 
				
			||||||
 | 
					        )))) ; else retain existing text
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    (install-narrowing (lambda (leftedge-grob) ; on staves, + adapt left margin
 | 
				
			||||||
 | 
					      (let* (
 | 
				
			||||||
 | 
					        (sys (ly:grob-system leftedge-grob))
 | 
				
			||||||
 | 
					        (all-grobs (ly:grob-array->list (ly:grob-object sys 'all-elements)))
 | 
				
			||||||
 | 
					        (grobs-named (lambda (name)
 | 
				
			||||||
 | 
					          (filter (lambda (x) (eq? name (grob::name x))) all-grobs)))
 | 
				
			||||||
 | 
					        (first-leftedge-grob (list-ref (grobs-named 'LeftEdge) 0))
 | 
				
			||||||
 | 
					        (relsys-x-of (lambda (g) (ly:grob-relative-coordinate g sys X)))
 | 
				
			||||||
 | 
					        (leftedge-x (relsys-x-of first-leftedge-grob))
 | 
				
			||||||
 | 
					        (leftedged? (lambda (g) (= (relsys-x-of g) leftedge-x)))
 | 
				
			||||||
 | 
					        (leftedged-ss (filter leftedged? (grobs-named 'StaffSymbol))))
 | 
				
			||||||
 | 
					      (if (eq? leftedge-grob first-leftedge-grob) ; ignore other leftedges [1]
 | 
				
			||||||
 | 
					       (begin
 | 
				
			||||||
 | 
					         (for-each set-staffsymbol! leftedged-ss)
 | 
				
			||||||
 | 
					         (for-each set-X-offset! (grobs-named 'SystemStartBar))
 | 
				
			||||||
 | 
					         (for-each set-X-offset! (grobs-named 'InstrumentName))
 | 
				
			||||||
 | 
					         (for-each tweak-text! (grobs-named 'InstrumentName) name-tweaks)
 | 
				
			||||||
 | 
					       ))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  (if (negative? narrowing) (warn-stretched left-indent right-indent))
 | 
				
			||||||
 | 
					  #{ % and continue anyway
 | 
				
			||||||
 | 
					    % ensure that these overrides are applied only at begin-of-line
 | 
				
			||||||
 | 
					    \break % (but this does not exclude unsupported multiple application)
 | 
				
			||||||
 | 
					    % give the spacing engine notice regarding the loss of width for music
 | 
				
			||||||
 | 
					    \once \override Score.LeftEdge.X-extent = #(cons narrowing narrowing)
 | 
				
			||||||
 | 
					    % discard line start region of staff and reassemble left-margin elements
 | 
				
			||||||
 | 
					    \once \override Score.LeftEdge.after-line-breaking = #install-narrowing
 | 
				
			||||||
 | 
					    % shift the system to partition the narrowing between left and right
 | 
				
			||||||
 | 
					    \overrideProperty Score.NonMusicalPaperColumn.line-break-system-details
 | 
				
			||||||
 | 
					    .X-offset #(- right-indent)
 | 
				
			||||||
 | 
					    % prevent a leftmost barnumber entering a stretched staff
 | 
				
			||||||
 | 
					    \once \override Score.BarNumber.horizon-padding = #(max 1 (- 1 narrowing))
 | 
				
			||||||
 | 
					  #}))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					pseudoIndent = % for changing just left-indent
 | 
				
			||||||
 | 
					#(define-music-function (name-tweaks left-indent)
 | 
				
			||||||
 | 
					  ((markup-list? '()) number?)
 | 
				
			||||||
 | 
					  #{
 | 
				
			||||||
 | 
					    \pseudoIndents $name-tweaks $left-indent 0
 | 
				
			||||||
 | 
					  #})
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					% [1] versions <2.19.1 can have end-of-line leftedges too
 | 
				
			||||||
 | 
					%     - these were eliminated in issue 3761
 | 
				
			||||||
 | 
					% [2] versions >=2.19.16: the first system behaves differently from the rest
 | 
				
			||||||
 | 
					%     - a side effect of issue 660 ?
 | 
				
			||||||
 | 
					% [3] versions >=2.23.0: LeftEdge's position may well differ in Y (but not in X)
 | 
				
			||||||
 | 
					%     - a side effect of issue 6084 ?
 | 
				
			||||||
@@ -2,10 +2,14 @@
 | 
				
			|||||||
  poetPrefix = "Worte:"
 | 
					  poetPrefix = "Worte:"
 | 
				
			||||||
  composerPrefix = "Weise:"
 | 
					  composerPrefix = "Weise:"
 | 
				
			||||||
  compositionPrefix = "Satz:"
 | 
					  compositionPrefix = "Satz:"
 | 
				
			||||||
 | 
					  adaptionTextPrefix = "Bearbeitung Text:"
 | 
				
			||||||
 | 
					  adaptionMusicPrefix = "Bearbeitung Musik:"
 | 
				
			||||||
  poetAndComposerEqualPrefix = "Worte und Weise:"
 | 
					  poetAndComposerEqualPrefix = "Worte und Weise:"
 | 
				
			||||||
  voicePrefix = "Stimme:"
 | 
					  voicePrefix = "Stimme:"
 | 
				
			||||||
  versePrefix = "Strophe:"
 | 
					  versePrefix = "Strophe:"
 | 
				
			||||||
 | 
					  translationAuthorPrefix = "Übersetzung:"
 | 
				
			||||||
  translationPrefix = "Übersetzung:"
 | 
					  translationPrefix = "Übersetzung:"
 | 
				
			||||||
 | 
					  pronunciationPrefix = "Aussprache:"
 | 
				
			||||||
  interludePrefix = "Zwischenspiel:"
 | 
					  interludePrefix = "Zwischenspiel:"
 | 
				
			||||||
  bridgePrefix = "Bridge:"
 | 
					  bridgePrefix = "Bridge:"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -41,22 +45,34 @@
 | 
				
			|||||||
              (year_melody (chain-assoc-get 'songinfo:year_melody props #f))
 | 
					              (year_melody (chain-assoc-get 'songinfo:year_melody props #f))
 | 
				
			||||||
              (poet-with-year (if (and poet-maybe-with-composer year_text) (string-append poet-maybe-with-composer ", " year_text) poet-maybe-with-composer))
 | 
					              (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))
 | 
					              (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))
 | 
					              (string-with-paragraphs->markuplist (lambda (prefix text)
 | 
				
			||||||
 | 
					                (if text
 | 
				
			||||||
 | 
					                  (apply append
 | 
				
			||||||
 | 
					                    (map
 | 
				
			||||||
 | 
					                      (lambda (paragraph)
 | 
				
			||||||
 | 
					                        (make-wordwrap-internal-markup-list #t
 | 
				
			||||||
 | 
					                          #{ \markuplist { $(ly:parser-include-string paragraph) } #}))
 | 
				
			||||||
 | 
					                      (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))))
 | 
					              (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)
 | 
					          (stack-lines DOWN 0.0 (chain-assoc-get 'baseline-skip props)
 | 
				
			||||||
            (interpret-markup-list layout props
 | 
					            (interpret-markup-list layout props
 | 
				
			||||||
              (append
 | 
					              (append
 | 
				
			||||||
                (if (and poet-and-composer-oneliner (< (interval-length (ly:stencil-extent (interpret-markup layout props poet-and-composer-oneliner) X)) current-line-width))
 | 
					                (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)
 | 
					                  (list poet-and-composer-oneliner)
 | 
				
			||||||
                  (make-wordwrap-string-internal-markup-list #t (string-append
 | 
					                  poet-and-composer-markup-list)
 | 
				
			||||||
                    (if poet-with-year (string-append "\n\n" poet-with-year) "")
 | 
					                (string-with-paragraphs->markuplist "" (string-append
 | 
				
			||||||
                    (if composer-with-year (string-append "\n\n" composer-with-year) "")
 | 
					                  (if copyright (string-append "\n\n© " copyright) "")))
 | 
				
			||||||
                  )))
 | 
					                (string-with-paragraphs->markuplist "" infotext)
 | 
				
			||||||
                (make-wordwrap-string-internal-markup-list #t (string-append
 | 
					                (string-with-paragraphs->markuplist (string-append (ly:output-def-lookup layout 'translationPrefix) " ") translation)
 | 
				
			||||||
                  (if copyright (string-append "\n\n© " copyright) "")
 | 
					                (string-with-paragraphs->markuplist (string-append (ly:output-def-lookup layout 'pronunciationPrefix) " ") pronunciation)
 | 
				
			||||||
                  (if infotext (string-append "\n\n" infotext) "")
 | 
					                  )))))
 | 
				
			||||||
                  (if translation (string-append "\n\nÜbersetzung: " translation) "")
 | 
					 | 
				
			||||||
                  (if pronunciation (string-append "\n\nAussprache: " pronunciation) ""))))))))
 | 
					 | 
				
			||||||
      (make-null-markup)
 | 
					      (make-null-markup)
 | 
				
			||||||
    )
 | 
					    )
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
@@ -3,9 +3,9 @@ songMargin = 5
 | 
				
			|||||||
songInfoFontSize = 0
 | 
					songInfoFontSize = 0
 | 
				
			||||||
songInfoLineWidthFraction = 0.9
 | 
					songInfoLineWidthFraction = 0.9
 | 
				
			||||||
songTitleSize = 6
 | 
					songTitleSize = 6
 | 
				
			||||||
songTitleFont = "LilyPond Sans"
 | 
					songTitleFont = "Liberation Sans"
 | 
				
			||||||
songChordFont = "LilyPond Sans"
 | 
					songChordFont = "Liberation Sans"
 | 
				
			||||||
songLyricFont = "LilyPond Sans"
 | 
					songLyricFont = "Liberation Sans"
 | 
				
			||||||
songChordFontSeries = #'bold
 | 
					songChordFontSeries = #'bold
 | 
				
			||||||
songTextChordAlignment = #'left
 | 
					songTextChordAlignment = #'left
 | 
				
			||||||
songScoreChordFontSize = 2
 | 
					songScoreChordFontSize = 2
 | 
				
			||||||
@@ -18,6 +18,18 @@ lyricSize = 1.6
 | 
				
			|||||||
stanzaFormat = "~a."
 | 
					stanzaFormat = "~a."
 | 
				
			||||||
romanStanzaFormat = "~@r."
 | 
					romanStanzaFormat = "~@r."
 | 
				
			||||||
refString = "Ref.:"
 | 
					refString = "Ref.:"
 | 
				
			||||||
 | 
					refStringWithNumbers = "Ref. ~a:"
 | 
				
			||||||
% hübsche Wiederholungszeichen für den Liedtext
 | 
					% hübsche Wiederholungszeichen für den Liedtext
 | 
				
			||||||
repStart = "𝄆"
 | 
					repStart = "𝄆"
 | 
				
			||||||
repStop = "𝄇"
 | 
					repStop = "𝄇"
 | 
				
			||||||
 | 
					customChordPrintings = {}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					\paper {
 | 
				
			||||||
 | 
					  cueMarkup = \markup {
 | 
				
			||||||
 | 
					    \italic
 | 
				
			||||||
 | 
					      #(make-on-the-fly-markup (lambda (layout props m)
 | 
				
			||||||
 | 
					        (interpret-markup layout props
 | 
				
			||||||
 | 
					          (string-join (map (lambda (n) (format #f "~@r." n)) (chain-assoc-get 'cues props)) ", ")))
 | 
				
			||||||
 | 
					        (make-null-markup))
 | 
				
			||||||
 | 
					  }
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
@@ -4,15 +4,15 @@
 | 
				
			|||||||
  (interpret-markup-list layout (prepend-alist-chain 'songfilename songfilename props) markuplist))
 | 
					  (interpret-markup-list layout (prepend-alist-chain 'songfilename songfilename props) markuplist))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define-markup-command (customEps layout props ysize filename)(number? string?)
 | 
					#(define-markup-command (customEps layout props ysize filename)(number? string?)
 | 
				
			||||||
   #:properties ((songfilename "")
 | 
					   #:properties ((songfilename ""))
 | 
				
			||||||
                 (defaultmarkup #f))
 | 
					 | 
				
			||||||
   (interpret-markup layout props
 | 
					   (interpret-markup layout props
 | 
				
			||||||
     (let ((filepath (if (string-null? songfilename)
 | 
					     (let ((defaulttitlemarkup (ly:output-def-lookup layout 'defaultTitleMarkup))
 | 
				
			||||||
 | 
					           (filepath (if (string-null? songfilename)
 | 
				
			||||||
                          filename
 | 
					                          filename
 | 
				
			||||||
                          (ly:format "~a/~a/~a" songPath songfilename filename))))
 | 
					                          (ly:format "~a/~a/~a" songPath songfilename filename))))
 | 
				
			||||||
       (if (file-exists? filepath)
 | 
					       (if (file-exists? filepath)
 | 
				
			||||||
             (make-epsfile-markup Y ysize filepath)
 | 
					             (make-epsfile-markup Y ysize filepath)
 | 
				
			||||||
             (if defaultmarkup
 | 
					             (if defaulttitlemarkup
 | 
				
			||||||
                 defaultmarkup
 | 
					                 defaulttitlemarkup
 | 
				
			||||||
                 (ly:format "file does not exist ~a" filepath))
 | 
					                 (ly:format "file does not exist ~a" filepath))
 | 
				
			||||||
))))
 | 
					))))
 | 
				
			||||||
@@ -1,8 +1,8 @@
 | 
				
			|||||||
#(use-modules (ice-9 receive))
 | 
					#(use-modules (ice-9 receive))
 | 
				
			||||||
#(define (format-author layout authorId noDetails)
 | 
					#(define (format-author author-format-function authorId noDetails)
 | 
				
			||||||
  (let ((author (if (defined? 'AUTHOR_DATA) (assoc-ref AUTHOR_DATA authorId) #f)))
 | 
					  (let ((author (if (defined? 'AUTHOR_DATA) (assoc-ref AUTHOR_DATA authorId) #f)))
 | 
				
			||||||
    (if author
 | 
					    (if author
 | 
				
			||||||
      ((ly:output-def-lookup layout 'authorFormat)
 | 
					      (author-format-function
 | 
				
			||||||
        noDetails
 | 
					        noDetails
 | 
				
			||||||
        (assoc-ref author "name")
 | 
					        (assoc-ref author "name")
 | 
				
			||||||
        (assoc-ref author "trail_name")
 | 
					        (assoc-ref author "trail_name")
 | 
				
			||||||
@@ -10,17 +10,25 @@
 | 
				
			|||||||
        (assoc-ref author "death_year")
 | 
					        (assoc-ref author "death_year")
 | 
				
			||||||
        (assoc-ref author "organization")
 | 
					        (assoc-ref author "organization")
 | 
				
			||||||
      )
 | 
					      )
 | 
				
			||||||
      "unbekannt")))
 | 
					      (if (string-null? authorId)
 | 
				
			||||||
 | 
					          "unbekannt"
 | 
				
			||||||
 | 
					          authorId))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define (find-author-ids-by contributionType authors)
 | 
					#(define (find-author-ids-by contributionType authors)
 | 
				
			||||||
  (filter-map (lambda (authordata) (if (member contributionType (cdr authordata)) (car authordata) #f)) authors))
 | 
					  (if authors
 | 
				
			||||||
 | 
					    (filter-map (lambda (authordata) (if (member contributionType (cdr authordata)) (car authordata) #f)) authors)
 | 
				
			||||||
 | 
					    (list)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define (find-author-id-with-part-numbers contributionType authors)
 | 
					#(define (find-author-id-with-part-numbers contributionType authors)
 | 
				
			||||||
  (filter-map (lambda (authordata)
 | 
					  (if authors
 | 
				
			||||||
    (let ((contributionNumbers (filter-map (lambda (contribution) (if (and (list? contribution) (equal? contributionType (car contribution))) (cadr contribution) #f)) (cdr authordata)))
 | 
					    (sort-list
 | 
				
			||||||
          (authorId (car authordata)))
 | 
					      (filter-map (lambda (authordata)
 | 
				
			||||||
      (if (null? contributionNumbers) #f (cons authorId contributionNumbers))
 | 
					        (let ((contributionNumbers (filter-map (lambda (contribution) (if (and (list? contribution) (equal? contributionType (car contribution))) (cadr contribution) #f)) (cdr authordata)))
 | 
				
			||||||
    )) authors))
 | 
					              (authorId (car authordata)))
 | 
				
			||||||
 | 
					          (if (null? contributionNumbers) #f (cons authorId (sort-list contributionNumbers <)))
 | 
				
			||||||
 | 
					        )) authors)
 | 
				
			||||||
 | 
					      (lambda (a b) (< (cadr a) (cadr b))))
 | 
				
			||||||
 | 
					    (list)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define-markup-command (print-songinfo layout props) ()
 | 
					#(define-markup-command (print-songinfo layout props) ()
 | 
				
			||||||
  (define (songinfo-from songId key)
 | 
					  (define (songinfo-from songId key)
 | 
				
			||||||
@@ -29,14 +37,17 @@
 | 
				
			|||||||
        (assoc-ref song key)
 | 
					        (assoc-ref song key)
 | 
				
			||||||
        (ly:warning (ly:format "song with id ~a not found" songId)))))
 | 
					        (ly:warning (ly:format "song with id ~a not found" songId)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  (define* (default-author-format authorId #:optional (noDetails #f))
 | 
				
			||||||
 | 
					    (format-author (ly:output-def-lookup layout 'authorFormat) authorId noDetails))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  (define (format-poet poetId)
 | 
					  (define (format-poet poetId)
 | 
				
			||||||
    (string-append (ly:output-def-lookup layout 'poetPrefix) " " (format-author layout poetId #f)))
 | 
					    (string-append (ly:output-def-lookup layout 'poetPrefix) " " (default-author-format poetId)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  (define (format-composer composerId)
 | 
					  (define (format-composer composerId)
 | 
				
			||||||
    (string-append (ly:output-def-lookup layout 'composerPrefix) " " (format-author layout composerId #f)))
 | 
					    (string-append (ly:output-def-lookup layout 'composerPrefix) " " (default-author-format composerId)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  (define (format-poet-and-composer authorId)
 | 
					  (define (format-poet-and-composer authorId)
 | 
				
			||||||
    (string-append (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) " " (format-author layout authorId #f)))
 | 
					    (string-append (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) " " (default-author-format authorId)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  (define (numbered-contribution-prefix contributionNumbers prefixLookup)
 | 
					  (define (numbered-contribution-prefix contributionNumbers prefixLookup)
 | 
				
			||||||
    (string-append
 | 
					    (string-append
 | 
				
			||||||
@@ -50,8 +61,7 @@
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
  (define (format-authors authorIds)
 | 
					  (define (format-authors authorIds)
 | 
				
			||||||
    (map (lambda (authorId)
 | 
					    (map (lambda (authorId)
 | 
				
			||||||
      (format-author
 | 
					      (default-author-format
 | 
				
			||||||
        layout
 | 
					 | 
				
			||||||
        authorId
 | 
					        authorId
 | 
				
			||||||
        (if (member authorId referencedAuthors)
 | 
					        (if (member authorId referencedAuthors)
 | 
				
			||||||
          #t
 | 
					          #t
 | 
				
			||||||
@@ -67,22 +77,20 @@
 | 
				
			|||||||
      (string-append contributionPrefix " " (string-join (format-authors authorIds) ", ")))
 | 
					      (string-append contributionPrefix " " (string-join (format-authors authorIds) ", ")))
 | 
				
			||||||
  )
 | 
					  )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  (define (join-present items joiner)
 | 
				
			||||||
 | 
					    (string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner)
 | 
				
			||||||
 | 
					  )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  (define (render-partial-contribution-group prefixLookup authorData)
 | 
					  (define (render-partial-contribution-group prefixLookup authorData)
 | 
				
			||||||
    (if (null? authorData)
 | 
					    (if (null? authorData)
 | 
				
			||||||
      ""
 | 
					      ""
 | 
				
			||||||
      (let ((firstAuthorContributions (cdar authorData)))
 | 
					      (let ((firstAuthorContributions (cdar authorData)))
 | 
				
			||||||
        (receive (authorDataSame authorDataOther)
 | 
					        (receive (authorDataSame authorDataOther)
 | 
				
			||||||
            (partition (lambda (authorEntry) (equal? (cdr authorEntry) firstAuthorContributions)) authorData)
 | 
					            (partition (lambda (authorEntry) (equal? (cdr authorEntry) firstAuthorContributions)) authorData)
 | 
				
			||||||
          (string-append
 | 
					          (join-present (list
 | 
				
			||||||
            (render-contribution-group (numbered-contribution-prefix firstAuthorContributions prefixLookup) (map car authorDataSame))
 | 
					            (render-contribution-group (numbered-contribution-prefix firstAuthorContributions prefixLookup) (map car authorDataSame))
 | 
				
			||||||
            " "
 | 
					 | 
				
			||||||
            (render-partial-contribution-group prefixLookup authorDataOther)
 | 
					            (render-partial-contribution-group prefixLookup authorDataOther)
 | 
				
			||||||
          ))))
 | 
					            ) " ")))))
 | 
				
			||||||
  )
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
  (define (join-present items joiner)
 | 
					 | 
				
			||||||
    (string-join (filter (lambda (item) (and (string? item) (not (string-null? (string-trim-both item))))) items) joiner)
 | 
					 | 
				
			||||||
  )
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
  (define (poet-and-composer-from-authors authors)
 | 
					  (define (poet-and-composer-from-authors authors)
 | 
				
			||||||
    (if authors
 | 
					    (if authors
 | 
				
			||||||
@@ -94,14 +102,28 @@
 | 
				
			|||||||
            (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
 | 
					            (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
 | 
				
			||||||
            (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
 | 
					            (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
 | 
				
			||||||
            (compositionIds (find-author-ids-by 'composition authors))
 | 
					            (compositionIds (find-author-ids-by 'composition authors))
 | 
				
			||||||
 | 
					            (adaptionTextIds (find-author-ids-by 'adaption_text authors))
 | 
				
			||||||
 | 
					            (adaptionMusicIds (find-author-ids-by 'adaption_music authors))
 | 
				
			||||||
            (bridgeIds (find-author-ids-by 'bridge authors))
 | 
					            (bridgeIds (find-author-ids-by 'bridge authors))
 | 
				
			||||||
            (interludeIds (find-author-ids-by 'interlude authors))
 | 
					            (interludeIds (find-author-ids-by 'interlude authors))
 | 
				
			||||||
            (year_text (chain-assoc-get 'header:year_text props #f))
 | 
					            (year_text (chain-assoc-get 'header:year_text props #f))
 | 
				
			||||||
            (year_translation (chain-assoc-get 'header:year_translation props #f))
 | 
					            (year_translation (chain-assoc-get 'header:year_translation props #f))
 | 
				
			||||||
            (year_melody (chain-assoc-get 'header:year_melody props #f))
 | 
					            (year_melody (chain-assoc-get 'header:year_melody props #f))
 | 
				
			||||||
            (year_composition (chain-assoc-get 'header:year_composition props #f))
 | 
					            (year_composition (chain-assoc-get 'header:year_composition 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? 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
 | 
					          (list
 | 
				
			||||||
            (join-present (list
 | 
					            (join-present (list
 | 
				
			||||||
              (render-contribution-group (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) poetIds)
 | 
					              (render-contribution-group (ly:output-def-lookup layout 'poetAndComposerEqualPrefix) poetIds)
 | 
				
			||||||
@@ -120,12 +142,23 @@
 | 
				
			|||||||
                  ) ", ")
 | 
					                  ) ", ")
 | 
				
			||||||
                  (render-partial-contribution-group 'versePrefix versePoetData)
 | 
					                  (render-partial-contribution-group 'versePrefix versePoetData)
 | 
				
			||||||
                  (join-present (list
 | 
					                  (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
 | 
					                    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? 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
 | 
					              (string-append
 | 
				
			||||||
                (ly:output-def-lookup layout 'composerPrefix)
 | 
					                (ly:output-def-lookup layout 'composerPrefix)
 | 
				
			||||||
                " "
 | 
					                " "
 | 
				
			||||||
@@ -140,6 +173,10 @@
 | 
				
			|||||||
                    (render-contribution-group (ly:output-def-lookup layout 'compositionPrefix) compositionIds)
 | 
					                    (render-contribution-group (ly:output-def-lookup layout 'compositionPrefix) compositionIds)
 | 
				
			||||||
                    year_composition
 | 
					                    year_composition
 | 
				
			||||||
                  ) ", ")
 | 
					                  ) ", ")
 | 
				
			||||||
 | 
					                  (join-present (list
 | 
				
			||||||
 | 
					                    (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 'bridgePrefix) bridgeIds)
 | 
				
			||||||
                  (render-contribution-group (ly:output-def-lookup layout 'interludePrefix) interludeIds)
 | 
					                  (render-contribution-group (ly:output-def-lookup layout 'interludePrefix) interludeIds)
 | 
				
			||||||
                ) "; ")
 | 
					                ) "; ")
 | 
				
			||||||
@@ -212,14 +249,14 @@
 | 
				
			|||||||
  oddFooterMarkup = \markup {
 | 
					  oddFooterMarkup = \markup {
 | 
				
			||||||
    \fill-line {
 | 
					    \fill-line {
 | 
				
			||||||
      \line { \null }
 | 
					      \line { \null }
 | 
				
			||||||
      \line { \general-align #Y #DOWN \fractional-line-width \print-songinfo }
 | 
					      \line { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo }
 | 
				
			||||||
      \line { \if \should-print-page-number \print-pagenumber }
 | 
					      \line { \if \should-print-page-number \print-pagenumber }
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
  }
 | 
					  }
 | 
				
			||||||
  evenFooterMarkup  = \markup {
 | 
					  evenFooterMarkup  = \markup {
 | 
				
			||||||
    \fill-line {
 | 
					    \fill-line {
 | 
				
			||||||
      \line { \if \should-print-page-number \print-pagenumber }
 | 
					      \line { \if \should-print-page-number \print-pagenumber }
 | 
				
			||||||
      \line { \general-align #Y #DOWN \fractional-line-width \print-songinfo }
 | 
					      \line { \if \on-last-page-of-part \general-align #Y #DOWN \fractional-line-width \print-songinfo }
 | 
				
			||||||
      \line { \null }
 | 
					      \line { \null }
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
  }
 | 
					  }
 | 
				
			||||||
							
								
								
									
										15
									
								
								private_includes/base/include_from_song.ily
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										15
									
								
								private_includes/base/include_from_song.ily
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,15 @@
 | 
				
			|||||||
 | 
					includeFromSong =
 | 
				
			||||||
 | 
					#(define-void-function (filename) (string?)
 | 
				
			||||||
 | 
					  (let ((noDefaultOutputBackup noDefaultOutput))
 | 
				
			||||||
 | 
					    (set! noDefaultOutput #t)
 | 
				
			||||||
 | 
					    (ly:parser-parse-string (ly:parser-clone)
 | 
				
			||||||
 | 
					      (ly:format "\\include \"~a\""
 | 
				
			||||||
 | 
					      (string-append
 | 
				
			||||||
 | 
					        (dirname (dirname (dirname (dirname (current-filename)))))
 | 
				
			||||||
 | 
					        file-name-separator-string
 | 
				
			||||||
 | 
					        "lilypond-song-includes"
 | 
				
			||||||
 | 
					        file-name-separator-string
 | 
				
			||||||
 | 
					        "liedbausteine"
 | 
				
			||||||
 | 
					        file-name-separator-string
 | 
				
			||||||
 | 
					        filename)))
 | 
				
			||||||
 | 
					    (set! noDefaultOutput noDefaultOutputBackup)))
 | 
				
			||||||
@@ -6,3 +6,8 @@ inline-score =
 | 
				
			|||||||
    #{
 | 
					    #{
 | 
				
			||||||
      \transposable #TRANSPOSITION #music
 | 
					      \transposable #TRANSPOSITION #music
 | 
				
			||||||
    #})
 | 
					    #})
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					fill-midi =
 | 
				
			||||||
 | 
					#(define-void-function (music) (ly:music?)
 | 
				
			||||||
 | 
					   (set! INLINESCOREMUSIC #{ \INLINESCOREMUSIC #music #})
 | 
				
			||||||
 | 
					)
 | 
				
			||||||
							
								
								
									
										86
									
								
								private_includes/base/merge_rests_engraver_override.ily
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										86
									
								
								private_includes/base/merge_rests_engraver_override.ily
									
									
									
									
									
										Normal file
									
								
							@@ -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)))))))
 | 
				
			||||||
							
								
								
									
										154
									
								
								private_includes/base/scm/yaml_parser.scm
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										154
									
								
								private_includes/base/scm/yaml_parser.scm
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,154 @@
 | 
				
			|||||||
 | 
					(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					;; 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)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))
 | 
				
			||||||
@@ -47,6 +47,55 @@ swing = \mark \markup {
 | 
				
			|||||||
  }
 | 
					  }
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					swingOff = \mark \markup {
 | 
				
			||||||
 | 
					  \line \general-align #Y #DOWN {
 | 
				
			||||||
 | 
					    \score {
 | 
				
			||||||
 | 
					      \new Staff \with {
 | 
				
			||||||
 | 
					        fontSize = #-2
 | 
				
			||||||
 | 
					        \override StaffSymbol.line-count = #0
 | 
				
			||||||
 | 
					%        \override VerticalAxisGroup.Y-extent = #'(0 . 0)
 | 
				
			||||||
 | 
					      }
 | 
				
			||||||
 | 
					      \relative {
 | 
				
			||||||
 | 
					        \stemUp
 | 
				
			||||||
 | 
					        \override Score.SpacingSpanner.common-shortest-duration = #(ly:make-moment 3 16)
 | 
				
			||||||
 | 
					        \override Beam.positions = #'(2 . 2)
 | 
				
			||||||
 | 
					        h'8[ h8]
 | 
				
			||||||
 | 
					      }
 | 
				
			||||||
 | 
					      \layout {
 | 
				
			||||||
 | 
					        ragged-right= ##t
 | 
				
			||||||
 | 
					        indent = 0
 | 
				
			||||||
 | 
					        \context {
 | 
				
			||||||
 | 
					          \Staff \remove "Clef_engraver"
 | 
				
			||||||
 | 
					          \remove "Time_signature_engraver"
 | 
				
			||||||
 | 
					        }
 | 
				
			||||||
 | 
					      }
 | 
				
			||||||
 | 
					    }
 | 
				
			||||||
 | 
					    " ="
 | 
				
			||||||
 | 
					    \score {
 | 
				
			||||||
 | 
					      \new Staff \with {
 | 
				
			||||||
 | 
					        fontSize = #-2
 | 
				
			||||||
 | 
					        \override StaffSymbol.line-count = #0
 | 
				
			||||||
 | 
					%        \override VerticalAxisGroup.Y-extent = #'(0 . 0)
 | 
				
			||||||
 | 
					      }
 | 
				
			||||||
 | 
					      \relative {
 | 
				
			||||||
 | 
					        \stemUp
 | 
				
			||||||
 | 
					        \override Score.SpacingSpanner.common-shortest-duration = #(ly:make-moment 3 16)
 | 
				
			||||||
 | 
					        \override Beam.positions = #'(2 . 2)
 | 
				
			||||||
 | 
					        h'8 [h8]
 | 
				
			||||||
 | 
					      }
 | 
				
			||||||
 | 
					      \layout {
 | 
				
			||||||
 | 
					        ragged-right= ##t
 | 
				
			||||||
 | 
					        indent = 0
 | 
				
			||||||
 | 
					        \context {
 | 
				
			||||||
 | 
					          \Staff
 | 
				
			||||||
 | 
					          \remove "Clef_engraver"
 | 
				
			||||||
 | 
					          \remove "Time_signature_engraver"
 | 
				
			||||||
 | 
					        }
 | 
				
			||||||
 | 
					      }
 | 
				
			||||||
 | 
					    }
 | 
				
			||||||
 | 
					  }
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
\include "swing.ly"
 | 
					\include "swing.ly"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
swingMusic =
 | 
					swingMusic =
 | 
				
			||||||
@@ -59,7 +108,7 @@ swingMusic =
 | 
				
			|||||||
        (partial-duration-length (car es))
 | 
					        (partial-duration-length (car es))
 | 
				
			||||||
        (if (ly:music? e)
 | 
					        (if (ly:music? e)
 | 
				
			||||||
          (if (and (eq? name 'ContextSpeccedMusic) (eq? (ly:music-property e 'name) 'PartialSet))
 | 
					          (if (and (eq? name 'ContextSpeccedMusic) (eq? (ly:music-property e 'name) 'PartialSet))
 | 
				
			||||||
            (ly:duration-length (ly:music-property e 'duration))
 | 
					            (ly:duration->moment (ly:music-property e 'duration))
 | 
				
			||||||
            (if (eq? name 'NoteEvent)
 | 
					            (if (eq? name 'NoteEvent)
 | 
				
			||||||
              ZERO-MOMENT
 | 
					              ZERO-MOMENT
 | 
				
			||||||
              (partial-duration-length e)
 | 
					              (partial-duration-length e)
 | 
				
			||||||
@@ -1,16 +1,6 @@
 | 
				
			|||||||
#(define-markup-command (bookTitleMarkupCustom layout props)()
 | 
					#(define-markup-command (bookTitleMarkupCustom layout props)()
 | 
				
			||||||
   (interpret-markup layout
 | 
					   (interpret-markup layout
 | 
				
			||||||
     (prepend-alist-chain 'defaultmarkup #{
 | 
					     (prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props)
 | 
				
			||||||
\markup {
 | 
					 | 
				
			||||||
  \override #'(baseline-skip . 3.5)
 | 
					 | 
				
			||||||
  \center-column {
 | 
					 | 
				
			||||||
    \override #`(font-name . ,songTitleFont) { \fontsize #songTitleSize \fromproperty #'header:title }
 | 
					 | 
				
			||||||
    \large \bold \fromproperty #'header:subtitle
 | 
					 | 
				
			||||||
    \smaller \bold \fromproperty #'header:subsubtitle
 | 
					 | 
				
			||||||
  }
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
                           #}
 | 
					 | 
				
			||||||
     (prepend-alist-chain 'songfilename (chain-assoc-get 'header:songfilename props "") props))
 | 
					 | 
				
			||||||
     (make-column-markup
 | 
					     (make-column-markup
 | 
				
			||||||
       (list
 | 
					       (list
 | 
				
			||||||
         (make-vspace-markup (chain-assoc-get 'header:titletopspace props 0))
 | 
					         (make-vspace-markup (chain-assoc-get 'header:titletopspace props 0))
 | 
				
			||||||
@@ -41,7 +31,7 @@
 | 
				
			|||||||
     (ly:make-stencil
 | 
					     (ly:make-stencil
 | 
				
			||||||
      (list 'embedded-ps
 | 
					      (list 'embedded-ps
 | 
				
			||||||
             (ly:format
 | 
					             (ly:format
 | 
				
			||||||
              "[/Action /GoTo /View [/Fit] /Title (~a) /OUT pdfmark" (pdf-encode title)))
 | 
					              "[/Action /GoTo /View [/XYZ -4 currentpagedevice /PageSize get 1 get 4 add null] /Title (~a) /OUT pdfmark" (pdf-encode title)))
 | 
				
			||||||
      empty-interval empty-interval
 | 
					      empty-interval empty-interval
 | 
				
			||||||
      ;'(0 . 0) '(0 . 0)
 | 
					      ;'(0 . 0) '(0 . 0)
 | 
				
			||||||
      ))
 | 
					      ))
 | 
				
			||||||
@@ -52,12 +42,9 @@
 | 
				
			|||||||
            (starttext (chain-assoc-get 'header:starttext props #f))
 | 
					            (starttext (chain-assoc-get 'header:starttext props #f))
 | 
				
			||||||
            (pdfbookmark (if starttext (string-append starttext " | " title) title)))
 | 
					            (pdfbookmark (if starttext (string-append starttext " | " title) title)))
 | 
				
			||||||
     (if title
 | 
					     (if title
 | 
				
			||||||
     ;(if (chain-assoc-get 'header:categories props #f)
 | 
					 | 
				
			||||||
       (if right
 | 
					       (if right
 | 
				
			||||||
         #{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \category-images } } #}
 | 
					         #{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \category-images } } #}
 | 
				
			||||||
         #{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } } #})
 | 
					         #{\markup { \title-to-pdf-toc #pdfbookmark \fill-line \general-align #Y #UP { \category-images \bookTitleMarkupCustom \null } } #})
 | 
				
			||||||
       ;#{\markup \fill-line \general-align #Y #UP { \null \bookTitleMarkupCustom \null } #})
 | 
					 | 
				
			||||||
      ;(make-null-markup))
 | 
					 | 
				
			||||||
      #{ \markup { " " } #})
 | 
					      #{ \markup { " " } #})
 | 
				
			||||||
     )))
 | 
					     )))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -66,4 +53,12 @@
 | 
				
			|||||||
  scoreTitleMarkup = \markup \null
 | 
					  scoreTitleMarkup = \markup \null
 | 
				
			||||||
  oddHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##t }
 | 
					  oddHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##t }
 | 
				
			||||||
  evenHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##f }
 | 
					  evenHeaderMarkup = \markup { \if \on-first-page-of-part \title-with-category-images ##f }
 | 
				
			||||||
 | 
					  defaultTitleMarkup = \markup {
 | 
				
			||||||
 | 
					    \override #'(baseline-skip . 3.5)
 | 
				
			||||||
 | 
					    \center-column {
 | 
				
			||||||
 | 
					      \override #`(font-name . ,songTitleFont) { \fontsize #songTitleSize \fromproperty #'header:title }
 | 
				
			||||||
 | 
					      \large \bold \fromproperty #'header:subtitle
 | 
				
			||||||
 | 
					      \smaller \bold \fromproperty #'header:subsubtitle
 | 
				
			||||||
 | 
					    }
 | 
				
			||||||
 | 
					  }
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
@@ -221,14 +221,28 @@
 | 
				
			|||||||
                       (cons (car x) (+ (cdr x) amount))
 | 
					                       (cons (car x) (+ (cdr x) amount))
 | 
				
			||||||
                       y)))
 | 
					                       y)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define-markup-command (score-equal-height layout props reference-height lines)
 | 
					#(define-markup-command (score-equal-height-with-indents layout props lines)
 | 
				
			||||||
  (number? markup-list?)
 | 
					  (markup-list?)
 | 
				
			||||||
  #:category music
 | 
					  #:category music
 | 
				
			||||||
  #:properties ((baseline-skip))
 | 
					  #:properties ((intraverse-vspace 0)
 | 
				
			||||||
    (stack-stencils Y DOWN baseline-skip
 | 
					                (verse-line-height songTextLineHeigth)
 | 
				
			||||||
      (map
 | 
					                (line-indents '()))
 | 
				
			||||||
        (lambda (line) (ly:make-stencil (ly:stencil-expr line) (ly:stencil-extent line X) `(,(/ reference-height -2.0) . ,(/ reference-height 2.0))))
 | 
					    (let ((indents-max-index (- (length line-indents) 1)))
 | 
				
			||||||
        (interpret-markup-list layout props lines))))
 | 
					      (stack-stencils Y DOWN intraverse-vspace
 | 
				
			||||||
 | 
					        (index-map
 | 
				
			||||||
 | 
					          (lambda (index line)
 | 
				
			||||||
 | 
					            (let ((stil
 | 
				
			||||||
 | 
					                    (ly:make-stencil
 | 
				
			||||||
 | 
					                      (ly:stencil-expr line)
 | 
				
			||||||
 | 
					                      (ly:stencil-extent line X)
 | 
				
			||||||
 | 
					                      `(,(/ verse-line-height -2.0) . ,(/ verse-line-height 2.0)))))
 | 
				
			||||||
 | 
					              (if (<= index indents-max-index)
 | 
				
			||||||
 | 
					                (ly:stencil-translate-axis
 | 
				
			||||||
 | 
					                  stil
 | 
				
			||||||
 | 
					                  (list-ref line-indents index)
 | 
				
			||||||
 | 
					                  X)
 | 
				
			||||||
 | 
					                stil)))
 | 
				
			||||||
 | 
					          (interpret-markup-list layout props lines)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define-public (custom-lyric-text::print grob)
 | 
					#(define-public (custom-lyric-text::print grob)
 | 
				
			||||||
  "Allow interpretation of tildes as lyric tieing marks."
 | 
					  "Allow interpretation of tildes as lyric tieing marks."
 | 
				
			||||||
@@ -243,30 +257,30 @@
 | 
				
			|||||||
   #:properties ((verse-chords #{#})
 | 
					   #:properties ((verse-chords #{#})
 | 
				
			||||||
                 (verse-reference-voice #{#})
 | 
					                 (verse-reference-voice #{#})
 | 
				
			||||||
                 (verse-break-voice #{#})
 | 
					                 (verse-break-voice #{#})
 | 
				
			||||||
                 (verse-line-height songTextLineHeigth)
 | 
					 | 
				
			||||||
                 (verse-text-chord-distance songTextChordDistance)
 | 
					                 (verse-text-chord-distance songTextChordDistance)
 | 
				
			||||||
                 (intraverse-vspace 0)
 | 
					 | 
				
			||||||
                 (transposition (cons #f #f))
 | 
					                 (transposition (cons #f #f))
 | 
				
			||||||
                 (verselayout generalLayout))
 | 
					                 (verselayout generalLayout))
 | 
				
			||||||
  "Vers mit Akkorden"
 | 
					  "Vers mit Akkorden"
 | 
				
			||||||
  (interpret-markup layout props
 | 
					  (interpret-markup layout props
 | 
				
			||||||
    #{
 | 
					    #{
 | 
				
			||||||
      \markup {
 | 
					      \markup {
 | 
				
			||||||
        \override #`(baseline-skip . ,intraverse-vspace)
 | 
					        \score-equal-height-with-indents \score-lines {
 | 
				
			||||||
        \score-equal-height #verse-line-height \score-lines {
 | 
					 | 
				
			||||||
          \transposable #transposition
 | 
					 | 
				
			||||||
          <<
 | 
					          <<
 | 
				
			||||||
            \new Devnull { #verse-break-voice }
 | 
					            \new Devnull { #(music-clone verse-break-voice) }
 | 
				
			||||||
            \new NullVoice = "dummyvoice" { #verse-reference-voice }
 | 
					            \new NullVoice = "dummyvoice" { #(music-clone verse-reference-voice) }
 | 
				
			||||||
            #(music-clone verse-chords)
 | 
					            \transposable #transposition #(music-clone verse-chords)
 | 
				
			||||||
            \new Lyrics \lyricsto "dummyvoice" { #lyrics }
 | 
					            \new Lyrics \lyricsto "dummyvoice" { #lyrics }
 | 
				
			||||||
          >>
 | 
					          >>
 | 
				
			||||||
          \layout {
 | 
					          \layout {
 | 
				
			||||||
            \verselayout
 | 
					            \verselayout
 | 
				
			||||||
 | 
					            #(let
 | 
				
			||||||
 | 
					              ((custom-size (ly:output-def-lookup verselayout 'size #f)))
 | 
				
			||||||
 | 
					              (if custom-size (layout-set-staff-size custom-size)))
 | 
				
			||||||
            ragged-right = ##t
 | 
					            ragged-right = ##t
 | 
				
			||||||
            \context {
 | 
					            \context {
 | 
				
			||||||
              \Lyrics
 | 
					              \Lyrics
 | 
				
			||||||
              \override VerticalAxisGroup.nonstaff-relatedstaff-spacing.basic-distance = #verse-text-chord-distance
 | 
					              \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.parent-alignment-X = #LEFT
 | 
				
			||||||
              \override LyricText.self-alignment-X = #LEFT
 | 
					              \override LyricText.self-alignment-X = #LEFT
 | 
				
			||||||
              \override LyricText.word-space = 0.8
 | 
					              \override LyricText.word-space = 0.8
 | 
				
			||||||
@@ -287,8 +301,10 @@
 | 
				
			|||||||
              \override SpacingSpanner.spacing-increment = 0
 | 
					              \override SpacingSpanner.spacing-increment = 0
 | 
				
			||||||
              \remove Bar_number_engraver
 | 
					              \remove Bar_number_engraver
 | 
				
			||||||
              \remove Mark_engraver
 | 
					              \remove Mark_engraver
 | 
				
			||||||
 | 
					              \remove Jump_engraver
 | 
				
			||||||
              \remove Volta_engraver
 | 
					              \remove Volta_engraver
 | 
				
			||||||
              \remove Parenthesis_engraver
 | 
					              \remove Parenthesis_engraver
 | 
				
			||||||
 | 
					              \remove Metronome_mark_engraver
 | 
				
			||||||
            }
 | 
					            }
 | 
				
			||||||
            \context {
 | 
					            \context {
 | 
				
			||||||
              \Staff
 | 
					              \Staff
 | 
				
			||||||
@@ -310,13 +326,15 @@
 | 
				
			|||||||
              \remove Tie_engraver
 | 
					              \remove Tie_engraver
 | 
				
			||||||
              \remove Dynamic_engraver
 | 
					              \remove Dynamic_engraver
 | 
				
			||||||
              \remove Note_heads_engraver
 | 
					              \remove Note_heads_engraver
 | 
				
			||||||
 | 
					              \remove Script_engraver
 | 
				
			||||||
            }
 | 
					            }
 | 
				
			||||||
            \context {
 | 
					            \context {
 | 
				
			||||||
              \NullVoice
 | 
					              \NullVoice
 | 
				
			||||||
              \consists Rest_engraver
 | 
					              \consists Rest_engraver
 | 
				
			||||||
              \omit Rest
 | 
					              \omit Rest
 | 
				
			||||||
             % \undo \omit NoteHead
 | 
					              \undo \omit NoteHead
 | 
				
			||||||
             % \hide NoteHead
 | 
					              \hide NoteHead
 | 
				
			||||||
 | 
					              \override NoteHead.X-extent = #'(0 . 0)
 | 
				
			||||||
            }
 | 
					            }
 | 
				
			||||||
          }
 | 
					          }
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
@@ -26,7 +26,7 @@ appendix =
 | 
				
			|||||||
  "call page-ref to appendix-item"
 | 
					  "call page-ref to appendix-item"
 | 
				
			||||||
  (interpret-markup layout props
 | 
					  (interpret-markup layout props
 | 
				
			||||||
    (markup #:with-link label
 | 
					    (markup #:with-link label
 | 
				
			||||||
      #:override (cons 'appendixPage (make-page-ref-markup label "XXX" "?"))
 | 
					      #:override (cons 'appendixPage (make-page-ref-markup label "888" "?"))
 | 
				
			||||||
      (ly:output-def-lookup layout 'appendixReferenceMarkup))))
 | 
					      (ly:output-def-lookup layout 'appendixReferenceMarkup))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
\paper {
 | 
					\paper {
 | 
				
			||||||
@@ -1,4 +1,5 @@
 | 
				
			|||||||
#(define song-list '())
 | 
					#(define song-list '())
 | 
				
			||||||
 | 
					#(define song-number 0)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define (files-in-directory dirname)
 | 
					#(define (files-in-directory dirname)
 | 
				
			||||||
      ;;; Generate list containing filenames
 | 
					      ;;; Generate list containing filenames
 | 
				
			||||||
@@ -9,7 +10,7 @@
 | 
				
			|||||||
    	     (closedir dir)
 | 
					    	     (closedir dir)
 | 
				
			||||||
    	     files)
 | 
					    	     files)
 | 
				
			||||||
    	    (else
 | 
					    	    (else
 | 
				
			||||||
    	     (next (readdir dir) (if (string-match "^(0|\\.)" f) files (cons f files))))))))
 | 
					    	     (next (readdir dir) (if (ly:regex-match? (ly:regex-exec (ly:make-regex "^(0|\\.)") f)) files (cons f files))))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define (file-to-stats filename)
 | 
					#(define (file-to-stats filename)
 | 
				
			||||||
   (set! song-list (cons filename song-list)))
 | 
					   (set! song-list (cons filename song-list)))
 | 
				
			||||||
@@ -114,7 +115,7 @@ width may require additional tweaking.)"
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
includeSong =
 | 
					includeSong =
 | 
				
			||||||
#(define-void-function (parser location textproc filename) ((procedure?) string?)
 | 
					#(define-void-function (parser location filename) (string?)
 | 
				
			||||||
     #{
 | 
					     #{
 | 
				
			||||||
     \bookOutputName #filename
 | 
					     \bookOutputName #filename
 | 
				
			||||||
     #}
 | 
					     #}
 | 
				
			||||||
@@ -125,7 +126,15 @@ includeSong =
 | 
				
			|||||||
        (acons label additional-page-numbers additional-page-switch-label-list))
 | 
					        (acons label additional-page-numbers additional-page-switch-label-list))
 | 
				
			||||||
      (set! song-list
 | 
					      (set! song-list
 | 
				
			||||||
        (acons (string->symbol filename)
 | 
					        (acons (string->symbol filename)
 | 
				
			||||||
          (acons 'label label (acons 'header HEADER (acons 'music MUSIC (acons 'layout LAYOUT (acons 'text #{ \markuplist \setsongfilename $filename $(if textproc (textproc TEXT) TEXT) #} '())))))
 | 
					          (acons 'label label
 | 
				
			||||||
 | 
					            (acons 'header HEADER
 | 
				
			||||||
 | 
					              (acons 'music MUSIC
 | 
				
			||||||
 | 
					                (acons 'layout LAYOUT
 | 
				
			||||||
 | 
					                  (acons 'text-pages
 | 
				
			||||||
 | 
					                    (map (lambda (text)
 | 
				
			||||||
 | 
					                      #{ \markuplist \setsongfilename $filename $text #})
 | 
				
			||||||
 | 
					                      TEXT_PAGES)
 | 
				
			||||||
 | 
					                    '())))))
 | 
				
			||||||
          song-list))
 | 
					          song-list))
 | 
				
			||||||
    ))
 | 
					    ))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -177,21 +186,23 @@ songs =
 | 
				
			|||||||
              \markup { \pagecenter { \epsfile #X #xsize #filename } }
 | 
					              \markup { \pagecenter { \epsfile #X #xsize #filename } }
 | 
				
			||||||
          } #}
 | 
					          } #}
 | 
				
			||||||
          )
 | 
					          )
 | 
				
			||||||
          (let ((header #{ \bookpart { $(assq-ref songvars 'header) \header {
 | 
					          (let* ((newnumber (+ 1 song-number))
 | 
				
			||||||
                  songfilename = $(symbol->string filename)
 | 
					                 (header #{ \bookpart { $(assq-ref songvars 'header) \header {
 | 
				
			||||||
                  myindexlabel = #(assq-ref songvars 'label)
 | 
					                   songfilename = $(symbol->string filename)
 | 
				
			||||||
                } } #})
 | 
					                   myindexlabel = #(assq-ref songvars 'label)
 | 
				
			||||||
                ;(header (assq-ref songvars 'header))
 | 
					                   songnumber = #(number->string newnumber)
 | 
				
			||||||
                (music (assq-ref songvars 'music))
 | 
					                 } } #})
 | 
				
			||||||
                (layout (assq-ref songvars 'layout))
 | 
					                 (music (assq-ref songvars 'music))
 | 
				
			||||||
                (text (assq-ref songvars 'text))
 | 
					                 (layout (assq-ref songvars 'layout))
 | 
				
			||||||
                (label (assq-ref songvars 'label)))
 | 
					                 (text-pages (assq-ref songvars 'text-pages))
 | 
				
			||||||
 | 
					                 (label (assq-ref songvars 'label)))
 | 
				
			||||||
 | 
					            (set! song-number newnumber)
 | 
				
			||||||
            #{
 | 
					            #{
 | 
				
			||||||
              \bookpart {
 | 
					              \bookpart {
 | 
				
			||||||
                $header
 | 
					                $header
 | 
				
			||||||
                \headerToTOC #header #label
 | 
					                \headerToTOC #header #label
 | 
				
			||||||
                \score { $music \layout { $layout } }
 | 
					                \score { $music \layout { $layout } }
 | 
				
			||||||
                $text
 | 
					                $(add-text-pages text-pages)
 | 
				
			||||||
              }
 | 
					              }
 | 
				
			||||||
            #}))))))
 | 
					            #}))))))
 | 
				
			||||||
   (reverse song-list)
 | 
					   (reverse song-list)
 | 
				
			||||||
@@ -56,24 +56,25 @@
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
#(let ((index-item-list (list)))
 | 
					#(let ((index-item-list (list)))
 | 
				
			||||||
   (set! add-index-item!
 | 
					   (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
 | 
					       (set! index-item-list
 | 
				
			||||||
       ;; We insert index items sorted from the beginning on and do
 | 
					       ;; We insert index items sorted from the beginning on and do
 | 
				
			||||||
       ;; not sort them later - this saves pretty much computing time
 | 
					       ;; 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
 | 
					        ;; this crazy hack is necessary because lilypond depends on guile 1.8 atm
 | 
				
			||||||
        ;; and so the cool unicode conversion functions cannot be used
 | 
					        ;; and so the cool unicode conversion functions cannot be used
 | 
				
			||||||
          (ly:string-substitute " " ""
 | 
					          (ly:string-substitute " " ""
 | 
				
			||||||
          (ly:string-substitute "…" ""
 | 
					          (ly:string-substitute "…" ""
 | 
				
			||||||
          (ly:string-substitute "Č" "C"
 | 
					          (ly:string-substitute "Č" "C"
 | 
				
			||||||
          (ly:string-substitute "Đ" "D"
 | 
					          (ly:string-substitute "Đ" "D"
 | 
				
			||||||
 | 
					          (ly:string-substitute "Š" "S"
 | 
				
			||||||
          (ly:string-substitute "Т" "T"
 | 
					          (ly:string-substitute "Т" "T"
 | 
				
			||||||
          (ly:string-substitute "Ä" "Ae"
 | 
					          (ly:string-substitute "Ä" "Ae"
 | 
				
			||||||
          (ly:string-substitute "ä" "ae"
 | 
					          (ly:string-substitute "ä" "ae"
 | 
				
			||||||
          (ly:string-substitute "Ö" "O"
 | 
					          (ly:string-substitute "Ö" "O"
 | 
				
			||||||
          (ly:string-substitute "ö" "oe"
 | 
					          (ly:string-substitute "ö" "oe"
 | 
				
			||||||
          (ly:string-substitute "Ü" "U"
 | 
					          (ly:string-substitute "Ü" "U"
 | 
				
			||||||
          (ly:string-substitute "ü" "ue" sorttext))))))))))))
 | 
					          (ly:string-substitute "ü" "ue" sorttext)))))))))))))
 | 
				
			||||||
        index-item-list))
 | 
					        index-item-list))
 | 
				
			||||||
       (make-music 'EventChord
 | 
					       (make-music 'EventChord
 | 
				
			||||||
         'page-marker #t
 | 
					         'page-marker #t
 | 
				
			||||||
@@ -91,20 +92,20 @@
 | 
				
			|||||||
          (cons (car ilist) (insert-alphabetical-sorted! iitem (cdr ilist))))))
 | 
					          (cons (car ilist) (insert-alphabetical-sorted! iitem (cdr ilist))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
% code for category index
 | 
					% 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)
 | 
					#(define-public (category-index-items) #f)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(let ((category-index-hash (make-hash-table)))
 | 
					#(let ((category-index-hash (make-hash-table)))
 | 
				
			||||||
   (set! add-category-index-item!
 | 
					   (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)
 | 
					     (for-each (lambda (category)
 | 
				
			||||||
            (let* ((catsym (string->symbol category))
 | 
					            (let* ((catsym (string->symbol category))
 | 
				
			||||||
                   (catlist (hashq-ref category-index-hash catsym
 | 
					                   (catlist (hashq-ref category-index-hash catsym
 | 
				
			||||||
                              (list (list label 'indexCategoryMarkup category)))))
 | 
					                              (list (list label 'indexCategoryMarkup `(((rawtext . ,category))))))))
 | 
				
			||||||
              (if (assq catsym category-names)
 | 
					              (if (assq catsym category-names)
 | 
				
			||||||
                (hashq-set! category-index-hash catsym
 | 
					                (hashq-set! category-index-hash catsym
 | 
				
			||||||
                  (cons (list label markup-symbol text) catlist))
 | 
					                  (cons (list label markup-symbol textoptions) catlist))
 | 
				
			||||||
                (ly:error "song: <~a> category ~a is not defined!" (markup->string text) category))))
 | 
					                (ly:error "song: <~a> category ~a is not defined!" (markup->string (chain-assoc-get 'rawtext textoptions)) category))))
 | 
				
			||||||
       categories)
 | 
					       categories)
 | 
				
			||||||
       (make-music 'EventChord
 | 
					       (make-music 'EventChord
 | 
				
			||||||
         'page-marker #t
 | 
					         'page-marker #t
 | 
				
			||||||
@@ -114,7 +115,33 @@
 | 
				
			|||||||
   (set! category-index-items (lambda ()
 | 
					   (set! category-index-items (lambda ()
 | 
				
			||||||
          (append-map (lambda (kv) (reverse (hashq-ref category-index-hash (car kv) (list)))) category-names))))
 | 
					          (append-map (lambda (kv) (reverse (hashq-ref category-index-hash (car kv) (list)))) category-names))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					% code for author index
 | 
				
			||||||
 | 
					#(define*-public (add-author-index-item! authorIDs markup-symbol text #:optional label) #f)
 | 
				
			||||||
 | 
					#(define-public (author-index-items) #f)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					#(let ((author-index-hash (make-hash-table)))
 | 
				
			||||||
 | 
					   (set! add-author-index-item!
 | 
				
			||||||
 | 
					   (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 `(((rawtext . ,authorID))))))))
 | 
				
			||||||
 | 
					                (hashq-set! author-index-hash authorsym
 | 
				
			||||||
 | 
					                  (cons (list label markup-symbol textoptions) authorlist))
 | 
				
			||||||
 | 
					                ))
 | 
				
			||||||
 | 
					       authorIDs)
 | 
				
			||||||
 | 
					       (make-music 'EventChord
 | 
				
			||||||
 | 
					         'page-marker #t
 | 
				
			||||||
 | 
					         'page-label label
 | 
				
			||||||
 | 
					         'elements (list (make-music 'LabelEvent
 | 
				
			||||||
 | 
					         'page-label label)))))
 | 
				
			||||||
 | 
					   (set! author-index-items (lambda ()
 | 
				
			||||||
 | 
					          (append-map cdr
 | 
				
			||||||
 | 
					            (sort-list
 | 
				
			||||||
 | 
					              (hash-map->list
 | 
				
			||||||
 | 
					                (lambda (authorsym authorlist) (cons (string-downcase (symbol->string authorsym)) (reverse authorlist)))
 | 
				
			||||||
 | 
					                author-index-hash)
 | 
				
			||||||
 | 
					              (lambda (a b) (string-ci<? (car a) (car b))))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define-markup-command (with-link-symbol-ref layout props symbol arg)
 | 
					#(define-markup-command (with-link-symbol-ref layout props symbol arg)
 | 
				
			||||||
@@ -140,39 +167,46 @@
 | 
				
			|||||||
     (markup #:override (cons 'baseline-skip 3.5) (if catname (make-left-column-markup (string-split (cadr catname) #\newline)) category)))))
 | 
					     (markup #:override (cons 'baseline-skip 3.5) (if catname (make-left-column-markup (string-split (cadr catname) #\newline)) category)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define-markup-command (index-item-with-pattern layout props)()
 | 
					#(define-markup-command (index-item-with-pattern layout props)()
 | 
				
			||||||
     (let (
 | 
					    #:properties ((index:text "")
 | 
				
			||||||
            (text (chain-assoc-get 'index:text props))
 | 
					                  (index:alternative #f)
 | 
				
			||||||
            (page (chain-assoc-get 'index:page props))
 | 
					                  (index:page #f)
 | 
				
			||||||
 | 
					                  (line-width))
 | 
				
			||||||
 | 
					    (let* (
 | 
				
			||||||
            (width (-
 | 
					            (width (-
 | 
				
			||||||
                     (chain-assoc-get 'line-width props)
 | 
					                     line-width
 | 
				
			||||||
                     (interval-length (ly:stencil-extent (interpret-markup layout props "XXXX") X))))
 | 
					                     (interval-length (ly:stencil-extent (interpret-markup layout props "XXXX") X))))
 | 
				
			||||||
            )
 | 
					            (lines-reversed
 | 
				
			||||||
     (interpret-markup layout props
 | 
					              (reverse (map (lambda (stil) (markup #:stencil stil))
 | 
				
			||||||
       (make-column-markup
 | 
					                (wordwrap-string-internal-markup-list layout
 | 
				
			||||||
         (let ((revlist
 | 
					                  (prepend-alist-chain 'line-width width
 | 
				
			||||||
                (if (markup? text)
 | 
					                    (if index:alternative
 | 
				
			||||||
                    (list text)
 | 
					                        (prepend-alist-chain 'font-shape 'italic props)
 | 
				
			||||||
                    (reverse (map (lambda (stil) (markup #:stencil stil))
 | 
					                        props))
 | 
				
			||||||
                      (wordwrap-string-internal-markup-list layout
 | 
					                  #f
 | 
				
			||||||
                        (cons (if (chain-assoc-get 'alternative text)
 | 
					                  index:text))))
 | 
				
			||||||
                                (list (cons 'line-width width) (cons 'font-shape 'italic))
 | 
					            (last-line-with-dots (make-fill-with-pattern-markup 1 RIGHT "." (car lines-reversed) index:page))
 | 
				
			||||||
                                (list (cons 'line-width width))) props) #f
 | 
					            (lines-without-dots (cdr lines-reversed))
 | 
				
			||||||
                        (chain-assoc-get 'rawtext text))))))
 | 
					            (target-line-size-markup
 | 
				
			||||||
               (target-size-markup
 | 
					 | 
				
			||||||
                 (make-column-markup
 | 
					                 (make-column-markup
 | 
				
			||||||
                   (list
 | 
					                   (list
 | 
				
			||||||
                    (make-simple-markup "Agj")
 | 
					                    (make-simple-markup "Agj")
 | 
				
			||||||
                    (make-vspace-markup 0.2))))
 | 
					                    (make-vspace-markup 0.2))))
 | 
				
			||||||
               )
 | 
					            )
 | 
				
			||||||
               (reverse (map (lambda (m)
 | 
					      (interpret-markup layout props
 | 
				
			||||||
                               (make-size-box-to-box-markup #f #t m target-size-markup))
 | 
					        (make-size-box-to-box-markup #f #t
 | 
				
			||||||
                          (cons
 | 
					          (make-with-link-symbol-ref-markup 'index:label
 | 
				
			||||||
                           (make-with-link-symbol-ref-markup 'index:label (make-fill-with-pattern-markup 1 RIGHT "." (car revlist) page))
 | 
					            (make-column-markup
 | 
				
			||||||
                           (cdr revlist)))))))))
 | 
					              (reverse (cons
 | 
				
			||||||
 | 
					                          last-line-with-dots
 | 
				
			||||||
 | 
					                          (map (lambda (m) (make-size-box-to-box-markup #f #t m target-line-size-markup)) lines-without-dots)))))
 | 
				
			||||||
 | 
					          ; this column is just to have a reference height for resizing
 | 
				
			||||||
 | 
					          (make-column-markup
 | 
				
			||||||
 | 
					            (reverse (map (lambda (m) (make-size-box-to-box-markup #f #t m target-line-size-markup)) (cons last-line-with-dots lines-without-dots))))
 | 
				
			||||||
 | 
					                          ))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
\paper {
 | 
					\paper {
 | 
				
			||||||
  indexItemMarkup = \markup {
 | 
					  indexItemMarkup = \markup {
 | 
				
			||||||
    \index-item-with-pattern
 | 
					    \sans \index-item-with-pattern
 | 
				
			||||||
  }
 | 
					  }
 | 
				
			||||||
  indexSectionMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
 | 
					  indexSectionMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
 | 
				
			||||||
    \sans \bold \fontsize #3 \fromproperty #'index:text
 | 
					    \sans \bold \fontsize #3 \fromproperty #'index:text
 | 
				
			||||||
@@ -182,17 +216,31 @@
 | 
				
			|||||||
    \fill-line { \line { \vcenter \category-image-symbol-ref #7 #'index:text \hspace #3 \vcenter \sans \bold \fontsize #3 \category-name-symbol-ref #'index:text } \null }
 | 
					    \fill-line { \line { \vcenter \category-image-symbol-ref #7 #'index:text \hspace #3 \vcenter \sans \bold \fontsize #3 \category-name-symbol-ref #'index:text } \null }
 | 
				
			||||||
    \vspace #.4
 | 
					    \vspace #.4
 | 
				
			||||||
  }
 | 
					  }
 | 
				
			||||||
 | 
					  indexAuthorMarkup = \markup \override #'(baseline-skip . 1.5) \left-column {
 | 
				
			||||||
 | 
					    \vspace #1
 | 
				
			||||||
 | 
					    \sans \bold \fontsize #3
 | 
				
			||||||
 | 
					      #(make-on-the-fly-markup
 | 
				
			||||||
 | 
					        (lambda (layout props m)
 | 
				
			||||||
 | 
					          (interpret-markup layout props
 | 
				
			||||||
 | 
					            (make-justify-string-markup (format-author (ly:output-def-lookup layout 'authorFormat) (chain-assoc-get 'index:text props #f) #t))))
 | 
				
			||||||
 | 
					        (make-null-markup))
 | 
				
			||||||
 | 
					    \vspace #.4
 | 
				
			||||||
 | 
					  }
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define (prepare-item-markup items layout)
 | 
					#(define (prepare-item-markup items layout)
 | 
				
			||||||
   (map (lambda (index-item)
 | 
					   (map (lambda (index-item)
 | 
				
			||||||
         (let ((label (car index-item))
 | 
					         (let* ((label (car index-item))
 | 
				
			||||||
               (index-markup (cadr index-item))
 | 
					                (index-markup (cadr index-item))
 | 
				
			||||||
               (text (caddr index-item)))
 | 
					                (textoptions (caddr index-item))
 | 
				
			||||||
 | 
					                (text (chain-assoc-get 'rawtext textoptions))
 | 
				
			||||||
 | 
					                (alternative (chain-assoc-get 'alternative textoptions))
 | 
				
			||||||
 | 
					                (songnumber (chain-assoc-get 'songnumber textoptions)))
 | 
				
			||||||
           (markup #:override (cons 'index:label label)
 | 
					           (markup #:override (cons 'index:label label)
 | 
				
			||||||
             #:override (cons 'index:page (markup #:custom-page-number label -1))
 | 
					             #:override (cons 'index:page (markup #:custom-page-number label -1))
 | 
				
			||||||
             #:override (cons 'index:text text)
 | 
					             #:override (cons 'index:text text)
 | 
				
			||||||
 | 
					             #:override (cons 'index:alternative alternative)
 | 
				
			||||||
 | 
					             #:override (cons 'index:songnumber songnumber)
 | 
				
			||||||
             (ly:output-def-lookup layout index-markup))))
 | 
					             (ly:output-def-lookup layout index-markup))))
 | 
				
			||||||
       (items)))
 | 
					       (items)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -200,7 +248,8 @@
 | 
				
			|||||||
  ( _i "Outputs index alphabetical sorted or in categories" )
 | 
					  ( _i "Outputs index alphabetical sorted or in categories" )
 | 
				
			||||||
    (let ((items (case index-type
 | 
					    (let ((items (case index-type
 | 
				
			||||||
            ((alphabetical) index-items)
 | 
					            ((alphabetical) index-items)
 | 
				
			||||||
            ((categories) category-index-items)))
 | 
					            ((categories) category-index-items)
 | 
				
			||||||
 | 
					            ((authors) author-index-items)))
 | 
				
			||||||
          (title (interpret-markup layout props title-markup)))
 | 
					          (title (interpret-markup layout props title-markup)))
 | 
				
			||||||
      (cons title
 | 
					      (cons title
 | 
				
			||||||
      (interpret-markup-list layout props
 | 
					      (interpret-markup-list layout props
 | 
				
			||||||
@@ -212,12 +261,12 @@
 | 
				
			|||||||
indexItem =
 | 
					indexItem =
 | 
				
			||||||
#(define-music-function (parser location sorttext text) (string? markup?)
 | 
					#(define-music-function (parser location sorttext text) (string? markup?)
 | 
				
			||||||
   "Add a line to the alphabetical index, using the @code{indexItemMarkup} paper variable markup."
 | 
					   "Add a line to the alphabetical index, using the @code{indexItemMarkup} paper variable markup."
 | 
				
			||||||
   (add-index-item! 'indexItemMarkup text sorttext))
 | 
					   (add-index-item! 'indexItemMarkup (prepend-alist-chain 'rawtext text '()) sorttext))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
indexSection =
 | 
					indexSection =
 | 
				
			||||||
#(define-music-function (parser location sorttext text) (string? markup?)
 | 
					#(define-music-function (parser location sorttext text) (string? markup?)
 | 
				
			||||||
   "Add a section line to the alphabetical index, using @code{indexSectionMarkup} paper variable markup. This can be used to divide the alphabetical index into different sections, for example one section for each first letter."
 | 
					   "Add a section line to the alphabetical index, using @code{indexSectionMarkup} paper variable markup. This can be used to divide the alphabetical index into different sections, for example one section for each first letter."
 | 
				
			||||||
   (add-index-item! 'indexSectionMarkup text sorttext))
 | 
					   (add-index-item! 'indexSectionMarkup (prepend-alist-chain 'rawtext text '()) sorttext))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define (extract-and-check-vars-from-header bookheader varlist)
 | 
					#(define (extract-and-check-vars-from-header bookheader varlist)
 | 
				
			||||||
  (let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0)))
 | 
					  (let* ((headervars (hash-map->list cons (struct-ref (ly:book-header bookheader) 0)))
 | 
				
			||||||
@@ -230,23 +279,44 @@ indexSection =
 | 
				
			|||||||
    ) varlist)))
 | 
					    ) varlist)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?)
 | 
					headerToTOC = #(define-music-function (parser location header label) (ly:book? symbol?)
 | 
				
			||||||
 | 
					    (define (all-author-ids authors)
 | 
				
			||||||
 | 
					      (let ((poetIds (find-author-ids-by 'text authors))
 | 
				
			||||||
 | 
					            (translatorIds (find-author-ids-by 'translation authors))
 | 
				
			||||||
 | 
					            (versePoetData (find-author-id-with-part-numbers 'verse authors))
 | 
				
			||||||
 | 
					            (composerIds (find-author-ids-by 'melody authors))
 | 
				
			||||||
 | 
					            (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
 | 
				
			||||||
 | 
					            (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
 | 
				
			||||||
 | 
					            (compositionIds (find-author-ids-by 'composition authors))
 | 
				
			||||||
 | 
					            (adaptionIds (find-author-ids-by 'adaption authors))
 | 
				
			||||||
 | 
					            (bridgeIds (find-author-ids-by 'bridge authors))
 | 
				
			||||||
 | 
					            (interludeIds (find-author-ids-by 'interlude authors)))
 | 
				
			||||||
 | 
					        (delete-duplicates
 | 
				
			||||||
 | 
					          (append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) (map car voiceComposerData) compositionIds adaptionIds bridgeIds interludeIds))
 | 
				
			||||||
 | 
					    ))
 | 
				
			||||||
    (let*
 | 
					    (let*
 | 
				
			||||||
      (
 | 
					      (
 | 
				
			||||||
       (extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle altalttitle categorytitle categories)))
 | 
					       (extractedheadervars (extract-and-check-vars-from-header header '(title starttext alttitle categorytitle categories authors songnumber)))
 | 
				
			||||||
       (title (assq-ref extractedheadervars 'title))
 | 
					       (title (assq-ref extractedheadervars 'title))
 | 
				
			||||||
       (starttext (assq-ref extractedheadervars 'starttext))
 | 
					       (starttext (assq-ref extractedheadervars 'starttext))
 | 
				
			||||||
       (alttitle (assq-ref extractedheadervars 'alttitle))
 | 
					       (alttitle (assq-ref extractedheadervars 'alttitle))
 | 
				
			||||||
       (altalttitle (assq-ref extractedheadervars 'altalttitle))
 | 
					 | 
				
			||||||
       (categorytitle (assq-ref extractedheadervars 'categorytitle))
 | 
					       (categorytitle (assq-ref extractedheadervars 'categorytitle))
 | 
				
			||||||
       (categories (assq-ref extractedheadervars 'categories))
 | 
					       (categories (assq-ref extractedheadervars 'categories))
 | 
				
			||||||
       (add-to-toc! (lambda (toctitle tocmarkup)
 | 
					       (authors (assq-ref extractedheadervars 'authors))
 | 
				
			||||||
                      (add-index-item! 'indexItemMarkup tocmarkup toctitle label)))
 | 
					       (songnumber (assq-ref extractedheadervars 'songnumber))
 | 
				
			||||||
 | 
					       (textoptions (lambda (text alternative) `(((rawtext . ,text) (alternative . ,alternative) (songnumber . ,songnumber)))))
 | 
				
			||||||
 | 
					       (add-to-toc! (lambda (toctitle alternative)
 | 
				
			||||||
 | 
					                      (add-index-item! 'indexItemMarkup (textoptions toctitle alternative) toctitle label)))
 | 
				
			||||||
       )
 | 
					       )
 | 
				
			||||||
           (if categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (cons (list (cons 'rawtext (if categorytitle categorytitle title))) '()) label))
 | 
					           (if categories (add-category-index-item! (string-tokenize categories) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
 | 
				
			||||||
           (if starttext (add-to-toc! starttext (cons (list (cons 'rawtext starttext) (cons 'alternative #t)) '())))
 | 
					           (if authors (add-author-index-item! (all-author-ids authors) 'indexItemMarkup (textoptions (if categorytitle categorytitle title) #f) label))
 | 
				
			||||||
           (if alttitle (add-to-toc! alttitle (cons (list (cons 'rawtext alttitle) (cons 'alternative #t)) '())))
 | 
					           (if starttext (add-to-toc! starttext #t))
 | 
				
			||||||
           (if altalttitle (add-to-toc! altalttitle (cons (list (cons 'rawtext altalttitle) (cons 'alternative #t)) '())))
 | 
					           (if alttitle
 | 
				
			||||||
           (if title (add-to-toc! title (cons (list (cons 'rawtext title)) '())) #{ #})
 | 
					               (if (list? alttitle)
 | 
				
			||||||
 | 
					                   (for-each (lambda (alt)
 | 
				
			||||||
 | 
					                                (add-to-toc! alt #t))
 | 
				
			||||||
 | 
					                             alttitle)
 | 
				
			||||||
 | 
					                   (add-to-toc! alttitle #t)))
 | 
				
			||||||
 | 
					           (if title (add-to-toc! title #f) #{ #})
 | 
				
			||||||
    ))
 | 
					    ))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -271,7 +341,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
 | 
				
			|||||||
            (ly:string-substitute "\"" "\\\"" field))
 | 
					            (ly:string-substitute "\"" "\\\"" field))
 | 
				
			||||||
          "\"")))
 | 
					          "\"")))
 | 
				
			||||||
  (define (format-authors authorIds)
 | 
					  (define (format-authors authorIds)
 | 
				
			||||||
    (string-join (map (lambda (authorId) (format-author layout authorId #f)) authorIds) ", "))
 | 
					    (string-join (map (lambda (authorId) (format-author (ly:output-def-lookup layout 'authorFormat) authorId #f)) authorIds) ", "))
 | 
				
			||||||
  (define cr-regex (ly:make-regex "\r"))
 | 
					  (define cr-regex (ly:make-regex "\r"))
 | 
				
			||||||
  (define crlf-regex (ly:make-regex "\r\n"))
 | 
					  (define crlf-regex (ly:make-regex "\r\n"))
 | 
				
			||||||
  (define para-sep-regex (ly:make-regex "\n[ \t\n]*\n[ \t\n]*"))
 | 
					  (define para-sep-regex (ly:make-regex "\n[ \t\n]*\n[ \t\n]*"))
 | 
				
			||||||
@@ -299,7 +369,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
 | 
				
			|||||||
                   (songvars (cdr song))
 | 
					                   (songvars (cdr song))
 | 
				
			||||||
                   (page-number (number->string (assoc-get (assq-ref songvars 'label) labelPageTable)))
 | 
					                   (page-number (number->string (assoc-get (assq-ref songvars 'label) labelPageTable)))
 | 
				
			||||||
                   (extractedheadervars (extract-and-check-vars-from-header (assq-ref songvars 'header)
 | 
					                   (extractedheadervars (extract-and-check-vars-from-header (assq-ref songvars 'header)
 | 
				
			||||||
                      '(title starttext alttitle altalttitle categorytitle categories authors year_text year_melody year_translation year_composition infotext translation pronunciation copyright source)))
 | 
					                      '(title starttext alttitle categorytitle categories authors year_text year_melody year_translation year_composition year_adaption infotext translation pronunciation copyright source)))
 | 
				
			||||||
                   (headervar-or-empty (lambda (varsym)
 | 
					                   (headervar-or-empty (lambda (varsym)
 | 
				
			||||||
                     (let ((extracted (assq-ref extractedheadervars varsym)))
 | 
					                     (let ((extracted (assq-ref extractedheadervars varsym)))
 | 
				
			||||||
                       (if extracted extracted ""))))
 | 
					                       (if extracted extracted ""))))
 | 
				
			||||||
@@ -311,6 +381,8 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
 | 
				
			|||||||
                   (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
 | 
					                   (verseComposerData (find-author-id-with-part-numbers 'meloverse authors))
 | 
				
			||||||
                   (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
 | 
					                   (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
 | 
				
			||||||
                   (compositionIds (find-author-ids-by 'composition authors))
 | 
					                   (compositionIds (find-author-ids-by 'composition authors))
 | 
				
			||||||
 | 
					                   (adaptionTextIds (find-author-ids-by 'adaption_text authors))
 | 
				
			||||||
 | 
					                   (adaptionMusicIds (find-author-ids-by 'adaption_music authors))
 | 
				
			||||||
                   (bridgeIds (find-author-ids-by 'bridge authors))
 | 
					                   (bridgeIds (find-author-ids-by 'bridge authors))
 | 
				
			||||||
                   (interludeIds (find-author-ids-by 'interlude authors)))
 | 
					                   (interludeIds (find-author-ids-by 'interlude authors)))
 | 
				
			||||||
              (map csv-escape
 | 
					              (map csv-escape
 | 
				
			||||||
@@ -319,17 +391,22 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
 | 
				
			|||||||
                  page-number
 | 
					                  page-number
 | 
				
			||||||
                  (headervar-or-empty 'title)
 | 
					                  (headervar-or-empty 'title)
 | 
				
			||||||
                  (headervar-or-empty 'starttext)
 | 
					                  (headervar-or-empty 'starttext)
 | 
				
			||||||
                  (headervar-or-empty 'alttitle)
 | 
					                  (let ((alttitle-value (headervar-or-empty 'alttitle)))
 | 
				
			||||||
                  (headervar-or-empty 'altalttitle)
 | 
					                    (if (list? alttitle-value)
 | 
				
			||||||
 | 
					                        (string-join alttitle-value ", ")  ; Wenn eine Liste, dann zusammenfügen
 | 
				
			||||||
 | 
					                        alttitle-value))  ; Wenn kein Liste, den originalen Wert verwenden
 | 
				
			||||||
 | 
					
 | 
				
			||||||
                  (headervar-or-empty 'categorytitle)
 | 
					                  (headervar-or-empty 'categorytitle)
 | 
				
			||||||
                  (headervar-or-empty 'categories)
 | 
					                  (headervar-or-empty 'categories)
 | 
				
			||||||
                  (format-authors (append poetIds (map car versePoetData)))
 | 
					                  (format-authors (append poetIds adaptionTextIds (map car versePoetData)))
 | 
				
			||||||
                  (format-authors translatorIds)
 | 
					                  (format-authors translatorIds)
 | 
				
			||||||
                  (format-authors (append composerIds compositionIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
 | 
					                  (format-authors (append composerIds compositionIds adaptionMusicIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
 | 
				
			||||||
                  (headervar-or-empty 'year_text)
 | 
					                  (headervar-or-empty 'year_text)
 | 
				
			||||||
                  (headervar-or-empty 'year_melody)
 | 
					                  (headervar-or-empty 'year_melody)
 | 
				
			||||||
                  (headervar-or-empty 'year_translation)
 | 
					                  (headervar-or-empty 'year_translation)
 | 
				
			||||||
                  (headervar-or-empty 'year_composition)
 | 
					                  (headervar-or-empty 'year_composition)
 | 
				
			||||||
 | 
					                  (headervar-or-empty 'year_adaption_text)
 | 
				
			||||||
 | 
					                  (headervar-or-empty 'year_adaption_music)
 | 
				
			||||||
                  (headervar-or-empty 'copyright)
 | 
					                  (headervar-or-empty 'copyright)
 | 
				
			||||||
                  (headervar-or-empty 'source)
 | 
					                  (headervar-or-empty 'source)
 | 
				
			||||||
                  (format-info-paragraphs (headervar-or-empty 'infotext))
 | 
					                  (format-info-paragraphs (headervar-or-empty 'infotext))
 | 
				
			||||||
@@ -345,7 +422,6 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
 | 
				
			|||||||
        "title"
 | 
					        "title"
 | 
				
			||||||
        "starttext"
 | 
					        "starttext"
 | 
				
			||||||
        "alttitle"
 | 
					        "alttitle"
 | 
				
			||||||
        "altalttitle"
 | 
					 | 
				
			||||||
        "categorytitle"
 | 
					        "categorytitle"
 | 
				
			||||||
        "categories"
 | 
					        "categories"
 | 
				
			||||||
        "poets"
 | 
					        "poets"
 | 
				
			||||||
@@ -355,6 +431,8 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
 | 
				
			|||||||
        "year_melody"
 | 
					        "year_melody"
 | 
				
			||||||
        "year_translation"
 | 
					        "year_translation"
 | 
				
			||||||
        "year_composition"
 | 
					        "year_composition"
 | 
				
			||||||
 | 
					        "year_adaption_text"
 | 
				
			||||||
 | 
					        "year_adaption_music"
 | 
				
			||||||
        "copyright"
 | 
					        "copyright"
 | 
				
			||||||
        "source"
 | 
					        "source"
 | 
				
			||||||
        "infotext"
 | 
					        "infotext"
 | 
				
			||||||
							
								
								
									
										3
									
								
								public_includes/book_top.ily
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										3
									
								
								public_includes/book_top.ily
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,3 @@
 | 
				
			|||||||
 | 
					\include "../private_includes/book/book_include.ily"
 | 
				
			||||||
 | 
					\include "../private_includes/book/toc_include.ily"
 | 
				
			||||||
 | 
					\include "../private_includes/book/appendix.ily"
 | 
				
			||||||
							
								
								
									
										88
									
								
								public_includes/layout_bottom.ily
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										88
									
								
								public_includes/layout_bottom.ily
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,88 @@
 | 
				
			|||||||
 | 
					% set the speed of the midi music
 | 
				
			||||||
 | 
					#(define midiQuarterNoteSpeed (if (defined? 'midiQuarterNoteSpeed) midiQuarterNoteSpeed 90))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					MUSIC = { \transposable #TRANSPOSITION \MUSIC }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					verselayout = \layout {
 | 
				
			||||||
 | 
					  \LAYOUT
 | 
				
			||||||
 | 
					  \context {
 | 
				
			||||||
 | 
					    \ChordNames
 | 
				
			||||||
 | 
					    \override ChordName.font-size = \songTextChordFontSize
 | 
				
			||||||
 | 
					  }
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					LAYOUT = \layout {
 | 
				
			||||||
 | 
					  \LAYOUT
 | 
				
			||||||
 | 
					  #(let
 | 
				
			||||||
 | 
					    ((custom-size (ly:output-def-lookup LAYOUT 'size #f)))
 | 
				
			||||||
 | 
					    (if custom-size (layout-set-staff-size custom-size)))
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					TEXT = \markuplist {
 | 
				
			||||||
 | 
					  \override #`(transposition . ,TRANSPOSITION)
 | 
				
			||||||
 | 
					  \override #`(verselayout . ,verselayout)
 | 
				
			||||||
 | 
					  \override #`(verse-chords . ,#{ \chords { \verseChords } #})
 | 
				
			||||||
 | 
					  \override #`(verse-reference-voice . ,#{ \global \firstVoice  #})
 | 
				
			||||||
 | 
					  \TEXT
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					#(define TEXT_PAGES
 | 
				
			||||||
 | 
					  (map
 | 
				
			||||||
 | 
					    (lambda (text) #{
 | 
				
			||||||
 | 
					      \markuplist {
 | 
				
			||||||
 | 
					        \override #`(transposition . ,TRANSPOSITION)
 | 
				
			||||||
 | 
					        \override #`(verselayout . ,verselayout)
 | 
				
			||||||
 | 
					        \override #`(verse-chords . ,#{ \chords { \verseChords } #})
 | 
				
			||||||
 | 
					        \override #`(verse-reference-voice . ,#{ \global \firstVoice  #})
 | 
				
			||||||
 | 
					        #text
 | 
				
			||||||
 | 
					      }
 | 
				
			||||||
 | 
					    #})
 | 
				
			||||||
 | 
					  (if
 | 
				
			||||||
 | 
					    (and
 | 
				
			||||||
 | 
					      (defined? 'TEXT_PAGES)
 | 
				
			||||||
 | 
					      (pair? TEXT_PAGES))
 | 
				
			||||||
 | 
					    TEXT_PAGES
 | 
				
			||||||
 | 
					    (list TEXT))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					#(define (add-text-pages text-pages)
 | 
				
			||||||
 | 
					  (if (pair? text-pages)
 | 
				
			||||||
 | 
					    (begin
 | 
				
			||||||
 | 
					      (add-score (car text-pages))
 | 
				
			||||||
 | 
					      (for-each
 | 
				
			||||||
 | 
					        (lambda (text)
 | 
				
			||||||
 | 
					          (add-music (pageBreak))
 | 
				
			||||||
 | 
					          (add-score text))
 | 
				
			||||||
 | 
					        (cdr text-pages)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					#(if (not noStandaloneOutput)
 | 
				
			||||||
 | 
					(begin
 | 
				
			||||||
 | 
					  (let ((header (ly:book-header HEADER)) (paper (ly:book-paper HEADER)))
 | 
				
			||||||
 | 
					    (if header (set! $defaultheader header))
 | 
				
			||||||
 | 
					    (if paper (set! $defaultpaper paper))
 | 
				
			||||||
 | 
					  )
 | 
				
			||||||
 | 
					  (add-score #{
 | 
				
			||||||
 | 
					    \score {
 | 
				
			||||||
 | 
					      \MUSIC
 | 
				
			||||||
 | 
					      \layout { \LAYOUT }
 | 
				
			||||||
 | 
					    }#})
 | 
				
			||||||
 | 
					  (add-text-pages TEXT_PAGES)
 | 
				
			||||||
 | 
					  (add-score #{
 | 
				
			||||||
 | 
					    \score {
 | 
				
			||||||
 | 
					      \unfoldRepeats { \MUSIC \INLINESCOREMUSIC }
 | 
				
			||||||
 | 
					      \midi {
 | 
				
			||||||
 | 
					        \context {
 | 
				
			||||||
 | 
					          \Score
 | 
				
			||||||
 | 
					          % Tempo des midi files
 | 
				
			||||||
 | 
					          tempoWholesPerMinute = #(/ midiQuarterNoteSpeed 4)
 | 
				
			||||||
 | 
					        }
 | 
				
			||||||
 | 
					        \context {
 | 
				
			||||||
 | 
					          \Staff
 | 
				
			||||||
 | 
					          \remove "Staff_performer"
 | 
				
			||||||
 | 
					        }
 | 
				
			||||||
 | 
					        \context {
 | 
				
			||||||
 | 
					          \Voice
 | 
				
			||||||
 | 
					          \consists "Staff_performer"
 | 
				
			||||||
 | 
					        }
 | 
				
			||||||
 | 
					      }
 | 
				
			||||||
 | 
					    }#})
 | 
				
			||||||
 | 
					))
 | 
				
			||||||
@@ -1,6 +1,5 @@
 | 
				
			|||||||
\version "2.25.8"
 | 
					 | 
				
			||||||
#(ly:set-option 'relative-includes #t)
 | 
					#(ly:set-option 'relative-includes #t)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#(define noDefaultOutput #t)
 | 
					#(define noDefaultOutput #t)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
\include "all_base_includes.ly"
 | 
					\include "../private_includes/base/all.ily"
 | 
				
			||||||
@@ -4,4 +4,4 @@ HEADER = \bookpart {
 | 
				
			|||||||
    \basicSongInfo
 | 
					    \basicSongInfo
 | 
				
			||||||
  }
 | 
					  }
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
\include #(if noDefaultOutput "void.ly" "standalone_output.ly")
 | 
					\include #(if noDefaultOutput "../private_includes/void.ily" "layout_bottom.ily")
 | 
				
			||||||
@@ -2,4 +2,4 @@
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
#(define noDefaultOutput (if (defined? 'noDefaultOutput) noDefaultOutput #f))
 | 
					#(define noDefaultOutput (if (defined? 'noDefaultOutput) noDefaultOutput #f))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
\include #(if noDefaultOutput "void.ly" "all_base_includes.ly")
 | 
					\include #(if noDefaultOutput "../private_includes/void.ily" "../private_includes/base/all.ily")
 | 
				
			||||||
@@ -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
 | 
					 | 
				
			||||||
@@ -1,10 +0,0 @@
 | 
				
			|||||||
(use-modules (ice-9 popen) (ice-9 textual-ports) (json parser))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(define (yml-file->scm filename)
 | 
					 | 
				
			||||||
  (let* ((python_cmd (string-append "import sys, yaml, json; print(json.dumps(yaml.safe_load(open('" filename "'))))"))
 | 
					 | 
				
			||||||
          (pipe (open-pipe* OPEN_READ "python3" "-c" python_cmd))
 | 
					 | 
				
			||||||
          (json (get-string-all pipe)))
 | 
					 | 
				
			||||||
    (close-pipe pipe)
 | 
					 | 
				
			||||||
    (json-string->scm json)))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))
 | 
					 | 
				
			||||||
@@ -1,44 +0,0 @@
 | 
				
			|||||||
% set the speed of the midi music
 | 
					 | 
				
			||||||
#(define midiQuarterNoteSpeed (if (defined? 'midiQuarterNoteSpeed) midiQuarterNoteSpeed 90))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
MUSIC = { \transposable #TRANSPOSITION \MUSIC }
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
verselayout = \layout {
 | 
					 | 
				
			||||||
  \LAYOUT
 | 
					 | 
				
			||||||
  \context {
 | 
					 | 
				
			||||||
    \ChordNames
 | 
					 | 
				
			||||||
    \override ChordName.font-size = \songTextChordFontSize
 | 
					 | 
				
			||||||
  }
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
TEXT = \markuplist {
 | 
					 | 
				
			||||||
  \override #`(transposition . ,TRANSPOSITION)
 | 
					 | 
				
			||||||
  \override #`(verselayout . ,verselayout)
 | 
					 | 
				
			||||||
  \override #`(verse-chords . ,#{ \chords { \verseChords } #})
 | 
					 | 
				
			||||||
  \override #`(verse-reference-voice . ,#{ \global \firstVoice  #})
 | 
					 | 
				
			||||||
  \TEXT
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
#(if (not noStandaloneOutput)
 | 
					 | 
				
			||||||
(begin
 | 
					 | 
				
			||||||
  (let ((header (ly:book-header HEADER)) (paper (ly:book-paper HEADER)))
 | 
					 | 
				
			||||||
    (if header (set! $defaultheader header))
 | 
					 | 
				
			||||||
    (if paper (set! $defaultpaper paper))
 | 
					 | 
				
			||||||
  )
 | 
					 | 
				
			||||||
  (add-score #{
 | 
					 | 
				
			||||||
    \score {
 | 
					 | 
				
			||||||
      \MUSIC
 | 
					 | 
				
			||||||
      \layout { \LAYOUT }
 | 
					 | 
				
			||||||
    }#})
 | 
					 | 
				
			||||||
  (add-score TEXT)
 | 
					 | 
				
			||||||
  (add-score #{
 | 
					 | 
				
			||||||
    \score {
 | 
					 | 
				
			||||||
      \unfoldRepeats { \MUSIC \INLINESCOREMUSIC }
 | 
					 | 
				
			||||||
      \midi {
 | 
					 | 
				
			||||||
        \context {
 | 
					 | 
				
			||||||
          \Score
 | 
					 | 
				
			||||||
          % Tempo des midi files
 | 
					 | 
				
			||||||
          tempoWholesPerMinute = #(ly:make-moment midiQuarterNoteSpeed 4)
 | 
					 | 
				
			||||||
        }
 | 
					 | 
				
			||||||
      }
 | 
					 | 
				
			||||||
    }#})
 | 
					 | 
				
			||||||
))
 | 
					 | 
				
			||||||
							
								
								
									
										16
									
								
								styles.ly
									
									
									
									
									
								
							
							
						
						
									
										16
									
								
								styles.ly
									
									
									
									
									
								
							@@ -1,16 +0,0 @@
 | 
				
			|||||||
#(define bookStyle
 | 
					 | 
				
			||||||
  (if (not (defined? 'bookStyle))
 | 
					 | 
				
			||||||
      #f
 | 
					 | 
				
			||||||
      bookStyle))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
#(define songStyle
 | 
					 | 
				
			||||||
  (if (not (defined? 'songStyle))
 | 
					 | 
				
			||||||
      (if (not (defined? 'defaultSongStyle)) 'default defaultSongStyle)
 | 
					 | 
				
			||||||
      songStyle))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
#(if (not (boolean? bookStyle))
 | 
					 | 
				
			||||||
         (set! songStyle bookStyle))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
#(define (bock-style layout props)
 | 
					 | 
				
			||||||
  "Whether we have bockstyle or not"
 | 
					 | 
				
			||||||
  (eq? songStyle 'bock))
 | 
					 | 
				
			||||||
		Reference in New Issue
	
	Block a user