problem with extending 'magnetic snapping lyrics' engraver

[Werner LEMBERG]

I'm trying to generalize the 'magnetic snapping lyrics' engraver (the
most recent version posted as
https://lists.gnu.org/archive/html/lilypond-user/2019-05/msg00389.html)
by providing a new property `hyphen-formatter`, to be used instead of
the hard-coded `ly:lyric-hyphen::print`.  Attached you can see the
final file together with a diff to the original version (ignoring
whitespace), and an example.  Unfortunately, it doesn't work, and I
can't find the problem: It aborts with

```
ERROR: Wrong type to apply: ()
```

Please advise.


    Werner

\version "2.23.7"

%% CHANGE-LOG harm ()
%%
%% line 52:
%% map becomes for-each
%%
%% line 133:
%% typo in comment
%%
%% lines 234 ff, 260:
%% exclude line-starting LyricHyphen

\header {
  snippet-title = "Magnetic snapping lyric syllables"
  snippet-author = "David Nalesnik, Mike Solomon, harm"
  % snippet-source = 
"http://lists.gnu.org/archive/html/lilypond-user/2014-03/msg00489.html";
  snippet-source = "see 
https://lists.gnu.org/archive/html/lilypond-user/2019-05/msg00388.html";
  snippet-description = \markup {
    This snippet handles lyric syllables that belong to one word together
    and ensures that there are no irritating gaps between them (solves issue 
2458).
  }
  % add comma-separated tags to make searching more effective:
  tags = "lyrics, syllable, gap, hyphen"
  % is this snippet ready?  See meta/status-values.md
  status = "undecided"
}

%%%%%%%%%%%%%%%%%%%%%%%%%%
% here goes the snippet: %
%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%% ADD NEW GROB INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(ly:add-interface
  'lyric-word-interface
  "A word of lyrics. Includes syllables and hyphens."
  '(text-items
    hyphen-formatter))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%% CREATE NEW 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)

%% harm:
#(for-each
  (lambda (x)
    (apply define-grob-property x))

  `(
    (text-items ,list? "Syllables and hyphens of a word of lyrics")
    (hyphen-formatter ,ly:stencil? "Stencil for formatting hyphens")))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%% ADD DEFINITION OF GROB %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(define (add-grob-definition grob-name grob-entry)
   (let* ((meta-entry   (assoc-get 'meta grob-entry))
          (class        (assoc-get 'class meta-entry #f))
          (ifaces-entry (assoc-get 'interfaces meta-entry)))
     (set-object-property! grob-name 'translation-type? ly:grob-properties?)
     (set-object-property! grob-name 'is-grob? #t)
     (set! ifaces-entry (uniq-list (sort ifaces-entry symbol<?)))
     (set! ifaces-entry (cons 'grob-interface ifaces-entry))
     (if class
         (set! meta-entry (assoc-set! meta-entry 'classes (list class))))
     (set! meta-entry (assoc-set! meta-entry 'name grob-name))
     (set! meta-entry (assoc-set! meta-entry 'interfaces
                                  ifaces-entry))
     (set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
     (set! all-grob-descriptions
           (cons (cons grob-name grob-entry)
                 all-grob-descriptions))))

#(add-grob-definition
  'LyricWord
  `(;(stencil . ,ly:lyric-word::print)
    (hyphen-formatter . ,ly:lyric-hyphen::print)
    (meta . ((class . Spanner)
             (interfaces . (lyric-hyphen-interface
                            lyric-word-interface
                            text-interface))))))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(define (add-bound-item spanner item)
   (if (null? (ly:spanner-bound spanner LEFT))
       (ly:spanner-set-bound! spanner LEFT item)
       (ly:spanner-set-bound! spanner RIGHT item)))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ENGRAVER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
