Magnetic lyrics: snap syllables together if the hyphen inbetween is too short

The current code that LilyPond uses to handle lyric hyphens (i.e., LyricHyphen grobs) often leads to very short hyphens or even small gaps between syllables with no hyphen visible. This snippet merges adjacent syllables into one string in such cases, also taking care of ligatures as if the string was not hyphenated.

It supersedes previous implementations of “magnetic snap” engravers that were in circulation via the lilypond-user mailing list.

\version "2.24.0"

% magnetic-lyrics.ily
%
%   written by
%     Jean Abou Samra <jean@abou-samra.fr>
%     Werner Lemberg <wl@gnu.org>
%
% Version 2022-Apr-15

% https://www.mail-archive.com/lilypond-user@gnu.org/msg149350.html

#(define (Left_hyphen_pointer_engraver context)
   "Collect syllable-hyphen-syllable occurrences in lyrics and store
them in properties.  This engraver only looks to the left.  For
example, if the lyrics input is @code{foo -- bar}, it does the
following.

@itemize @bullet
@item
Set the @code{text} property of the @code{LyricHyphen} grob between
@q{foo} and @q{bar} to @code{foo}.

@item
Set the @code{left-hyphen} property of the @code{LyricText} grob with
text @q{foo} to the @code{LyricHyphen} grob between @q{foo} and
@q{bar}.
@end itemize

Use this auxiliary engraver in combination with the
@code{lyric-@/text::@/apply-@/magnetic-@/offset!} hook."
   (let ((hyphen #f)
         (text #f))
     (make-engraver
      (acknowledgers
       ((lyric-syllable-interface engraver grob source-engraver)
        (set! text grob)))
      (end-acknowledgers
       ((lyric-hyphen-interface engraver grob source-engraver)
        (when (not (grob::has-interface grob 'lyric-space-interface))
          (set! hyphen grob))))
      ((stop-translation-timestep engraver)
       (when (and text hyphen)
         (ly:grob-set-object! text 'left-hyphen hyphen))
       (set! text #f)
       (set! hyphen #f)))))

#(define (lyric-text::apply-magnetic-offset! grob)
   "If the space between two syllables is less than the value in
property @code{LyricText@/.details@/.squash-threshold}, move the right
syllable to the left so that it gets concatenated with the left
syllable.

Use this function as a hook for
@code{LyricText@/.after-@/line-@/breaking} if the
@code{Left_@/hyphen_@/pointer_@/engraver} is active."
   (let ((hyphen (ly:grob-object grob 'left-hyphen #f)))
     (when hyphen
       (let ((left-text (ly:spanner-bound hyphen LEFT)))
         (when (grob::has-interface left-text 'lyric-syllable-interface)
           (let* ((common (ly:grob-common-refpoint grob left-text X))
                  (this-x-ext (ly:grob-extent grob common X))
                  (left-x-ext
                   (begin
                     ;; Trigger magnetism for left-text.
                     (ly:grob-property left-text 'after-line-breaking)
                     (ly:grob-extent left-text common X)))
                  ;; `delta` is the gap width between two syllables.
                  (delta (- (interval-start this-x-ext)
                            (interval-end left-x-ext)))
                  (details (ly:grob-property grob 'details))
                  (threshold (assoc-get 'squash-threshold details 0.2)))
             (when (< delta threshold)
               (let* (;; We have to manipulate the input text so that
                      ;; ligatures crossing syllable boundaries are not
                      ;; disabled.  For languages based on the Latin
                      ;; script this is essentially a beautification.
                      ;; However, for non-Western scripts it can be a
                      ;; necessity.
                      (lt (ly:grob-property left-text 'text))
                      (rt (ly:grob-property grob 'text))
                      ;; Append new syllable.
                      (ltrt (if (and (string? lt) (string? rt))
                                (string-append lt rt)
                                (make-concat-markup (list lt rt))))
                      ;; Right-align `ltrt` to the right side.
                      (markup (grob-interpret-markup
                               grob
                               (make-translate-markup
                                (cons (interval-length this-x-ext) 0)
                                (make-right-align-markup ltrt)))))
                 (begin
                   ;; Don't print `left-text`.
                   (ly:grob-set-property! left-text 'stencil #f)
                   ;; Set text and stencil (which holds all collected
                   ;; syllables so far) and shift it to the left.
                   (ly:grob-set-property! grob 'text ltrt)
                   (ly:grob-set-property! grob 'stencil markup)
                   (ly:grob-translate-axis! grob (- delta) X))))))))))


#(define (lyric-hyphen::displace-bounds-first grob)
   ;; Make very sure this callback isn't triggered too early.
   (let ((left (ly:spanner-bound grob LEFT))
         (right (ly:spanner-bound grob RIGHT)))
     (ly:grob-property left 'after-line-breaking)
     (ly:grob-property right 'after-line-breaking)
     (ly:lyric-hyphen::print grob)))


%% demonstration

music = {
  <<
    { d'4 4 4 4 |
      r4 4 4 4 }
    \addlyrics { suf -- fice  baff -- ling 
                 car -- fuff -- ling }
  >>
}

\markup "Without magnetic lyrics:"

\score {
  \music
}

\markup "With magnetic lyrics:"

\score {
  \music

  \layout {
    \context {
      \Lyrics
      \consists #Left_hyphen_pointer_engraver
      \override LyricText.after-line-breaking =
        #lyric-text::apply-magnetic-offset!
      \override LyricHyphen.stencil = #lyric-hyphen::displace-bounds-first
      \override LyricText.details.squash-threshold = 0.4
      \override LyricHyphen.minimum-distance = 0
      \override LyricHyphen.minimum-length = 0.4
      \override LyricSpace.minimum-distance = 1
    }
  }
}

\paper {
  line-width = 92\mm
  ragged-last = ##f
  tagline = ##f
}