%{
stradella-toolbox 1.3
%}
\version "2.18.2"
%{

  This file is made for LilyPond, the GNU music typesetter.



  Copyright (c) 2012--2015 ArnoldTheresius
    ('Arnold' at the "Deutsches Lilypond Forum" [http://www.lilypondforum.de])



  This 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, or at any other License LilyPond
  is published.



  This 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 LilyPond.  If not, see <http://www.gnu.org/licenses/>.

%}

%§ Workaround - tweaks are transfered to the grobs only _after_ my engravers were running since 2.18.0

%{
#(define (wa:GtwE-propertyID id grob symbol)
  (let ((propty (ly:grob-property grob symbol)))
   (if (null? propty) (begin
     (for-each display (list "\n " id " " symbol " (ly:stream-event? (event-cause grob)) = " (ly:stream-event? (event-cause grob)) "\n"))
     (let ((ev (event-cause grob)))
      (if (ly:stream-event? ev)
       (let ((x
          (ly:assoc-get symbol (ly:event-property ev 'tweaks) #f)
        ))
        (if (not (null? x))
         (for-each display (list "\n " id " grob symbol '" (symbol->string symbol)
          "' only found in cause as " x " "))
        )
        x
       )
       propty
      )
     )
    )
    propty)))
%}

#(define (wa:GtwE-property grob symbol)
  (let ((propty (ly:grob-property grob symbol)))
   (if (null? propty)
    (let ((ev (event-cause grob)))
     (if (ly:stream-event? ev)
      (ly:assoc-get symbol (ly:event-property ev 'tweaks) '())
      '()))
    propty)))

%{
#(define (wa:GtwEb-property grob symbol def)
  (let ((propty (ly:grob-property grob symbol def)))
   (if (null? propty)
    (let ((x
     (ly:assoc-get symbol (ly:event-property (event-cause grob) 'tweaks) def)
     ))
     (if x
      (for-each display (list "\n grob symbol '" (symbol->string symbol)
       "' only defined in cause as ##t "))
     )
     x
    )
    propty)))
%}

%§ Message Translation

#(define locale-lang-translate (list
  '("english" . "en")
  '("german"  . "de")
  '("french"  . "fr")
  '("italian" . "it")))

#(define locale-country-translate (list
  '("germany" . "de")
  '("austria" . "at")
  '("france"  . "fr")
  '("italy"   . "it")))

% Select the string from an alist, where the key is your LANG defintion.
% If no entry is found, take the first element (which should be 'en = english).
#(define (locale-string-select langlist)
  (let ((lang-def (getenv "LANG")))
   (if (eq? lang-def #f) (set! lang-def (setlocale LC_COLLATE "")))
   (if (string? lang-def)
    (let*
     ((pos1 (string-index lang-def #\.))
      (short-lang-def (string-downcase (if (eq? pos1 #f) lang-def (substring lang-def 0 pos1))))
      (pos2 (string-index short-lang-def #\_))
      (part-one (if (eq? pos2 #f) short-lang-def (substring short-lang-def 0 pos2)))
      (part-two (if (eq? pos2 #f) "" (substring short-lang-def (+ 1 pos2))))
      (rep-one (assoc-ref locale-lang-translate part-one))
      (rep-two (assoc-ref locale-country-translate part-two))
      (key-one (if (string? rep-one ) rep-one part-one))
      (key-part-two (if (string? rep-two ) rep-two part-two))
      (key-two (string-append key-one "_" key-part-two))
      (trans-two (assoc-ref langlist (string->symbol key-two))))
     (if (string? trans-two)
      trans-two
      (let ((trans-one (assoc-ref langlist (string->symbol key-one))))
       (if (string? trans-one) trans-one (cdar langlist)))))
    (cdar langlist))))

%§ Properties extension
% Not nessessarily the best solution, but I put my options and flags into the tweaks,
% thus I'll have them automatically available in the notehead grobs.
% Perhaps it would be better to put all these options into one alist called 'stradella'

#(if (not (defined? 'all-user-grob-custom-properties)) ;;;all-user-grob-custom-properties
  (define-public all-user-grob-custom-properties '()))

#(define (add-user-grob-custom-property symbol type? description)
  (if (not (equal? (object-property symbol 'backend-doc) #f))
   (ly:error (_ "symbol ~S redefined") symbol))
  (set-object-property! symbol 'backend-type? type?)
  (set-object-property! symbol 'backend-doc description)
  (set! all-user-grob-custom-properties (cons symbol all-user-grob-custom-properties))
  (set! all-backend-properties (append all-backend-properties (cons symbol '()))))

#(add-user-grob-custom-property
  'stradella-note-event           ly:music? "A backward link to the causing notehead")
#(add-user-grob-custom-property
  'stradella-shows-pitch          boolean?  "Does this stradella text markup contain the pitch")
#(add-user-grob-custom-property
  'stradella-fixed-string         boolean?  "Does this stradella text markup contain a (user defined) fixed string")
#(add-user-grob-custom-property
  'stradella-staff-id             symbol?   "Staff context sequence number in grobs")
#(add-user-grob-custom-property
  'stradella-id                   string?   "content indicator for cleanup")
#(add-user-grob-custom-property
  'stradella-class                symbol?   "'bass or 'chord - type classification for cleanup")
#(add-user-grob-custom-property
  'stradella-type                 symbol?   "Which stradella function does a notehead represent: 'bass, 'alt-bass, 'major, 'minor, 'seveth, 'diminished, or even 'additional or 'additional-sound")
#(add-user-grob-custom-property
  'stradella-show                 scheme?   "boolean to hide or prevent from cleanup, or string to show (and prevent from cleanup)")
#(add-user-grob-custom-property
  'stradella-shift                rational? "shift up or down the bending range octave where to show the noteheads, count in octaves")
#(add-user-grob-custom-property
  'stradella-padding              number?   "an extra padding for the stradella text markups")
#(add-user-grob-custom-property
  'stradella-parenthesize-altbass boolean?  "put the 'alternate bass indicator' (underscore) into braces")
#(add-user-grob-custom-property
  'stradella-new-section          boolean?  "Mark this note event to be an additional start trigger for the cleanup")
#(add-user-grob-custom-property
  'stradella-cleanup-coloration   boolean?  "Used in StaffSymbol to indicate the stradella text scripts selected to be removed with a color")
#(add-user-grob-custom-property
  'stradella-cleaned              integer?  "Used in TextScripts to indicate the stradella cleanup is already processed (if the staff is turned off)")

%§ some utilities

copyMusic =
#(define-music-function (parser location m) (ly:music?)
  (ly:music-deep-copy m))

copyEvent =
#(define-music-function (parser location m) (ly:music?)
  (ly:event-deep-copy m))

% \tag for a tweak? 
tweakOpt =
#(define-music-function (parser location name tag value music)
  (symbol? symbol? scheme? ly:music?)
  (let ((new-sym (symbol-append name '-- tag)))
   (set! (ly:music-property music 'tweaks)
    (acons new-sym value (ly:music-property music 'tweaks)))
   music))

#(define (activate-tweaks tag name-list m)
  (for-each
   (lambda (x)
    (let*
     ((full-name-symb (symbol-append x '-- tag))
      (tw (ly:music-property m 'tweaks))
      (val (ly:assoc-get full-name-symb tw '())))
     (if (not (null? val))
      (set! (ly:music-property m 'tweaks)
       (acons x val (ly:music-property m 'tweaks)))))
   ) name-list)
  m)

%§ something like tags for tweaks
activateTweaks =
#(define-music-function (parser location tag name-list music)
  (symbol? list? ly:music?)
  (music-map (lambda (x) (activate-tweaks tag name-list x))
   (ly:music-deep-copy music)))


%§ short forms of option tweaks for the stradella bass
% they will be defined if you call the following function

enableStradellaTweakShortnames =
#(define-void-function (parser location) ()
  (begin
   ; Stradella bass: forced hide
   (ly:parser-define! parser (string->symbol "SH")
    (define-music-function (parser location music) (ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-show #f
       (ly:music-property music 'tweaks)))
     music))
   ; Stradella bass: forced show
   (ly:parser-define! parser (string->symbol "SS")
    (define-music-function (parser location music) (ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-show #t
       (ly:music-property music 'tweaks)))
     music))
   ; Stradella bass: forced dash to show
   (ly:parser-define! parser (string->symbol "SD")
    (define-music-function (parser location music) (ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-show "-"
       (ly:music-property music 'tweaks)))
     music))
   ; Stradella bass: set alt-bass to be optional (parenthesisze the underline)
   (ly:parser-define! parser (string->symbol "SP")
    (define-music-function (parser location music) (ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-parenthesize-altbass #t
       (ly:music-property music 'tweaks)))
     music))
   ; Stradella bass: add extra offset into the placement (fractional number, 1 = 7/7 = 12/12 = octave)
   (ly:parser-define! parser (string->symbol "SShift")
    (define-music-function (parser location offset music) (rational? ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-shift offset
       (ly:music-property music 'tweaks)))
     music))
   ; Stradella bass: padding for text object
   (ly:parser-define! parser (string->symbol "SPad")
    (define-music-function (parser location padding music) (number? ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-padding padding
       (ly:music-property music 'tweaks)))
     music))
   ; Stradella bass: new section marker for pre-display cleanup
   (ly:parser-define! parser (string->symbol "SN")
    (define-music-function (parser location music) (ly:music?)
     (set! (ly:music-property music 'tweaks)
      (acons 'stradella-new-section #t
       (ly:music-property music 'tweaks)))
     music))
 ))

%§ Helper functions ...

#(define (restore-octave-in-transposed-pitch pitch-dist-back p)
  (let
   ((o (ly:pitch-octave (ly:pitch-transpose p pitch-dist-back)))
    (n (ly:pitch-notename p))
    (a (ly:pitch-alteration p)))
   (ly:make-pitch o n a)))

#(define (restore-octave-in-transpose pitch-dist-back music)
  (let
   ((es (ly:music-property music 'elements))
    (ar (ly:music-property music 'articulations))
    (e (ly:music-property music 'element))
    (p (ly:music-property music 'pitch)))
   (if (pair? ar)
    (ly:music-set-property!
     music 'articulations
     (map (lambda (x) (restore-octave-in-transpose pitch-dist-back x)) ar)))
   (if (pair? es)
    (ly:music-set-property!
     music 'elements
     (map (lambda (x) (restore-octave-in-transpose pitch-dist-back x)) es)))
   (if (ly:music? e)
    (ly:music-set-property!
     music 'element
     (restore-octave-in-transpose pitch-dist-back e)))
   (if (ly:pitch? p)
    (begin
     (set! p (restore-octave-in-transposed-pitch pitch-dist-back p))
     (ly:music-set-property! music 'pitch p)))
   music))

#(define (keep-octave-transpose from-pitch to-pitch music)
  (let ((pitch-dist-back (ly:pitch-diff from-pitch to-pitch)))
   (restore-octave-in-transpose pitch-dist-back
    (ly:music-transpose music (ly:pitch-diff to-pitch from-pitch)))))

%§ transpose, but keep them in the same octave 
keepOctaveTranspose =
#(define-music-function (parser location from-pitch to-pitch m) (ly:pitch? ly:pitch? ly:music?)
  (keep-octave-transpose from-pitch to-pitch m))




#(define (stradella-x-type-info-notehead-markup notehead-grob grey-tone text-string)
  (let*
   ((sz (ly:grob-property notehead-grob 'font-size 0.0))
    (dl (ly:grob-property notehead-grob 'duration-log 2))
    (mult (magstep sz)))
   (markup #:line (#:with-dimensions
     (cons (* -0.9 mult) (* 0.9 mult))
     (cons (* -0.5 mult) (* 0.5 mult))
     (#:postscript (string-concatenate (list
        " " (number->string mult) " dup scale \n"
        " newpath 0.2 setlinewidth 1 setlinejoin 1 setlinecap \n"
        " -0.8 -0.15 moveto \n"
        " -0.4 -0.4 lineto 0.4 -0.4 lineto 0.8 0.15 lineto \n"
        " 0.4 0.4 lineto -0.4 0.4 lineto -0.8 -0.15 lineto \n"
        (if grey-tone " 0.5 setgray" " ")
        " gsave" (if (>= dl 2) " " " 1.0 setgray ") "fill grestore stroke \n"
        " 0 -0.25 moveto \n"
        (if (>= dl 2)
          " /Helvetica-Bold findfont 0.7 scalefont setfont 1.0 setgray \n"
          " /Helvetica findfont 0.7 scalefont setfont 0.0 setgray \n")
        " (" text-string ") \n"
        " dup stringwidth pop -0.5 mul 0 rmoveto \n"
        " show \n")))))))

#(define (stradella-altbass-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #f "A"))
#(define (stradella-bass-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #f "B"))
#(define (stradella-minor-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #f "m"))
#(define (stradella-major-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #f "M"))
#(define (stradella-seventh-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #f "7"))
#(define (stradella-diminished-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #f "d"))
#(define (stradella-additional-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #t "+"))
#(define (stradella-additionalsound-type-info-notehead-markup notehead-grob)
  (stradella-x-type-info-notehead-markup notehead-grob #t "s"))

%§ use with \musicMap to visualize the stradella information
#(define-public (stradella-type-to-notehead e)
  (let ((eventtype (ly:music-property e 'name)))
   (if (eq? eventtype 'NoteEvent)
    (let ((t (ly:music-property e 'tweaks)))
     (if (not (null? t))
      (let ((st (assq 'stradella-type t)))
       (if (pair? st)
        (let ((sn (symbol->string (cdr st))))
         (if (equal? sn "alt-bass")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-altbass-type-info-notehead-markup t))))
         (if (equal? sn "bass")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-bass-type-info-notehead-markup t))))
         (if (equal? sn "major")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-major-type-info-notehead-markup t))))
         (if (equal? sn "minor")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-minor-type-info-notehead-markup t))))
         (if (equal? sn "seventh")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-seventh-type-info-notehead-markup t))))
         (if (equal? sn "diminished")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-diminished-type-info-notehead-markup t))))
         (if (equal? sn "additional")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-additional-type-info-notehead-markup t))))
         (if (equal? sn "additional-sound")
          (ly:music-set-property! e 'tweaks
           (acons 'stencil ly:text-interface::print
            (acons 'text stradella-additionalsound-type-info-notehead-markup t))))))))))
   e))

#(define-public (add-stradella-info e)
  (let ((eventtype (ly:music-property e 'name)))
   (if (eq? eventtype 'NoteEvent)
    (let*
     ((p (ly:music-property e 'pitch))
      (o (ly:pitch-octave p))
      (n (ly:pitch-notename p))
      (a (ly:pitch-alteration p))
      (t (ly:music-property e 'tweaks))
      (allready-defined (if (null? t) #f
        (if (pair? (assq 'stradella-type t)) #t #f))))
     (if (not allready-defined)
      (case o
       ((-3) ;(display " alt-bass...")
        (ly:music-set-property! e 'tweaks
         (acons 'stradella-type 'alt-bass t))
        (ly:music-set-property! e 'pitch (ly:make-pitch -2 n a)))
       ((-2) ;(display " bass...")
        (ly:music-set-property! e 'tweaks
         (acons 'stradella-type 'bass t)))
       ((-1) ;(display " major-chord...")
        (ly:music-set-property! e 'tweaks
         (acons 'stradella-type 'major t)))
       ((0) ;(display " minor-chord...")
        (ly:music-set-property! e 'tweaks
         (acons 'stradella-type 'minor t))
        (ly:music-set-property! e 'pitch (ly:make-pitch -1 n a)))
       ((1) ;(display " seventh-chord...")
        (ly:music-set-property! e 'tweaks
         (acons 'stradella-type 'seventh t))
        (ly:music-set-property! e 'pitch (ly:make-pitch -1 n a)))
       ((2) ;(display " diminished-chord...")
        (ly:music-set-property! e 'tweaks
         (acons 'stradella-type 'diminished t))
        (ly:music-set-property! e 'pitch (ly:make-pitch -1 n a)))
       (else (ly:warning (locale-string-select '(
           (en . "~a is NOT in a supported stradella proxy octave")
           (de . "~a beschreibt keine der unterstützten Stradella-Stellvertreter-Oktaven"))) p))))))
      ; if 'stradella-type' is allready defined, no octave alteration in the pitch will be done here
   e))

%§ convert the weak octave information into the more stable stradella attributes
stradellaMode =
#(define-music-function (parser location m) (ly:music?)
  (music-map add-stradella-info m))


#(define (stradella-text-recuction e)
  (let ((eventtype (ly:music-property e 'name)))
   (if (eq? eventtype 'NoteEvent)
    (let*
     ((a (ly:music-property e 'articulations '()))
      (d (ly:music-property e 'duration))
      (l (ly:duration-log d)))
     (if (> l 2)
      (ly:music-set-property! e 'articulations
       (cons (make-music 'BeamForbidEvent) '()))
      (if (not (null? a))
       (ly:music-set-property! e 'articulations '()))))
    (if (eq? eventtype 'EventChord)
     (let*
      ((es (ly:music-property e 'elements))
       (new-es (filter (lambda (x)
          (let ((en (ly:music-property x 'name)))
           (or (eq? en 'NoteEvent)
               (eq? en 'EventChord)
               (eq? en 'SkipEvent)
               (eq? en 'RestEvent)))) es))
       (dllist (cons 0 (map (lambda (x)
           (let ((dur (ly:music-property x 'duration '())))
            (if (ly:duration? dur)
             (ly:duration-log dur) 0))) new-es)))
       (dlmax (apply max dllist)))
      (if (> dlmax 2)
       (set! new-es (append new-es
         (cons (make-music 'BeamForbidEvent) '()))))
      (ly:music-set-property! e 'elements new-es))))
  e))
stradellaReduceForTextOnly =
#(define-music-function (parser location m) (ly:music?)
  (music-map stradella-text-recuction m))


%§ post processing marks for the extended parallelMusic
pmpStartRepeat = #(define-music-function (parser location) () (make-music 'MarkEvent
 'label "<parallel-music-results-postprocess:start repeat volta 2>"))
pmpStartRepeatEx = #(define-music-function (parser location count) (integer?) (make-music 'MarkEvent
 'label (string-append "<parallel-music-results-postprocess:start repeat volta " (number->string count) ">")))
pmpEndRepeat = #(define-music-function (parser location) () (make-music 'MarkEvent
 'label "<parallel-music-results-postprocess:end repeat>"))
pmpStartAlternative = #(define-music-function (parser location) () (make-music 'MarkEvent
 'label "<parallel-music-results-postprocess:start alternative>"))

#(define (pmpMark mus)
  (if (ly:music? mus)
   (let
    ((eventtype (ly:music-property mus 'name))
     (labeltext (ly:music-property mus 'label))
    )
    (if (and (eq? eventtype 'MarkEvent) (string? labeltext))
     (let*
      ((head "<parallel-music-results-postprocess:")
       (headlen (string-length head))
       (labellen (string-length labeltext)))
      (if (<= labellen headlen) 0
       (let*
        ((labelhead (string-copy labeltext 0 headlen))
         (labelpost (string-copy labeltext headlen))
         (postlen (string-length labelpost))
         (labelshortpost (string-copy labelpost 0 (min postlen 19)))
        )
        (if (string=? labelhead head)
         (if (string=? labelshortpost "start repeat volta ") 1
          (if (string=? labelpost "end repeat>") 2
           (if (string=? labelpost "start alternative>") 3
            0)))
         0))))
     0))
   0))

#(define (pmpMarkRepeatCount mus)
  (if (ly:music? mus)
   (let
    ((eventtype (ly:music-property mus 'name))
     (labeltext (ly:music-property mus 'label)))
    (if (and (eq? eventtype 'MarkEvent) (string? labeltext))
     (let*
      ((head "<parallel-music-results-postprocess:")
       (headlen (+ (string-length head) 19))
       (labellen (string-length labeltext)))
      (if (<= labellen headlen) 2
       (let*
        ((labelhead (string-copy labeltext 0 headlen))
         (labelpost (string-copy labeltext headlen (- labellen 1)))
         (labelterm (string-copy labeltext (- labellen 1))))
        (if (string=? labelterm ">") (string->number labelpost)
         2))))
     2))
   2))

#(define (parallel-music-results-postprocess mus)
  (let ((eventtype (ly:music-property mus 'name)))
   (if (eq? eventtype 'SequentialMusic)
    (let
     ((es (ly:music-property mus 'elements))
      (new-es '())
      (active-dest 0)
      (rep-collect '())
      (alt-collect '())
      (alt-list-collect '())
      (rep-count 2)
     )
     (for-each (lambda (ese)
       (let ((etype (pmpMark ese)))
        (if (eq? etype 2) ;; end repeat ;;
         (begin
          (if (eq? active-dest 3)
           (set! alt-list-collect (append alt-list-collect (cons (make-music 'SequentialMusic 'elements alt-collect) '()))))
          (set! new-es (append new-es (cons
           (make-music 'VoltaRepeatedMusic 'repeat-count rep-count
            'element (make-music 'SequentialMusic 'elements rep-collect) 'elements alt-list-collect) '())))
          (set! active-dest 0)
          (set! rep-collect '())
          (set! alt-collect '())
          (set! alt-list-collect '())))
        (if (eq? etype 1) ;; start repeat ;;
         (begin
          (if (eq? active-dest 3)
           (set! alt-list-collect (append alt-list-collect (cons (make-music 'SequentialMusic 'elements alt-collect) '()))))
          (if (>= active-dest 1) ;; terminate existing repeat and start new repeat block
           (set! new-es (append new-es (cons
            (make-music 'VoltaRepeatedMusic 'repeat-count rep-count
             'element (make-music 'SequentialMusic 'elements rep-collect) 'elements alt-list-collect) '()))))
          (set! active-dest 1)
          (set! rep-collect '())
          (set! alt-collect '())
          (set! alt-list-collect '())))
        (if (and (eq? etype 3) (>= active-dest 1)) ;; start alternative (only when repeat allready started) ;;
         (if (eq? active-dest 3) ;; next alternative ;;
          (begin
           (set! alt-list-collect (append alt-list-collect (cons (make-music 'SequentialMusic 'elements alt-collect) '())))
           (set! alt-collect '()))
          (set! active-dest 3)))
        (if (eq? etype 0)
         (begin
          (if (eq? active-dest 0)
           (set! new-es (append new-es (cons ese '()))))
          (if (eq? active-dest 1)
           (set! rep-collect (append rep-collect (cons ese '()))))
          (if (eq? active-dest 3)
           (set! alt-collect (append alt-collect (cons ese '())))))))) 
      es)
     (if (eq? active-dest 1) ;; start repeat is open ;;
      (set! new-es (append new-es (cons
       (make-music 'VoltaRepeatedMusic 'repeat-count rep-count
        'element (make-music 'SequentialMusic 'elements rep-collect) 'elements alt-list-collect) '()))))
     (if (eq? active-dest 3) ;; start alternative is open ;;
      (begin
       (set! alt-list-collect (append alt-list-collect (cons (make-music 'SequentialMusic 'elements alt-collect) '())))
       (set! new-es (append new-es (cons
        (make-music 'VoltaRepeatedMusic 'repeat-count rep-count
         'element (make-music 'SequentialMusic 'elements rep-collect) 'elements alt-list-collect) '())))))
     (ly:music-set-property! mus 'elements new-es)
     mus)
    mus)))

#(define (sequential-music-without-tags m)
  (let ((eventtype (ly:music-property m 'name)))
   (if (eq? eventtype 'SequentialMusic)
    (let ((taglist (ly:music-property m 'tags)))
     (if (null? taglist) #t
      (if (<= (length taglist) 0) #t #f)))
    #f)))

#(define (unnest-sequential-music mus)
  (let ((eventtype (ly:music-property mus 'name)))
   (if (eq? eventtype 'SequentialMusic)
    (let
     ((es (ly:music-property mus 'elements))
      (immigrate-count 0))
     (for-each (lambda (ese) (if (sequential-music-without-tags ese)
        (set! immigrate-count (+ 1 immigrate-count))))
      es)
     (if (> immigrate-count 0)
      (let ((new-es '()))
       (for-each (lambda (ese)
         (if (sequential-music-without-tags ese)
          (let ((inner-es (ly:music-property ese 'elements)))
           (for-each (lambda (esi)
             (set! new-es (append new-es (cons esi '()))))
            inner-es))
          (set! new-es (append new-es (cons ese '())))))
        es)
       (ly:music-set-property! mus 'elements new-es)))
     (if (and (defined? 'pmp-get-rid-of-last-barcheck)
              (boolean? pmp-get-rid-of-last-barcheck)
              pmp-get-rid-of-last-barcheck)
      (let* ((final-es (ly:music-property mus 'elements))
             (es-len (length final-es))
             (last-e (if (> es-len 1) (list-ref final-es (- es-len 1)) '()))
             (last-type (if (ly:music? last-e) (ly:music-property last-e 'name) 'something-else)))
       (if (eq? last-type 'BarCheck)
        (ly:music-set-property! mus 'elements
         (list-head final-es (- es-len 1))))))))
   mus))

%#(define (display-music-tree indent mus)
%  (if (ly:music? mus)
%   (let
%    ((eventtype (ly:music-property mus 'name))
%     (es (ly:music-property mus 'elements)))
%    (display "\n")
%    (do ((i 1 (1+ i))) ((> i indent)) (display "   "))
%    (display eventtype)
%    (if (or (sequential-music-without-tags mus) (not (eq? eventtype 'SequentialMusic)))
%     (display " ") 
%     (display " (tagged) "))
%    (if (eq? eventtype 'MarkEvent)
%     (let ((mark-text (ly:music-property mus 'label)))
%      (display " \"") (display mark-text) (display "\" ")))
%    (if (not (null? es))
%     (for-each (lambda (ese) (display-music-tree (+ indent 1) ese)) es)))))
%
%§ reduced \displayMusic, just show the structure without content
%displayMusicTree =
%#(define-void-function (parser location m) (ly:music?)
%  (display-music-tree 0 m))


%§ \paralleMusic with \stradellaMode applied to the last voice
% and another postprocessor applied to all voices
parallelMusicWithStradella =
#(define-void-function (parser location voice-ids music) (list? ly:music?)
  (let ((parmus (ly:parser-lookup parser 'parallelMusic)))
   (if (null? parmus)
    (ly:warning (locale-string-select '(
       (en . "\\parallelMusic not found in parser!")
       (de . "\\parallelMusic konnte im Parser nicht gefunden werden!"))))
    (if (not (ly:music-function? parmus))
     (ly:warning  (locale-string-select '(
        (en . "\\parallelMusic is not a music function!")
        (de . "\\parallelMusic ist keine Musikfunktion!"))))
     (let ((parex (ly:music-function-extract parmus)))
      (parex parser location voice-ids music)     
      ;; also works: (apply parex parser location voice-ids music '())
      (let ((counter 0))
       (for-each (lambda (voice-id)
         (let ((pme (ly:parser-lookup parser voice-id)))
          (if (null? pme)
           (ly:warning (locale-string-select '(
              (en . "parallel music sequence not created: ~a")
              (de . "Parallel-Musik-Sequenz wurde nicht erzeugt: ~a"))) voice-id)
           (if (eq? counter 0)
            (ly:parser-define! parser voice-id
             (parallel-music-results-postprocess
              (music-map add-stradella-info
               (unnest-sequential-music pme))))
            (ly:parser-define! parser voice-id
             (parallel-music-results-postprocess
              (unnest-sequential-music pme)))
         )))
         (set! counter (+ 1 counter)))
        (reverse voice-ids))))))))


%§ just a wrapper, a new name for an existing function
stradellaChordify =
#(define-music-function (parser location m) (ly:music?)
  (event-chord-wrap! m parser))

#(define (stradella-chordpitch-bend p c pit)
  (let ((e-correction 0))
   (if c
    ; chromatic pitch
    (let*
     ((e-cp (ly:pitch-semitones pit))
      (r-cp (ly:pitch-semitones p))
      (d-cp (- e-cp r-cp)))
     (if (or (>= d-cp 12) (< d-cp 0))
      (set! e-correction (- (floor (/ d-cp 12))))))
    ; diatonic pitch
    (let*
     ((e-dp (ly:pitch-steps pit))
      (r-dp (ly:pitch-steps p))
      (d-dp (- e-dp r-dp)))
     (if (or (>= d-dp 7) (< d-dp 0))
      (set! e-correction (- (floor (/ d-dp 7)))))))
   (if (not (eq? e-correction 0))
    (let
     ((o (ly:pitch-octave pit))
      (a (ly:pitch-alteration pit))
      (n (ly:pitch-notename pit)))
     (ly:make-pitch (+ o e-correction) n a))
    pit)))

#(define (stradella-append-chord-note es transpose-pitch p c e snd)
  (let*
   ((transposed (stradella-chordpitch-bend p c (ly:pitch-transpose (ly:music-property e 'pitch) transpose-pitch)))
    (transposed-chromatic (ly:pitch-semitones transposed))
    (allready-in #f))
   (for-each (lambda (x)
     (if (ly:music? x) (if (eq? (ly:music-property x 'name) 'NoteEvent)
       (if (eq? (ly:pitch-semitones (ly:music-property x 'pitch)) transposed-chromatic)
        (set! allready-in #t))))
    ) es)
   (if (not allready-in)
    (let
     ((durat (ly:music-property e 'duration))
      (orign (ly:music-property e 'origin))
      (twkes (acons 'stradella-type (if snd 'additional-sound 'additional)
        (assoc-remove! (alist-copy (ly:music-property e 'tweaks)) 'stradella-type))))
     ; (display "Ton ") (display transposed) (display " mit ") (display twkes) (display " wird eingefuegt.")
     (append! es (list (make-music 'NoteEvent
        'pitch transposed  'duration durat  'tweaks twkes  'origin orign)))))))

#(define-public (stradella-type-number tweaks show-additional)
  (if (null? tweaks) 0
   (let ((stype (assq 'stradella-type tweaks)))
    (if (pair? stype)
     (let ((sn (symbol->string (cdr stype))))
      (if (equal? sn "alt-bass") -2
       (if (equal? sn "bass") -1
        (if (equal? sn "major") 1
         (if (equal? sn "minor") 2
          (if (equal? sn "seventh") 3
           (if (equal? sn "diminished") 4
            (if (and (equal? sn "additional") show-additional) 99
             0)
     )))))))
     0))))

#(define-public (stradella-spread p c bass-shift add-chord add-opts m)
  (let ((eventtype (ly:music-property m 'name)))
   (if (eq? eventtype 'EventChord)
    (let ((es (ly:music-property m 'elements)))
     (do
      ((pass 1 (1+ pass)))
      ((> pass (if add-chord 2 1)))
      (for-each (lambda (e)
        (if (ly:music? e)
         (let*
          ((e-name (ly:music-property e 'name))
           (e-tweaks (ly:music-property e 'tweaks))
           (e-st (stradella-type-number e-tweaks #t)))
          (if (eq? e-name 'NoteEvent)
           (if (eq? pass 1) ; execute pitch-bend
            (if (not (eq? e-st 0))
             (let*
              ((e-pitch (ly:music-property e 'pitch))
               (e-tweaks (ly:music-property e 'tweaks))
               (e-shift-tag (ly:assoc-get 'stradella-shift e-tweaks '()))
               (e-shift-off (ly:assoc-get 'disable-shift add-opts #f))
               (e-shift (if (or e-shift-off (null? e-shift-tag)) 0 e-shift-tag))
               (e-bass-shift (if e-shift-off 0
                              (if (null? e-shift-tag) bass-shift e-shift-tag)))
               (e-correction 0))
              (if c
               ; chromatic pitch
               (let*
                ((e-cp (ly:pitch-semitones e-pitch))
                 (r-shift (floor (+ 1/2 (* 12 (if (> e-st 0) e-shift e-bass-shift)))))
                 (r-cp (+ (ly:pitch-semitones p) r-shift))
                 (d-cp (- e-cp r-cp)))
                (if (> e-st 0) ; chord pitch
                 (if (or (>= d-cp 12) (< d-cp 0))
                  (set! e-correction (- (floor (/ d-cp 12))))))
                (if (< e-st 0) ; bass pitch
                 (if (or (>= d-cp 0) (< d-cp -12))
                  (set! e-correction (- (floor (/ (+ d-cp 12) 12)))))))
               ; diatonic pitch
               (let*
                ((e-dp (ly:pitch-steps e-pitch))
                 (r-shift (floor (+ 1/2 (* 7 (if (> e-st 0) e-shift e-bass-shift)))))
                 (r-dp (+ (ly:pitch-steps p) r-shift))
                 (d-dp (- e-dp r-dp)))
                (if (> e-st 0) ; chord pitch
                 (if (or (>= d-dp 7) (< d-dp 0))
                  (set! e-correction (- (floor (/ d-dp 7))))))
                (if (< e-st 0) ; bass pitch
                 (if (or (>= d-dp 0) (< d-dp -7))
                  (set! e-correction (- (floor (/ (+ d-dp 7) 7))))))))
              (if (not (eq? e-correction 0))
               (let
                ((o (ly:pitch-octave e-pitch))
                 (a (ly:pitch-alteration e-pitch))
                 (n (ly:pitch-notename e-pitch)))
                (ly:music-set-property! e 'pitch (ly:make-pitch (+ o e-correction) n a))
            )))) ; end of (if 'pass 1' action
            (if (eq? pass 2) ; execute chord-build
             (if (> e-st 0)
              (let*
               ((chord-dup-count (ly:assoc-get 'duplicate-chords add-opts #f))
                (dup-chords (if (integer? chord-dup-count) #t #f)))
               ;(display "\nPass 2, add-chord, e-st > 0\n")
               (case e-st
                ((1) ;(display "\n1. e-st = ") (display e-st) (display (ly:music-property e 'pitch))
                 (stradella-append-chord-note es (ly:make-pitch 0 2 0) p c e #f)
                 (stradella-append-chord-note es (ly:make-pitch 0 4 0) p c e #f)
                 (if dup-chords
                  (do
                   ((oct 1 (1+ oct)))
                   ((> oct chord-dup-count))
                   (stradella-append-chord-note es (ly:make-pitch oct 0 0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 2 0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 4 0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t))))
                ((2) ;(display "\n2. e-st = ") (display e-st) (display (ly:music-property e 'pitch))
                 (stradella-append-chord-note es (ly:make-pitch 0 2 -1/2) p c e #f)
                 (stradella-append-chord-note es (ly:make-pitch 0 4    0) p c e #f)
                 (if dup-chords
                  (do
                   ((oct 1 (1+ oct)))
                   ((> oct chord-dup-count))
                   (stradella-append-chord-note es (ly:make-pitch oct 0    0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 2 -1/2) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 4    0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t))))
                ((3) ;(display "\n3. e-st = ") (display e-st) (display (ly:music-property e 'pitch))
                 (stradella-append-chord-note es (ly:make-pitch 0 2    0) p c e #f)
                 (stradella-append-chord-note es (ly:make-pitch 0 6 -1/2) p c e #f)
                 (if dup-chords
                  (do
                   ((oct 1 (1+ oct)))
                   ((> oct chord-dup-count))
                   (stradella-append-chord-note es (ly:make-pitch oct 0    0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 2    0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 6 -1/2) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)))
                 (if (or (ly:assoc-get 'enable-full-chords add-opts #f)
                         (ly:assoc-get 'enable-full-seventh-chords add-opts #f))
                  (begin
                   (stradella-append-chord-note es (ly:make-pitch 0 4 0) p c e #f)
                   (if dup-chords
                    (do
                     ((oct 1 (1+ oct)))
                     ((> oct chord-dup-count))
                     (stradella-append-chord-note es (ly:make-pitch oct 4 0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)))
                )))
                ((4) ;(display "\n4. e-st = ") (display e-st) (display (ly:music-property e 'pitch))
                 (stradella-append-chord-note es (ly:make-pitch 0 2 -1/2) p c e #f)
                 (stradella-append-chord-note es (ly:make-pitch 0 5    0) p c e #f)
                 (if dup-chords
                  (do
                   ((oct 1 (1+ oct)))
                   ((> oct chord-dup-count))
                   (stradella-append-chord-note es (ly:make-pitch oct 0    0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 2 -1/2) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)
                   (stradella-append-chord-note es (ly:make-pitch oct 5    0) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)))
                 (if (or (ly:assoc-get 'enable-full-chords add-opts #f)
                         (ly:assoc-get 'enable-full-diminished-chords add-opts #f))
                  (begin
                   (stradella-append-chord-note es (ly:make-pitch 0 4 -1/2) p c e #f)
                   (if dup-chords
                    (do
                     ((oct 1 (1+ oct)))
                     ((> oct chord-dup-count))
                     (stradella-append-chord-note es (ly:make-pitch oct 4 -1/2) (ly:pitch-transpose p (ly:make-pitch oct 0 0)) c e #t)))
                )))
                ; ((99) (display "\n additional stradella pitch needs no action "))
             )) ; end of (if 'add-chord for chord tones' action
              (if (< e-st 0)
               (let*
                ((bass-dup-up-count (ly:assoc-get 'duplicate-bass-up add-opts #f))
                 (dup-bass-up (if (integer? bass-dup-up-count) #t #f))
                 (bass-dup-down-count (ly:assoc-get 'duplicate-bass-down add-opts #f))
                 (dup-bass-down (if (integer? bass-dup-down-count) #t #f))
                )
                (if dup-bass-up
                 (do
                  ((oct 1 (1+ oct)))
                  ((> oct bass-dup-up-count))
                  (stradella-append-chord-note es (ly:make-pitch 0 0 0) (ly:pitch-transpose p (ly:make-pitch (- oct 1) 0 0)) c e #t)
                ))
                (if dup-bass-down
                 (do
                  ((oct 1 (1+ oct)))
                  ((> oct bass-dup-down-count))
                  (stradella-append-chord-note es (ly:make-pitch 0 0 0) (ly:pitch-transpose p (ly:make-pitch (- -1 oct) 0 0)) c e #t)
           )))))))
       )))) ; end of lambda in (for-each ... es)
       es)) ; end of '(do ... )
     m)
    m)))

%§ Place the noteEvent into the desired octave range and so on
stradellaSpread =
#(define-music-function (parser location chords-base-pitch chromatic-mode bass-shift add-chord add-opts m)
                                        (ly:pitch?         boolean?       rational?  boolean?  list?    ly:music?)
  ; (display "\nc = ") (display chromatic-mode) (display "\n")
  (music-map (lambda (x) (stradella-spread chords-base-pitch
                                           chromatic-mode bass-shift add-chord add-opts x)) m))

#(define-markup-command (stradella-underline layout props parentesize arg)
  (boolean? markup?)
  #:category font
  #:properties ((font-size 0) (thickness 2.5) (offset 3.5))
  (let*
   ((thick (* (magstep font-size) (ly:output-def-lookup layout 'line-thickness)))
    (underline-thick (* thickness thick))
    (markup (interpret-markup layout props arg))
    (x1 (car (ly:stencil-extent markup X)))
    (x2 (cdr (ly:stencil-extent markup X)))
    (y (* thick (- offset)))
    (line (make-line-stencil underline-thick x1 y x2 y)))
   (if parentesize
    (let*
     ((p-thick (* underline-thick 0.5))
      (xd1 0.9)   (xd2 1.6)
      (yd1 0.9)   (yd2 1.6)
      (y11 (+ y (* underline-thick yd1)))
      (y12 (+ y (* underline-thick yd2)))
      (y21 (- y (* underline-thick yd1)))
      (y22 (- y (* underline-thick yd2)))
      (x11 (- x1 (* underline-thick xd2)))
      (x12 (- x1 (* underline-thick xd1)))
      (x21 (+ x2 (* underline-thick xd2)))
      (x22 (+ x2 (* underline-thick xd1)))
      (pla (make-line-stencil p-thick x11 y11 x12 y12))
      (plb (make-line-stencil p-thick x11 y11 x11 y21))
      (plc (make-line-stencil p-thick x12 y22 x11 y21))
      (pra (make-line-stencil p-thick x21 y11 x22 y12))
      (prb (make-line-stencil p-thick x21 y11 x21 y21))
      (prc (make-line-stencil p-thick x22 y22 x21 y21)))
     (ly:stencil-add markup line pla plb plc pra prb prc))
    (ly:stencil-add markup line))))

#(define-markup-command (raise-scaled layout props amount arg)
  (number? markup?)
  #:category align
  #:properties ((font-size 0))
  (let ((s-amount (* (magstep font-size) amount)))
   (ly:stencil-translate-axis (interpret-markup layout props arg) s-amount Y)))


#(define (stradella-textify-static chords-or-bass up-down give-prio text-style e)
  (let ((eventtype (ly:music-property e 'name)))
   (if (eq? eventtype 'EventChord)
    (let
     ((es (ly:music-property e 'elements))
      (t-aaa (if (equal? text-style "AAA") #t #f))
      (text-added #f)
     )
     (for-each (lambda (n)
       (let ((neventtype (ly:music-property n 'name)))
        (if (eq? neventtype 'NoteEvent)
         (let*
          ((e-tweaks (ly:music-property n 'tweaks))
           (e-st (stradella-type-number e-tweaks #f))
           (e-padding (ly:assoc-get 'stradella-padding e-tweaks '()))
           (e-parentaltbass (ly:assoc-get 'stradella-parenthesize-altbass e-tweaks #f))
           (e-show (ly:assoc-get 'stradella-show e-tweaks '()))
           (e-trigger (ly:assoc-get 'stradella-new-section e-tweaks #f))
           (e-show-opt (if (null? e-show) '() (acons 'stradella-show e-show '())))
           (e-fixed (string? e-show))
           (e-skip (and (boolean? e-show) (eq? e-show #f)))
          )
          (if (and (not e-skip)
                   (or (and (> e-st 0) (>= chords-or-bass 0))
                       (and (< e-st 0) (<= chords-or-bass 0)))
                   (or (not (and t-aaa (eq? e-st -1)))
                       e-fixed
                       e-trigger))
           (let*
            ((t-nat-on-b (if (equal? text-style "semiDefault") #t #f))
             (t-flat-on-b (if (equal? text-style "german") #f #t))
             (t-use-b (if (or (equal? text-style "default") (equal? text-style "semiDefault")) #t #f))
             (e-pitch (ly:music-property n 'pitch))
             (e-notename (ly:pitch-notename e-pitch))
             (e-altera (ly:pitch-alteration e-pitch))
             (e-class (if (< e-st 0) 'bass (if (> e-st 0) 'chord #f)))
             (e-opt0 (if (equal? give-prio 0) e-show-opt (acons 'outside-staff-priority give-prio e-show-opt)))
             (e-opt00 (if e-trigger (acons 'stradella-new-section #t e-opt0) e-opt0))
             (e-opt1 (acons 'extra-spacing-width (cons 0  0)
                      (acons 'extra-spacing-height (cons -inf.0 +inf.0)
                       (acons 'stradella-note-event n
                        (acons 'stradella-shows-pitch (not t-aaa)
                         (acons 'stradella-class e-class
                          (acons 'stradella-fixed-string e-fixed
                           (if (null? e-padding)
                            (acons 'padding 0.65 e-opt00)
                            (acons 'padding e-padding e-opt00)
                           ))))))))
            )
            (if t-aaa
             (let*
              ((id (string-concatenate (list "[" (number->string e-st)
                                             (if (and (eq? e-st -1) e-parentaltbass) "p" "")
                                             "]")))
               (e-sign (case e-st
                 ((-2) " ")
                 ((-1) "")
                 ((1) "M")
                 ((2) "m")
                 ((3) "7")
                 ((4) "d")
                 (else "?")))
               (e-text
                (if e-fixed
                 (markup #:line (#:roman (#:center-align (#:simple e-show))))
                 (if (eq? e-st -2)
                  (markup #:line (#:roman (#:center-align (#:stradella-underline e-parentaltbass
                       (#:simple e-sign)))))
                  (if (eq? e-st -1)
                   ; need no text, but a trigger for a new section
                   (markup #:line #:null)
                   (markup #:line (#:roman (#:center-align (#:simple e-sign)))))
               )))
               (e-object (make-music 'TextScriptEvent
                 'direction up-down
                 'text e-text
                 'tweaks (acons 'stradella-id id e-opt1)
               ))
              )
              (append! es (list e-object))
              (set! text-added #t)
             )
             (let*
              ((id (string-concatenate (list "[" (number->string e-notename)
                                             "|" (number->string (* e-altera 200))
                                             "|" (number->string e-st)
                                             (if (and (eq? e-st -1) e-parentaltbass) "p" "")
                                             "]")))
               (e-post (case e-st
                 ((-2) "")
                 ((-1) "")
                 ((1) "")
                 ((2) "m")
                 ((3) "⁷")
                 ((4) "v")
                 (else "")))
               (e-mid (case e-altera
                 ((-1)   (markup (#:doubleflat)))
                 ((-1/2) (if (or t-flat-on-b (not (eq? e-notename 6))) (markup (#:flat)) (markup (#:null)))) 
                 ((0)    (if (and t-nat-on-b (eq? e-notename 6)) (markup (#:natural)) (markup (#:null))))
                 ((1/2)  (markup (#:sharp)))
                 ((1)    (markup (#:doublesharp)))
                 (else (#:simple "?"))))
               (e-pre (case e-notename
                 ((0) (if (<= e-st 0) "C" "c"))
                 ((1) (if (<= e-st 0) "D" "d"))
                 ((2) (if (<= e-st 0) "E" "e"))
                 ((3) (if (<= e-st 0) "F" "f "))
                 ((4) (if (<= e-st 0) "G" "g"))
                 ((5) (if (<= e-st 0) "A" "a"))
                 ((6) (if (or (equal? e-altera -1/2) t-use-b) (if (<= e-st 0) "B" "b") (if (<= e-st 0) "H" "h")))
                 (else "?")))
               (e-text
                (if e-fixed
                 (markup #:line (#:roman (#:center-align (#:simple e-show))))
                 (if (eq? e-st -2)
                  (markup #:line (#:roman (#:center-align (#:stradella-underline e-parentaltbass
                       (#:concat (#:simple e-pre #:fontsize -3 (#:raise-scaled 1.25 e-mid) e-post))))))
                  (markup #:line (#:roman (#:center-align
                     (#:concat (#:simple e-pre #:fontsize -3 (#:raise-scaled 1.25 e-mid) e-post)))))
               )))
               (e-object (make-music 'TextScriptEvent
                 'direction up-down
                 'text e-text
                 'tweaks (acons 'stradella-id id e-opt1)
               ))
              )
              (append! es (list e-object))
              (set! text-added #t)
        ))))))
       )
      )
      es
     )
     (if text-added
      (ly:music-set-property! e 'elements es)
   )))
   e))


%§ create the text elements to the stradella music
stradellaStaticTextify =
#(define-music-function (parser location chords-or-bass up-down give-priority text-style m)
                                        (integer?      integer? integer?     string?    ly:music?)
  (music-map (lambda (x) (stradella-textify-static chords-or-bass up-down give-priority text-style x)) m))

#(define (Stradella_staffid_engraver ctx)  
  (let ((id (gensym "_StaffNoSymb")))
     ; This 'id' is to be expected unique, even if some time in the future
     ; the engravers may be started in separate threads.

    `((acknowledgers

       (staff-symbol-interface . ,(lambda (engr grob source-engr)
         (ly:grob-set-property! grob 'stradella-staff-id id)))

       (text-script-interface . ,(lambda (engr grob source-engr)
         ;; whenever a TextScript is acknowledged,
         ;; add it to `scripts´ list,
         ;; but only if it's a stradella text object.
         ;; last but not least, adjust some properties
         ; (display " text-script")
         (let ((stra-class (wa:GtwE-property grob 'stradella-class)))
          ; (display " class = ") (display stra-class)
          (if (not (null? stra-class))
           (ly:grob-set-property! grob 'stradella-staff-id id))))))
 )))

#(define (Stradella_textshift_engraver ctx)  
  (let ((scripts '())
        (note-column #f))

    `((acknowledgers
       (note-column-interface . ,(lambda (engr grob source-engr)
         ;; cache NoteColumn in this (Voice) context
         ; (display " note-column")
         (set! note-column grob)))

       (text-script-interface . ,(lambda (engr grob source-engr)
         ;; whenever a TextScript is acknowledged,
         ;; add it to `scripts´ list,
         ;; but only if it's a stradella text object.
         ;; last but not least, adjust some properties
         ;; (display "\n text-script")
         (let ((stra-class (wa:GtwE-property grob 'stradella-class)))
          ;; (for-each display (list "\n class = " stra-class " "))
          (if (not (null? stra-class))
           (begin
            (set! scripts (cons grob scripts))
            (ly:grob-set-property! grob 'X-offset ly:self-alignment-interface::aligned-on-x-parent)
            (ly:grob-set-property! grob 'self-alignment-X CENTER)
            (ly:grob-set-property! grob 'avoid-slur 'around)
            ; (ly:grob-set-property! grob 'extra-spacing-height (cons +inf.0 -inf.0))
         )))
      )))

      ;(start-translation-timestep . ,(lambda (engr)
      ;  (display "\nEngraver:")
      ;))

      (stop-translation-timestep . ,(lambda (engr)
        ;; if any TextScript grobs exist,
        ;; set NoteColumn as X-parent
        ;(display "; ")
        (and (pair? scripts)
         (for-each (lambda (script)
           (set! (ly:grob-parent script X) note-column))
          scripts))
        ;; clear scripts ready for next timestep
        (set! scripts '()))))))


\layout {
  \context {
    \Voice
    \consists #Stradella_textshift_engraver
  }
  \context {
    \Staff
    \consists #Stradella_staffid_engraver
  }
}

#(define stradella-pre-purge-friends '(AbsoluteDynamicEvent
                                       ApplyContext
                                       ArticulationEvent
                                       BeamEvent
                                       BeamForbidEvent
                                       BreathingEvent
                                       EventChord
                                       GraceMusic
                                       KeyChangeEvent
                                       LineBreakEvent
                                       MarkEvent
                                       MultiMeasureRestMusic
                                       NoteEvent
                                       OverrideProperty
                                       PartialSet
                                       PropertySet
                                       RestEvent
                                       SkipEvent
                                       SlurEvent
                                       SpacingSectionEvent
                                       TieEvent
                                       TimeScaledMusic
                                       TimeSignatureMusic
                                       TextScriptEvent))
#(define stradella-pre-purge-triggers '(BarCheck
                                        ContextSpeccedMusic
                                        SequentialMusic
                                        SimultaneousMusic        ; nicht immer!
                                        VoiceSeparator           ; ???
                                        VoltaRepeatedMusic))

#(define (stradella-pre-purge-contains-trigger-mark e)
  (let ((e-name (ly:music-property e 'name)))
   (if (eq? e-name 'EventChord)
    (let* ((es (ly:music-property e 'elements))
           (twk (ly:music-property e 'tweaks))
           (ns (ly:assoc-get 'stradella-new-section twk #f)))
     (if (and (boolean? ns) (eq? ns #t))
      #t
      (let ((erg #f))
       (for-each (lambda (ese) (let*
          ((etwk (ly:music-property ese 'tweaks))
           (sns (ly:assoc-get 'stradella-new-section etwk #f)))
          (if (and (boolean? sns) (eq? sns #t)) (set! erg #t))
        )) es)
       erg)))
    #f)))

#(define (stradella-pre-purge-is-trigger e)
  (let ((e-name (ly:music-property e 'name)))
   (if (pair? (memq e-name stradella-pre-purge-triggers))
    #t
    (if (stradella-pre-purge-contains-trigger-mark e) #t #f))))

#(define (stradella-pre-purge-is-removable-textobject side e)
  (let ((nm (ly:music-property e 'name)))
   (if (eq? nm 'TextScriptEvent)
    (let* ((e-tweaks (ly:music-property e 'tweaks))
           (e-class (ly:assoc-get 'stradella-class e-tweaks 'undef))
           (e-show (ly:assoc-get 'stradella-show e-tweaks #f)))
     (if (eq? e-class 'chord)
      (if (and (>= side 0) (eq? e-show #f)) #t #f)
      (if (eq? e-class 'bass)
       (if (and (<= side 0) (eq? e-show #f)) #t #f)
       #f)))
    #f)))

#(define (stradella-pre-purge-colorize-textobjects side e)
  (let ((es (ly:music-property e 'elements)))
   (for-each (lambda (ese)
     (if (stradella-pre-purge-is-removable-textobject side ese)
      (let ((e-tweaks (ly:music-property ese 'tweaks)))
       (ly:music-set-property! ese 'tweaks
        (acons 'color (list 1.0 0.0 0.0) e-tweaks)))
    )) es)))

#(define (stradella-pre-purge-textobjects side e)
  (let*
   ((es (ly:music-property e 'elements))
    (new-es (filter (lambda (x)
              (not (stradella-pre-purge-is-removable-textobject side x)))
             es)))
   (if (> (length new-es) 0)
    (ly:music-set-property! e 'elements new-es))))

#(define (stradella-pre-purge-get-ids side e)
  (let ((collector '())
        (es (ly:music-property e 'elements)))
   (for-each (lambda (ese) (let
      ((nm (ly:music-property ese 'name)))
      (if (eq? nm 'TextScriptEvent)
       (let* ((e-tweaks (ly:music-property ese 'tweaks))
              (e-class (ly:assoc-get 'stradella-class e-tweaks 'undef)))
        (if (and (>= side 0) (eq? e-class 'chord))
         (let ((id (ly:assoc-get 'stradella-id e-tweaks "")))
          (set! collector (cons id collector))))
        (if (and (<= side 0) (eq? e-class 'bass))
         (let ((id (ly:assoc-get 'stradella-id e-tweaks "")))
          (set! collector (cons id collector))))))
    )) es)
   (if (> (length collector) 0)
    (string-concatenate (sort-list collector string<?))
    "")))

#(define (stradella-pre-purge-sequential-sections side e)
  (let ((eventtype (ly:music-property e 'name))
        (color-removables (if (defined? 'stradella-pre-purge-coloration)
                           (eq? stradella-pre-purge-coloration #t)
                           #f))
   )
   (if (not (pair? (memq eventtype stradella-pre-purge-friends)))
    (if (not (pair? (memq eventtype stradella-pre-purge-triggers)))
     (ly:warning (locale-string-select '(
        (en . "Eventtype still not classified for use in \\stradellaPrePurge: ~a")
        (de . "Ereignistyp ist für \\stradellaPrePurge nicht klassifiziert: ~a")))
      eventtype)))
   (if (eq? eventtype 'SequentialMusic)
    (begin
     ;; (display "\nprepurging SequentialMusic: ")
     (let
      ((es (ly:music-property e 'elements))
       (last-chord-id "")
       (last-bass-id "")
      )
      (for-each (lambda (x)
        (let ((nm (ly:music-property x 'name)))
         ;; (display "\n   ") (display nm)
         (if (stradella-pre-purge-is-trigger x)
          (begin ;; (display " triggers")
           (if (>= side 0) (set! last-chord-id ""))
           (if (<= side 0) (set! last-bass-id ""))))
         (if (eq? nm 'EventChord)
          (begin
           (if (>= side 0)
            (let ((new-chord-id (stradella-pre-purge-get-ids UP x)))
             (if (> (string-length new-chord-id) 0)
              (if (string=? new-chord-id last-chord-id)
               (if color-removables                           ;; chord should be purged
                (stradella-pre-purge-colorize-textobjects UP x) 
                (stradella-pre-purge-textobjects UP x))
               (set! last-chord-id new-chord-id)))))
           (if (<= side 0)
            (let ((new-bass-id (stradella-pre-purge-get-ids DOWN x)))
             (if (> (string-length new-bass-id) 0)
              (if (string=? new-bass-id last-bass-id)
               (if color-removables                           ;; bass should be purged
                (stradella-pre-purge-colorize-textobjects DOWN x)
                (stradella-pre-purge-textobjects DOWN x))
               (set! last-bass-id new-bass-id)))))))
       )) es))))
   e))

%§ reduce the ocurrences of the stradella text elements based on the bar checks
stradellaPrePurge =
#(define-music-function (parser location side     music)
                                        (integer? ly:music?)
  (music-map (lambda (m) (stradella-pre-purge-sequential-sections side m)) music))

#(define (sort-by-X-coord sys grob-lst) 
"Arranges a list of grobs in ascending order by their X-coordinates" ;©harm6
  (let*
   ((X-coord (lambda (x) (ly:grob-relative-coordinate x sys X))) 
    (comparator (lambda (p q) (< (X-coord p) (X-coord q))))) 
   (sort grob-lst comparator))) 
      
#(define (grob-meta-name grob)
  (let ((meta (ly:grob-property grob 'meta)))
   (ly:assoc-get 'name meta)))

#(define (stradella-group-grob-sequence grob-seq sys staff-id delta)
  (let
   ((erg '())
    (last-X #f)
    (sublist '()))
   (for-each (lambda (grob)
     (let
      ((grob-name (grob-meta-name grob))
       (grob-X (ly:grob-relative-coordinate grob sys X))
       (need-grob #f)
       (new-group #f))
      (if (equal? grob-name 'BarLine)
       (let ((glyph (ly:grob-property grob 'glyph)))
        (if (> (string-count glyph (string->char-set ":S")) 0)
         (set! need-grob #t))))
      (if (equal? grob-name 'VoltaBracket)
       (let ((text (ly:grob-property grob 'text)))
        (if (not (string=? text "1."))
         (set! need-grob #t))))
      (if (equal? grob-name 'TextScript)
       (let
        ((st (ly:grob-property grob 'stradella-class #f))
         (staff-no (ly:grob-property grob 'stradella-staff-id #f)))
        (if (and (not (eq? st #f)) (eq? staff-id staff-no))
         (set! need-grob #t))))
      (if need-grob (begin
        (if (eq? last-X #f)
         (set! new-group #t)
         (if (> (- grob-X last-X) delta)
          (set! new-group #t)
          (set! new-group #f)))
        (if new-group (begin
          (if (not (null? sublist))
           (set! erg (append erg (cons sublist '()))))
          (set! sublist '())))
        (set! sublist (cons grob sublist))
        (set! last-X grob-X))))) 
    grob-seq)
   (if (not (null? sublist))
    (set! erg (append erg (cons sublist '()))))
   erg))

%§ after-line-breaking callback function to remove the repeated stradella texts
#(define ((stradella-cleanup side) base-grob)
  (let*
   ((sys (ly:grob-system base-grob))
    ;;; all grobs on the whole system line
    (elements-lst (ly:grob-array->list (ly:grob-object sys 'all-elements)))
    ;;; stradella-staff-id is put into the 'stradella TextScript grobs' and the 'StaffSymbol grobs'
    ;;;   by the 'Stradella_staffid_engraver' engraver
    (staff-id (ly:grob-property base-grob 'stradella-staff-id))
    ; (count-list '()) ;;; for analysis only
    ;;; In rough (not 100 %) index, if the cleanup is already processed
    (done-id (ly:grob-property base-grob 'stradella-cleaned '()))
    (staff-only-color-removables (ly:grob-property base-grob 'stradella-cleanup-coloration))
    (color-removables (if (boolean? staff-only-color-removables)
                       staff-only-color-removables
                       (if (defined? 'stradella-cleanup-coloration)
                        (eq? stradella-cleanup-coloration #t)
                        #f)))
   )
   ;;;DEBUG (for-each display (list "\nstradella-cleanup for side " side
   ;;;DEBUG   " called via " staff-id " base-grob " base-grob "\n"))
   (if (not (eq? done-id side))
    (let
     ((grob-sequence (sort-by-X-coord sys (filter (lambda (grob)
          (let ((grob-name (grob-meta-name grob)))
           (pair? (member grob-name (list 'TextScript 'BarLine 'VoltaBracket))) ;; auch 'LeftEdge 'VoltaBracketSpanner ?
          )) elements-lst))))
     ;;;DEBUG (for-each display (list "\nexecuting stradella-cleanup for side " side " on " staff-id "\n"))
     ;;; filter out the 'TextScript grobs from other staffs, the 'non stradella TextScript grobs'
     ;;;   and rearrange them into a (sorted) list containing lists for each X-position (in the specified tolerance)
     (let ((grob-listsequence (stradella-group-grob-sequence grob-sequence sys staff-id 0.05)))
      ;;; go on, analize with grobs are redundant, then remove them
      (let
       ((last-chord-id "")
        (last-bass-id ""))
       (for-each (lambda (tick)
         (let
          ((chord-array '())
           (bass-array '())
           (trigger #f))
          (for-each (lambda (grob)
            (let ((gn (grob-meta-name grob)))
             (if (eq? gn 'TextScript)
              (let
               ((scl (ly:grob-property grob 'stradella-class))
                (sid (ly:grob-property grob 'stradella-id))
                (sns (ly:grob-property grob 'stradella-new-section #f)))
               (ly:grob-set-property! grob 'stradella-cleaned side)
               (if (eq? sns #t) (set! trigger #t))
               (if (string? sid)
                (if (eq? scl 'chord)
                 (set! chord-array (cons sid chord-array))
                 (if (eq? scl 'bass)
                  (set! bass-array (cons sid bass-array))))))
              (set! trigger #t)))
           ) tick)
          (if trigger (begin
            (set! last-chord-id "")
            (set! last-bass-id "")))
          (if (and (> (length chord-array) 0) (>= side 0))
           (let ((new-id (string-concatenate (sort-list chord-array string<?))))
            (if (equal? new-id last-chord-id)
             (for-each (lambda (grob)
               (if (eq? (grob-meta-name grob) 'TextScript)
                (if (eq? (ly:grob-property grob 'stradella-class) 'chord)
                 (if (eq? (ly:grob-property grob 'stradella-show #f) #f)
                  (if color-removables
                   (ly:grob-set-property! grob 'color (list 1.0 0.0 1.0))
                   (ly:grob-suicide! grob)))))
              ) tick)
             (set! last-chord-id new-id))))
          (if (and (> (length bass-array) 0) (<= side 0))
           (let ((new-id (string-concatenate (sort-list bass-array string<?))))
            (if (equal? new-id last-bass-id)
             (for-each (lambda (grob)
               (if (eq? (grob-meta-name grob) 'TextScript)
                (if (eq? (ly:grob-property grob 'stradella-class) 'bass)
                 (if (eq? (ly:grob-property grob 'stradella-show #f) #f)
                  (if color-removables
                   (ly:grob-set-property! grob 'color (list 1.0 0.0 1.0))
                   (ly:grob-suicide! grob)))))
              ) tick)
             (set! last-bass-id new-id)))))
        ) grob-listsequence)))))))