\version "2.19.32"

%%%%%%%%%%%%%%%%%%%%%%%%%
%% CUSTOM-GROB-PROPERTY
%%%%%%%%%%%%%%%%%%%%%%%%%

#(define (define-grob-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)
  symbol)
  
#(define my-custom-grob-properties
  `(
    (align-to-melisma ,boolean? "Should LyricText be aligned to other LyricText
being in melisma?")
   ))
   
#(define (acknowledge-my-grob-properties lst)
  (for-each (lambda (x) (apply define-grob-property x)) lst))
    
#(acknowledge-my-grob-properties my-custom-grob-properties)

%%%%%%%%%%%%%%%%%%%%%%%%%
%% ENGRAVER
%%%%%%%%%%%%%%%%%%%%%%%%%

#(define (align-to-melisma-engraver ctx)
"
To be put in Score-context.
Collects all Voices, gets knowledge whether a melisma is active.
If a melisma is active, every selected LyricText's `self-alignment-X' is set to 
the value of `lyricMelismaAlignment' unless `align-to-melisma' is set #f.
Selection is done comparing the stencil-lengths.
"
   (let ((voices '())
         ;; currently not needed:
         ;(lyrics '())
         (lyric-texts '())
         (melisma? #f))
     `(
       (acknowledgers
         (lyric-syllable-interface
          . ,(lambda (engraver grob source-engraver)
               (let* (;; get `lyricMelismaAlignment', this value is used later
                      ;; to set all selected grob's 'self-alignment-X to it
                      (lyric-melisma-alignment 
                        (ly:context-property ctx 'lyricMelismaAlignment))
                      ;; `align-to-melisma?' may be set false, for manual
                      ;; settings 
                      (align-to-melisma? 
                        (ly:grob-property grob 'align-to-melisma #t))
;;;; here the problem starts
;;;; a bunch of stencils is created just to compare their lengths to the actual 
;;;; one, then thrown away :((
;;;; TODO: how to do it different?
;;;;       comparing strings, will fail for markups, markup->string is not 
;;;;       sufficient.
;;;;       But, comparing the stencil-length, as done here, will probably 
;;;;       return false-true for some cases.
;;;;      
;;;;       However, manual inserting other values for`self-alignment-X' is 
;;;;       still possible in combination with `align-to-melisma' set #f
                      (lyric-texts-stencil-x-lengths
                        (sort
                          (map
                            (lambda (e)
                              (interval-length 
                                (ly:stencil-extent 
                                  (grob-interpret-markup grob e) 
                                  X)))
                            lyric-texts)
                            <))
                      (actual-stencil-length
                        (interval-length 
                          (ly:stencil-extent 
                            (ly:grob-property grob 'stencil) 
                            X)))
                      ;; align, when the actual stencil-length is present
                      ;; more than once in `lyric-texts-stencil-x-lengths'
                      ;; TODO find a less clumsy method
                      (should-be-aligned
                        (let ((sub-lst
                                (member 
                                  actual-stencil-length 
                                  lyric-texts-stencil-x-lengths)))
                          (and (not (null? sub-lst))
                               (not (null? (cdr sub-lst)))
                               (= (car sub-lst) (cadr sub-lst))))))
                               
                 ;; align selected grobs
                 (if (and melisma? align-to-melisma? should-be-aligned)
                     (ly:grob-set-property! 
                       grob 'self-alignment-X lyric-melisma-alignment))))))
                  
       (listeners
         ;; get all syllables at current time-step, so `acknowledgers' can work
         ;; on the complete(!) list, which is called `lyric-texts'
         ;; `lyric-texts' will be cleared before moving on to next time-step
         ;; see `stop-translation-timestep'
         (lyric-event
           .
           ,(lambda (engraver event)
              (let ((syllable-text (ly:event-property event 'text)))
                (set! lyric-texts (cons syllable-text lyric-texts)))))
         ;; get all Voices:
         ;; collect all contexts, filter for Voices, 
         ;;    (re-)set local variable `voices'
         ;;
         ;; TODO: `RemoveContext' may be important
         ;;       Test creating/stopping new Voices at different time-steps
         (AnnounceNewContext
           .
           ,(lambda (engraver event)
              (let ((context (ly:event-property event 'context)))
               ;; currently not needed:
               ;(if (eq? (ly:context-name context) 'Lyrics)
               ;    (set! lyrics (cons context lyrics)))
               (if (eq? (ly:context-name context) 'Voice)
                   (set! voices (cons context voices)))))))
                  
       (process-music
        . ,(lambda (trans)
             ;; Get knowledge whether a melisma starts at current time-step.
             ;; Hence look, if one element of `melismaBusyProperties' returns #t
             ;; default for `melismaBusyProperties' is:
             ;;   (list 'melismaBusy
             ;;         'slurMelismaBusy
             ;;         'tieMelismaBusy
             ;;         'beamMelismaBusy
             ;;         'completionBusy)
             (let ((melisma-props 
                     (ly:context-property ctx 'melismaBusyProperties)))
               (for-each
                 (lambda (voice)
                   (for-each 
                     (lambda (prop)
                       (let ((mlsm (ly:context-property voice prop #f)))
                         (if mlsm (set! melisma? #t))))
                     melisma-props))
                 voices))))
                 
       ;; clear `lyric-texts', `melisma?' before moving forward
       (stop-translation-timestep
        . ,(lambda (trans)
             (set! lyric-texts '())
             (set! melisma? #f))))))
             
%% Short-cut:
%% don't align next syllable to a melisma by `align-to-melisma-engraver'
do-not-align-me =
  \once \override LyricText.align-to-melisma = ##f

%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLE
%%%%%%%%%%%%%%%%%%%%%%%%%

my-layout =
  \layout {
    \context {
      \Score
      \consists #align-to-melisma-engraver
      lyricMelismaAlignment = -0.5
    }
  }

one =
  \new Staff 
    \new Voice { 
      c''1( d'') 
      %\set Score.lyricMelismaAlignment = -2.5
      e''( f''2) e''
    }
  \addlyrics { 
    Left __ 
    Left __ 
  }
    
two = 
  \new Staff 
    \new Voice { 
      c''1 
      d'' 
      e'' f''2 e''
    }
  \addlyrics { 
    %% manual setting!
    \once \override LyricText.color = #cyan
    \once \override LyricText.self-alignment-X = #-2
    \do-not-align-me
    Left -- \markup \with-color #green "too!"
    Left too! 
  }
  
three =
  \new Staff
    \new Voice = "3" {
      c'1( d') 
      e'( f')
    }
  \addlyrics {
    very-long-one
    \markup \with-color #green
    "two" 
    three  four
  }
  
four =
  \new Staff
    \new Voice = "4" {
      c'1 d' 
      e' f'
    }
  \addlyrics {
    very-long-one
    \markup \with-color #red "two" 
    three four
  }
  
\score {
  <<
    \three
    \two
    \four
    \one
  >>
  \my-layout
}