fix tag group usage in markups

private_includes/base/all.ily

@@ -40,6 +40,7 @@
 \include "chord_settings.ily"
 \include "chordpro.ily"
 \include "transposition.ily"
+\include "markup_tag_groups_hack.ily"
 \include "verses_with_chords.ily"
 \include "arrows_in_scores.ily"
 \include "swing_style.ily"

private_includes/base/chordpro.ily

@@ -115,7 +115,7 @@
          ((char=? first-char #\h)
           (unless (member chord-str chordpro-h-chords-used)
             (set! chordpro-h-chords-used (cons chord-str chordpro-h-chords-used))))
-         
+
          ;; B/b chords (German B = English Bb)
          ((char=? first-char #\B)
           (unless (member chord-str chordpro-b-chords-used)
@@ -123,17 +123,17 @@
          ((char=? first-char #\b)
           (unless (member chord-str chordpro-b-chords-used)
             (set! chordpro-b-chords-used (cons chord-str chordpro-b-chords-used))))
-         
+
          ;; Chords with accidentals (is/es)
          (has-accidental
           (unless (member chord-str chordpro-accidental-chords-used)
             (set! chordpro-accidental-chords-used (cons chord-str chordpro-accidental-chords-used))))
-         
+
          ;; Other lowercase chords (minor without B/H/accidentals)
          ((char-lower-case? first-char)
           (unless (member chord-str chordpro-minor-chords-used)
             (set! chordpro-minor-chords-used (cons chord-str chordpro-minor-chords-used)))))
-        
+
         ;; Always return original
         chord-str)))
 
@@ -218,7 +218,7 @@
 #(define chordpro-accidental-chords-used '())
 
 %% Configuration and metadata (set by layout_bottom.ily or song file)
-#(define chordpro-export-enabled #t)
+#(define chordpro-export-enabled #f)
 #(define chordpro-current-filename "output")
 #(define chordpro-header-title "Untitled")
 #(define chordpro-header-authors #f)
@@ -486,50 +486,7 @@
                  (cons (list (car pending-syllable) (cadr pending-syllable) #f (caddr pending-syllable))
                        chordpro-syllables-collected))
            (set! pending-syllable #f))
-
+       )))))
-         ;; Write debug output (overwrite each time, final version will be complete)
-         (with-output-to-file "/tmp/chordpro_debug.txt"
-           (lambda ()
-             (display (format #f "ChordPro: Collected ~a syllables, ~a chords (unfiltered), ~a breaks, ~a verses\n"
-                            (length chordpro-syllables-collected)
-                            (length chordpro-chords-collected)
-                            (length chordpro-breaks-collected)
-                            chordpro-current-verse-index))
-             (display "All syllables:\n")
-             (for-each
-               (lambda (syl)
-                 (display (format #f "  V~a: '~a' hyphen=~a at ~a\n"
-                                (cadddr syl) (cadr syl) (if (caddr syl) "YES" "NO") (car syl))))
-               (reverse chordpro-syllables-collected))
-             (newline)
-             (display "Breaks:\n")
-             (for-each
-               (lambda (brk)
-                 (display (format #f "  V~a at ~a\n" (cdr brk) (car brk))))
-               (reverse chordpro-breaks-collected))
-             (newline)
-             (display "All chords (after visibility filtering):\n")
-             (for-each
-               (lambda (chord)
-                 (display (format #f "  V~a: ~a at ~a\n"
-                                (caddr chord) (cadr chord) (car chord))))
-               (reverse chordpro-chords-collected))
-             (newline)
-             (display "Stanza numbers:\n")
-             (for-each
-               (lambda (stanza-entry)
-                 (display (format #f "  V~a: '~a' (type: ~a, real: ~a)\n"
-                                (car stanza-entry) (cadr stanza-entry) (caddr stanza-entry) (cadddr stanza-entry))))
-               (reverse chordpro-stanza-numbers))
-             (newline)
-             (display "Inline texts (repStart/repStop etc.):\n")
-             (for-each
-               (lambda (inline-entry)
-                 (display (format #f "  V~a: '~a' at ~a (dir: ~a)\n"
-                                (cadr inline-entry) (caddr inline-entry) (car inline-entry) (cadddr inline-entry))))
-               (reverse chordpro-inline-texts-collected)))))
-
-       ))))
 
 %% Helper functions to format and write ChordPro
 #(define (chordpro-write-from-engraver-data num-verses)
