\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 strings from @code{markup->string}, if @code{""}
is returned, stencil-lengths are used for comparison.
"
   (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))
                      ;; try to get useful strings from `lyric-texts' for
                      ;; comparison.
                      ;; If any "" is returned, pure string-comparison is not
                      ;; sufficient and we have to use stencil-length-comparison
                      ;; as fall-back later.
                      (string-lyrics-list
                        (map (lambda (t) (markup->string t)) lyric-texts))
                      (any-null-string?
                        (any string-null? string-lyrics-list))
                      ;; try to get useful string from 'text
                      ;; nb this may return ""
                      (actual-text-string
                        (markup->string (ly:grob-property grob 'text)))
                      ;; if the `actual-text-string' is returned more than once,
                      ;; this returns #t, i.e. lyric-syllables may be aligned.
                      (string-lyr-should-be-aligned?
                        (>=
                            (length
                              (filter 
                                (lambda (t) (equal? t actual-text-string))
                                string-lyrics-list))
                            2)))
                            
             (if (and melisma? align-to-melisma?)
                 (cond ((and
                          (not any-null-string?)
                          string-lyr-should-be-aligned?)
                        (ly:grob-set-property! 
                          grob 'self-alignment-X lyric-melisma-alignment))
                       ;; if `lyric-texts' contains "", we fall-back to
                       ;; compare stencil-lengths
                       ;; nb this may result in false postive selection
                       ;; and will create several stencil, which are thrown away
                       ;; not nice, maybe the best we can do, though
                       (any-null-string?
                        (let* ((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))))))
                          (if 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
    }
  }

  
%%%% 0NE 

one =
  \new Staff \with { instrumentName = "I " }
    \new Voice { 
      c''1( d'') 
      e''1( f''2) 
      %\once \set Score.lyricMelismaAlignment = -3.5
      e''(
      f''1)
    }
  \addlyrics { 
    Left __ 
    double-two
    \markup 
      \scale #'(0.6 . 0.6) 
      \score { 
        \new Staff { e''4 d''8 e''  } 
        \layout { \omit Staff.TimeSignature } 
      }
  }
  
%%%% TWO

two = 
  \new Staff \with { instrumentName = "II " }
    \new Voice { 
      c''1 
      _\markup 
         \fontsize #-6 
         \column { 
           "cyan \"Left\" is manually"
           "excluded from being aligned"
           "and other value is used"
         }
      d'' 
      e''1 f''2 e''
      f''1
    }
  \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! 
    \markup 
      \scale #'(0.6 . 0.6) 
      \score { 
        \new Staff { e''4 d''8 e''  } 
        \layout { \omit Staff.TimeSignature } 
      }
    bubble
  }
  
%%%% THREE
  
three =
  \new Staff \with { instrumentName = "III " }
    \new Voice = "3" {
      c'1( d') 
      e'1( f')
      e'1
    }
  \addlyrics {
    very-long-one
    \markup \with-color #green
    two
    three
  }
  
%%%% FOUR
  
four =
  \new Staff \with { instrumentName = "IV " }
    \new Voice = "4" {
      c'1 d' 
      e'1 f'
      g'1
    }
  \addlyrics {
    very-long-one
    two
    \markup \italic \bold \with-color #blue 
    double-two 
    four
    bubble
  }
  
\score {
  <<
    \one
    \two
    \three
    \four
  >>
  \layout { \my-layout }
}