collectlyricwordEngraver =
% Collect lyric syllables and hyphens into words. (LyricExtender?)
% The bounds of a LyricWord should be LyricText grobs, when available.
% When a LyricWord consists of a single syllable, the left and right bounds
% should be the same grob.
% When a spanner is broken, the ends not attached to LyricText grobs should
% attach to NonMusicalPaperColumn, as with any spanner.
#(lambda (context)
   (let ((word-bits '()) ; holds syllables and hyphens
         (word '()) ; LyricWord grob we're building
         (collect #f)) ; signal to end word and begin another
     (make-engraver

      (acknowledgers
       ((lyric-syllable-interface engraver grob source-engraver)
        (set! collect #t)
        (set! word-bits (append word-bits (list grob)))
        (if (ly:grob? word)
            (add-bound-item word grob)))
       ((lyric-hyphen-interface engraver grob source-engraver)
        (let* ((props (ly:grob-basic-properties grob))
               (meta (assoc-get 'meta props))
               (name (assoc-get 'name meta)))
          ; don't collect LyricSpace
          ;; harm:
          ; use it as our signal to end or word/start a new one
          (if (eq? name 'LyricSpace)
              (set! collect #f)
              (set! word-bits (append word-bits (list grob)))))))

      ((process-music trans)
       (if (and collect (pair? word-bits))
           (begin
             (if (not (ly:grob? word))
                 (set! word (ly:engraver-make-grob trans 'LyricWord '())))
             ; car should always be a LyricText grob, but maybe a check is in 
order
             (add-bound-item word (car word-bits))
             (for-each
              (lambda (x)
                (ly:pointer-group-interface::add-grob word 'text-items x))
              word-bits)))

       (if (not collect)
           (begin
             (if (ly:grob? word)
                 (begin
                   (if (pair? word-bits)
                       (begin
                         (for-each
                          (lambda (x)
                            (ly:pointer-group-interface::add-grob word 
'text-items x))
                          word-bits)
                         (if (null? (ly:spanner-bound word RIGHT))
                             (ly:spanner-set-bound!
                              word RIGHT
                              (car word-bits)))))
                   (set! word (ly:engraver-make-grob trans 'LyricWord '()))
                   (set! collect #t)))

             (if (not (ly:grob? word))
                 (begin
                   (set! word (ly:engraver-make-grob trans 'LyricWord '()))
                   (if (pair? word-bits)
                       (begin
                         (ly:spanner-set-bound! word LEFT (car word-bits))
                         (for-each
                          (lambda (x)
                            (ly:pointer-group-interface::add-grob word 
'text-items x))
                          word-bits)
                         (if (null? (ly:spanner-bound word RIGHT))
                             (ly:spanner-set-bound! word RIGHT (car 
word-bits)))))
                   (set! word '())))))

       (set! word-bits '())))))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(define (compress-pair formatter syl-a hyphen syl-b threshold)
   (let* ((hyphen-sten (formatter hyphen))
          (hyphen-ex
           (if (ly:stencil? hyphen-sten)
               (ly:stencil-extent hyphen-sten X)
               (cons (/ threshold -2) (/ threshold 2)))))
     (if (> (interval-length hyphen-ex) threshold)
         '() ; no compression--DO NOTHING!

         (let*
             ((syl-a-text (ly:grob-property syl-a 'text))
              (syl-a-text (if (markup? syl-a-text) syl-a-text (markup 
syl-a-text)))
              (syl-b-text (ly:grob-property syl-b 'text))
              (syl-b-text (if (markup? syl-b-text) syl-b-text (markup 
syl-b-text)))
              (full-text (make-concat-markup (list syl-a-text syl-b-text))))

           (set! (ly:grob-property syl-a 'text) full-text)
           (set! (ly:grob-property syl-b 'text) empty-markup)
           (set! (ly:grob-property syl-a 'stencil) lyric-text::print)
           (set! (ly:grob-property syl-b 'stencil) lyric-text::print)
           (set! (ly:grob-property hyphen 'stencil) empty-stencil)))))

#(define (lyric-word-compressor threshold)
   (lambda (grob) ; LyricWord
     (let* ((items (ly:grob-object grob 'text-items))
            (item-list (ly:grob-array->list items)))
       (if (> (length item-list) 1) ; do nothing to monosyllabic words
           (let* ((formatter (ly:grob-property grob 'hyphen-formatter))
                  (text-grobs
                   (filter
                    (lambda (item)
                      (grob::has-interface item 'lyric-syllable-interface))
                    item-list))
                  (hyphen-grobs
                   (filter
                    (lambda (item)
                      (grob::has-interface item 'lyric-hyphen-interface))
                    item-list)))

             (define (helper fmt seed tx-list hy-list)
               (if (and (pair? (cdr tx-list))
                        (pair? hy-list))
                   (let ((next-syl (cadr tx-list))
                         (hyphen (car hy-list)))
                     (compress-pair fmt seed hyphen next-syl threshold)
                     (if (equal? empty-markup (ly:grob-property next-syl 'text))
                         (helper fmt seed (cdr tx-list) (cdr hy-list))
                         (helper fmt (cadr tx-list) (cdr tx-list) (cdr 
hy-list))))))

             ;; harm:
             (define (remove-line-starting-hyphens hyphens)
               (append-map
                (lambda (h)
                  (let* ((orig
                          (if (ly:spanner? h)
                              (ly:grob-original h)
                              #f))
                         (siblings (if (ly:grob? orig)
                                       (ly:spanner-broken-into orig)
                                       '())))

                    (if (pair? siblings)
                        (remove
                         (lambda (sib)
                           (and (pair? siblings)
                                (grob::has-interface
                                 (ly:spanner-bound sib LEFT)
                                 'paper-column-interface)))
                         siblings)
                        (list h))))
                hyphens))

             (helper
              formatter
              (car text-grobs)
              text-grobs
              ;; harm:
              (remove-line-starting-hyphens hyphen-grobs)
              )
             )))))

%%%%%%%%%%%%%%%%%%%%%%%%%%%% SOME OTHER FUNCTIONS 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(define (dim-hack grob ax)
   (let* ((elts (ly:grob-object grob 'text-items))
          (common (ly:grob-common-refpoint-of-array grob elts ax))
          (rel (ly:relative-group-extent elts common ax))
          (off (ly:grob-relative-coordinate grob common ax)))
     (coord-translate rel (- off))))

#(define (height-hack grob)
   (dim-hack grob Y))

#(define (width-hack grob)
   (dim-hack grob X))

#(define (ly:lyric-word::underline grob)
   (let* ((height (height-hack grob))
          (width (width-hack grob)))

     (make-line-stencil 0.1 (car width) 0 (cdr width) 0)))

#(define (ly:lyric-word::boxer grob)
   (let* ((yext (height-hack grob))
          (xext (width-hack grob))
          (thick 0.1))

     (ly:stencil-add
      (make-filled-box-stencil xext (cons (- (car yext) thick) (car yext)))
      (make-filled-box-stencil xext (cons (cdr yext) (+ (cdr yext) thick)))
      (make-filled-box-stencil (cons (cdr xext) (+ (cdr xext) thick)) yext)
      (make-filled-box-stencil (cons (- (car xext) thick) (car xext)) yext))))

wordunderline = \once \override LyricWord.stencil = #ly:lyric-word::underline
wordbox = \once \override LyricWord.stencil = #ly:lyric-word::boxer

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% INITIALIZATION 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\layout {
  \context {
    \Global
    \grobdescriptions #all-grob-descriptions
  }
  \context {
    \Lyrics
    \consists \collectlyricwordEngraver
  }
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% EXAMPLE USAGE 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% layout {
%   \context {
%     \Lyrics
%     \override LyricWord.after-line-breaking = #(lyric-word-compressor 0.5)
%     %% allow arbitrarily small hyphens, which are collected later
%     %% (try to horizontally space out notes as natural as possible)
%     \override LyricHyphen.minimum-distance = #0
%     \override LyricHyphen.minimum-length = #0
%   }
% }

--- magnetic-lyrics.ily.orig    2022-04-03 16:06:42.632467276 +0200
+++ magnetic-lyrics.ily 2022-04-06 07:58:55.229552955 +0200
@@ -35,7 +35,8 @@
 #(ly:add-interface
   'lyric-word-interface
   "A word of lyrics. Includes syllables and hyphens."
-  '(text-items))
+  '(text-items
+    hyphen-formatter))
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
@@ -55,7 +56,8 @@
     (apply define-grob-property x))
 
   `(
-     (text-items ,list? "Syllables and hyphens of a word of lyrics")))
+    (text-items ,list? "Syllables and hyphens of a word of lyrics")
+    (hyphen-formatter ,ly:stencil? "Stencil for formatting hyphens")))
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
@@ -82,6 +84,7 @@
 #(add-grob-definition
   'LyricWord
   `(;(stencil . ,ly:lyric-word::print)
+    (hyphen-formatter . ,ly:lyric-hyphen::print)
      (meta . ((class . Spanner)
               (interfaces . (lyric-hyphen-interface
                              lyric-word-interface
@@ -176,8 +179,8 @@
 
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
-#(define (compress-pair syl-a hyphen syl-b threshold)
-   (let* ((hyphen-sten (ly:lyric-hyphen::print hyphen))
+#(define (compress-pair formatter syl-a hyphen syl-b threshold)
+   (let* ((hyphen-sten (formatter hyphen))
           (hyphen-ex
            (if (ly:stencil? hyphen-sten)
                (ly:stencil-extent hyphen-sten X)
@@ -203,7 +206,8 @@
      (let* ((items (ly:grob-object grob 'text-items))
             (item-list (ly:grob-array->list items)))
        (if (> (length item-list) 1) ; do nothing to monosyllabic words
-           (let* ((text-grobs
+           (let* ((formatter (ly:grob-property grob 'hyphen-formatter))
+                 (text-grobs
                    (filter
                     (lambda (item)
                       (grob::has-interface item 'lyric-syllable-interface))
@@ -214,15 +218,15 @@
                       (grob::has-interface item 'lyric-hyphen-interface))
                     item-list)))
 
-             (define (helper seed tx-list hy-list)
+             (define (helper fmt seed tx-list hy-list)
                (if (and (pair? (cdr tx-list))
                         (pair? hy-list))
                    (let ((next-syl (cadr tx-list))
                          (hyphen (car hy-list)))
-                     (compress-pair seed hyphen next-syl threshold)
+                     (compress-pair fmt seed hyphen next-syl threshold)
                      (if (equal? empty-markup (ly:grob-property next-syl 
'text))
-                         (helper seed (cdr tx-list) (cdr hy-list))
-                         (helper (cadr tx-list) (cdr tx-list) (cdr 
hy-list))))))
+                         (helper fmt seed (cdr tx-list) (cdr hy-list))
+                         (helper fmt (cadr tx-list) (cdr tx-list) (cdr 
hy-list))))))
 
              ;; harm:
              (define (remove-line-starting-hyphens hyphens)
@@ -248,6 +252,7 @@
                 hyphens))
 
              (helper 
+              formatter
               (car text-grobs) 
               text-grobs 
               ;; harm:

\version "2.23.7"

\include "magnetic-lyrics.ily"

<<
  \new Voice = "foo" \relative c' {
    \repeat unfold 16 { a8 b a2 a8 b }
  }
  \new Lyrics \lyricsto "foo" {
    \override Lyrics.LyricWord.after-line-breaking =
      #(lyric-word-compressor 0.5)
    \override Lyrics.LyricHyphen.minimum-distance = #0
    \override Lyrics.LyricSpace.minimum-distance = #1
    \repeat unfold 10 { foo }
    \repeat unfold 10 { foo -- \markup \caps bar }
    \repeat unfold 10 { \markup \bold syl -- la -- ble }
    a \markup \with-color #red ran -- \markup \box dom string of mo -- no -- 
syl -- la -- bic
    and mul -- ti -- \markup \fontsize #5 syl -- la -- bic
    \markup \bold \underline ver -- \markup \italic bi -- age
    \markup {
      \stencil #(make-circle-stencil 0.5 0 #f)
    }
  }
>>