@@ -553,7 +510,7 @@
         (when (and (defined? 'chordpro-header-authors) chordpro-header-authors)
           (display (format #f "{artist: ~a}\n"
                           (format-chordpro-authors chordpro-header-authors))))
-        
+
         ;; Write {define:} directives for all used minor chords
         (unless (null? chordpro-minor-chords-used)
           (newline)
@@ -563,7 +520,7 @@
               (let ((major-form (german-minor-to-major-form minor-chord)))
                 (display (format #f "{define: ~a copy ~a}\n" minor-chord major-form))))
             (reverse chordpro-minor-chords-used)))
-        
+
         ;; Write {define:} directives for all used B chords (German B = English Bb)
         (unless (null? chordpro-b-chords-used)
           (for-each
@@ -572,7 +529,7 @@
               (let ((bb-form (german-b-to-bb-form b-chord)))
                 (display (format #f "{define: ~a copy ~a}\n" b-chord bb-form))))
             (reverse chordpro-b-chords-used)))
-        
+
         ;; Write {define:} directives for all used H chords (German H = English B)
         (unless (null? chordpro-h-chords-used)
           (for-each
@@ -581,7 +538,7 @@
               (let ((b-form (german-h-to-b-form h-chord)))
                 (display (format #f "{define: ~a copy ~a}\n" h-chord b-form))))
             (reverse chordpro-h-chords-used)))
-        
+
         ;; Write {define:} directives for chords with accidentals (is/es -> #/b)
         (unless (null? chordpro-accidental-chords-used)
           (for-each
@@ -590,7 +547,7 @@
               (let ((intl-form (german-accidentals-to-international accidental-chord)))
                 (display (format #f "{define: ~a copy ~a}\n" accidental-chord intl-form))))
             (reverse chordpro-accidental-chords-used)))
-        
+
         (newline)
 
         ;; Write each verse in reverse order (they were collected backwards)

private_includes/base/default_songinfo_style.ily

@@ -7,6 +7,7 @@
   poetAndComposerEqualPrefix = "Worte und Weise:"
   voicePrefix = "Stimme:"
   versePrefix = "Strophe:"
+  refPrefix = "Refrain:"
   translationAuthorPrefix = "Übersetzung:"
   translationPrefix = "Übersetzung:"
   pronunciationPrefix = "Aussprache:"
@@ -39,6 +40,7 @@
         (versePoetData '())
         (composerIds '())
         (verseComposerData '())
+        (refComposerIds '())
         (voiceComposerData '())
         (compositionIds '())
         (adaptionTextIds '())
@@ -48,6 +50,7 @@
         (year_text #f)
         (year_translation #f)
         (year_melody #f)
+        (year_melody_meloref #f)
         (year_composition #f)
         (year_adaption_text #f)
         (year_adaption_music #f)
@@ -60,12 +63,14 @@
         (adaptionTextPrefix "")
         (adaptionMusicPrefix "")
         (bridgePrefix "")
-        (interludePrefix ""))
+        (interludePrefix "")
+        (refPrefix ""))
       (if (and
             (equal? poetIds composerIds)
             (null? translatorIds)
             (null? versePoetData)
             (null? verseComposerData)
+            (null? refComposerIds)
             (null? voiceComposerData)
             (null? compositionIds)
             (null? adaptionTextIds)
@@ -104,6 +109,7 @@
                 (null? compositionIds)
                 (null? adaptionMusicIds)
                 (null? verseComposerData)
+                (null? refComposerIds)
                 (null? voiceComposerData)
                 (null? bridgeIds)
                 (null? interludeIds)) #f
@@ -116,6 +122,10 @@
                   year_melody
                 ) ", ")
                 (render-partial-contribution-group 'versePrefix verseComposerData)
+                (join-present (list
+                  (render-contribution-group refPrefix refComposerIds)
+                  year_melody_meloref
+                ) ", ")
                 (render-partial-contribution-group 'voicePrefix voiceComposerData)
                 (join-present (list
                   (render-contribution-group compositionPrefix compositionIds)

private_includes/base/footer_with_songinfo.ily

@@ -101,6 +101,7 @@
         #: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)
+        #:refComposerIds (find-author-ids-by 'meloref authors)
         #:voiceComposerData (find-author-id-with-part-numbers 'voice authors)
         #:compositionIds (find-author-ids-by 'composition authors)
         #:adaptionTextIds (find-author-ids-by 'adaption_text authors)
@@ -110,6 +111,7 @@
         #:year_text (chain-assoc-get 'header:year_text props #f)
         #:year_translation (chain-assoc-get 'header:year_translation props #f)
         #:year_melody (chain-assoc-get 'header:year_melody props #f)
+        #:year_melody_meloref (chain-assoc-get 'header:year_melody_meloref 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)
@@ -123,7 +125,7 @@
         #:adaptionMusicPrefix (ly:output-def-lookup layout 'adaptionMusicPrefix)
         #:bridgePrefix (ly:output-def-lookup layout 'bridgePrefix)
         #:interludePrefix (ly:output-def-lookup layout 'interludePrefix)
-      )
+        #:refPrefix (ly:output-def-lookup layout 'refPrefix))
       (list #f #f)
     )
   )
@@ -143,7 +145,7 @@
             (translation (chain-assoc-get 'header:translation props #f))
             (pronunciation (chain-assoc-get 'header:pronunciation props #f))
             (year_text (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_text props #f)))
-            (year_melody (if (string? (car poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f))))
+            (year_melody (if (string? (cadr poet-and-composers)) #f (chain-assoc-get 'header:year_melody props #f))))
             (markup
               #:override (cons 'songinfo:poet-maybe-with-composer
                 (if (and poet-maybe-with-composer (not (and (string? poet-maybe-with-composer) (string-null? poet-maybe-with-composer)))) poet-maybe-with-composer #f))

private_includes/base/markup_tag_groups_hack.ily

@@ -0,0 +1,16 @@
+% We have to record the tag groups for markup, so we use the right tag groups during markup interpretiton.
+recordedTagGroups = #'()
+
+tagGroup =
+#(define-void-function (tags) (symbol-list?)
+   (let ((err (define-tag-group tags)))
+     (if err (ly:parser-error err (*location*))
+         (set! recordedTagGroups (cons tags recordedTagGroups)))))
+
+#(define-markup-command (handle-tag-groups layout props recorded-groups m) (list? markup?)
+   (resetTagGroups)
+   (for-each
+     (lambda (group)
+       (define-tag-group group))
+     recorded-groups)
+   (interpret-markup layout props m))

private_includes/base/transposition.ily

@@ -2,7 +2,12 @@ TRANSPOSITION = #(cons #f #f)
 
 transposeGlobal =
 #(define-void-function (from to) (ly:pitch? ly:pitch?)
-   (set! TRANSPOSITION (cons from to)))
+   (if (not (car TRANSPOSITION))
+       (set! TRANSPOSITION (cons from to))
+       (let ((current_to (cdr TRANSPOSITION))
+             (interval (ly:pitch-diff to from)))
+         (set! TRANSPOSITION (cons (car TRANSPOSITION) 
+                                    (ly:pitch-transpose current_to interval))))))
 
 transposable =
 #(define-music-function (fromto music) (pair? ly:music?)

private_includes/book/toc_include.ily

@@ -283,13 +283,14 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
             (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))
+            (refComposerIds (find-author-ids-by 'meloref 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))
+          (append poetIds translatorIds (map car versePoetData) composerIds (map car verseComposerData) refComposerIds (map car voiceComposerData) compositionIds adaptionIds bridgeIds interludeIds))
     ))
     (let*
       (
@@ -377,6 +378,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
                    (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))
+                   (refComposerIds (find-author-ids-by 'meloref authors))
                    (voiceComposerData (find-author-id-with-part-numbers 'voice authors))
                    (compositionIds (find-author-ids-by 'composition authors))
                    (adaptionTextIds (find-author-ids-by 'adaption_text authors))
@@ -398,7 +400,7 @@ headerToTOC = #(define-music-function (parser location header label) (ly:book? s
                   (headervar-or-empty 'categories)
                   (format-authors (append poetIds adaptionTextIds (map car versePoetData)))
                   (format-authors translatorIds)
-                  (format-authors (append composerIds compositionIds adaptionMusicIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData)))
+                  (format-authors (append composerIds compositionIds adaptionMusicIds bridgeIds interludeIds (map car voiceComposerData) (map car verseComposerData) refComposerIds))
                   (headervar-or-empty 'year_text)
                   (headervar-or-empty 'year_melody)
                   (headervar-or-empty 'year_translation)

public_includes/layout_bottom.ily

@@ -18,6 +18,7 @@ TEXT = \markuplist {
   \override #`(verselayout . ,verselayout)
   \override #`(verse-chords . ,#{ \chords { \verseChords } #})
   \override #`(verse-reference-voice . ,#{ \global \firstVoice  #})
+  \handle-tag-groups \recordedTagGroups
   \TEXT
 }
 
@@ -29,6 +30,7 @@ TEXT = \markuplist {
         \override #`(verselayout . ,verselayout)
         \override #`(verse-chords . ,#{ \chords { \verseChords } #})
         \override #`(verse-reference-voice . ,#{ \global \firstVoice  #})
+        \handle-tag-groups \recordedTagGroups
         #text
       }
     #})