Editing Alternate \textSpanner engraver

LilyPond's default text spanner engraver can only handle a single text spanner per voice at a time.  The engraver in this snippet provides an alternate implementation to circumvent this limitation; it uses spanner IDs to specify start and end of overlapping text spanners.

To use it, replace <code>Text_spanner_engraver</code> with <code>\alternateTextSpannerEngraver</code>.  The example below demonstrates two possible ways to specify a spanner ID: either define a new command or use the <code>\=</code> command to directly set the ID.

To control the vertical order of text spanners, use the standard way of tweaking the <code>outside-staff-priority</code> property.

<lilypond version="2.24">
% LSR written by Dave Nalesnik
% LSR https://lists.gnu.org/archive/html/lilypond-user/2026-01/msg00006.html

% Incorporating some code from the rewrite in Scheme of
% Text_spanner_engraver in input/regression/scheme-text-spanner.ly

#(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)))

#(define (set-axis! grob axis)
   (when (not (number? (ly:grob-property grob 'side-axis)))
     (set! (ly:grob-property grob 'side-axis) axis)
     (ly:grob-chain-callback
      grob
      (if (eq? axis X)
          ly:side-position-interface::x-aligned-side
          side-position-interface::y-aligned-side)
      (if (eq? axis X)
	  'X-offset
	  'Y-offset))))

#(define (assign-spanner-index orig-ls)
   "Determine an available position of a new spanner in an ordered
sequence of spanners (a list of pairs, where the car of the pair
gives the position).  The goal is for the sequence to begin with
zero and contain no gaps.  Return the index representing the
spanner's position.

Examples (only showing the cars of the pairs):

  (0 1)   => 2
  (2 3)   => 0
  (0 3)   => 1
  (0 1 3) => 2
"
   (if (null? orig-ls)
       0
       (let loop ((ls orig-ls)
		  (insert? #t)
		  (result 0))
         (cond
          ((null? ls)
	   result)
          ;; Position at head of list.
          ((and insert? (> (caar orig-ls) 0))
           (loop ls #f 0))
          ;; No gaps, put at end of list.
          ((and insert? (null? (cdr ls)))
           (loop (cdr ls) #f (1+ (caar ls))))
          ;; Fill lowest position of gap.
          ((and insert?
                (> (caadr ls) (1+ (caar ls))))
           (loop (cdr ls) #f (1+ (caar ls))))
          (else
	   (loop (cdr ls) insert? result))))))

alternateTextSpannerEngraver =
#(lambda (context)
   (let (;; A list of pairs comprising a spanner index (not
	 ;; `spanner-id` values) and a spanner which has been begun.
         (spanners '())
         (finished '()) ; A list of spanners in completion stage.
         (start-events '()) ; A list of START events.
         (stop-events '())) ; A list of STOP events.
     (make-engraver
      ;; `\startTextSpan`, `\stopTextSpan`, and the like create
      ;; events which we collect here.
      (listeners
       ((text-span-event engraver event)
        (if (= START (ly:event-property event 'span-direction))
            (set! start-events (cons event start-events))
            (set! stop-events (cons event stop-events)))))

      ;; Populate `note-columns` property of spanners.  Bounds are
      ;; set to note columns, and each spanner keeps a record of
      ;; the note columns it traverses.
      (acknowledgers
       ((note-column-interface engraver grob source-engraver)
        (for-each (lambda (s)
                    (ly:pointer-group-interface::add-grob
                     (cdr s) 'note-columns grob)
                    (when (null? (ly:spanner-bound (cdr s) LEFT))
                      (add-bound-item (cdr s) grob)))
		  spanners)
        ;; `finished` only contains spanners, no indices.
        (for-each (lambda (f)
                    (ly:pointer-group-interface::add-grob
                     f 'note-columns grob)
                    (when (null? (ly:spanner-bound f RIGHT))
                      (add-bound-item f grob)))
		  finished)))

      ((process-music trans)
       ;; Move begun spanners from `span` to `finished`.  We do
       ;; this on the basis of `spanner-id`.  If we find a match
       ;; -- either the strings are the same, or both are unset --
       ;; a transfer can be made.  Return a warning if we find no
       ;; match: spanner hasn't been properly begun.
       (for-each
        (lambda (es)
          (let ((es-id (ly:event-property es 'spanner-id)))
            (let loop ((sp spanners))
              (if (null? sp)
                  (ly:warning "No spanner to end!")
                  (let ((sp-id (ly:event-property
                                (event-cause (cdar sp))
				'spanner-id)))
                    (cond
                     ((equal? sp-id es-id)
                      (set! finished (cons (cdar sp) finished))
                      (set! spanners
			    (remove (lambda (s)
				      (eq? s (car sp))) spanners)))
                     (else
		      (loop (cdr sp)))))))))
        stop-events)

       ;; The end of our spanners can be acknowledged by other
       ;; engravers, thus announce them.
       (for-each
        (lambda (f)
          (ly:engraver-announce-end-grob trans f (event-cause f)))
        finished)

       ;; Make spanners in response to START events.
       ;;
       ;; Each new spanner is assigned an index denoting its
       ;; position relative to other active spanners.  This is
       ;; enforced (for the moment) by adding a small amount to
       ;; the spanner's `outside-staff-priority` proportional to
       ;; this index.  This is unlikely to result in conflicts,
       ;; though a better solution may be to organize the spanners
       ;; by a new alignment grob.
       ;;
       ;; Also, add any existing spanners to the
       ;; `side-support-elements` array of the new spanner.  This
       ;; ensures correct ordering over line breaks when
       ;; `outside-staff-priority` is set to `#f` (which means
       ;; that it is no longer an outside-staff object -- not the
       ;; default).
       (for-each
        (lambda (es)
          (let* ((new (ly:engraver-make-grob
		       trans 'TextSpanner es))
                 (new-idx (assign-spanner-index spanners))
                 (new-osp (ly:grob-property
			   new 'outside-staff-priority))
                 (new-osp (if (number? new-osp)
                              (+ new-osp (/ new-idx 1000.0))
                              new-osp)))
            (set! (ly:grob-property
		   new 'outside-staff-priority) new-osp)
            (set-axis! new Y)
            ;; Add spanners with a lower index than the new
            ;; spanner to its `side-support-elements` list.  This
            ;; allows new spanners to fill gaps under the topmost
            ;; spanner.
            (for-each (lambda (sp)
			(when (< (car sp) new-idx)
			  (ly:pointer-group-interface::add-grob
			   new 'side-support-elements (cdr sp))))
		      spanners)
            (set! spanners (cons (cons new-idx new) spanners))
            (set! spanners
                  (sort spanners (lambda (x y)
				   (< (car x) (car y)))))))
        start-events)

       ;; Events have served their purpose for this timestep.
       ;; Clear the way for new events in later timesteps.
       (set! start-events '())
       (set! stop-events '()))

      ((stop-translation-timestep trans)
       ;; Set bounds of spanners to `PaperColumns` grobs if they
       ;; haven't been set.  This allows spanners to be drawn
       ;; between spacers.
       ;;
       ;; Other uses?  Doesn't appear to affect whether spanners
       ;; can de drawn between rests.
       (for-each (lambda (s)
		   (when (null? (ly:spanner-bound (cdr s) LEFT))
		     (ly:spanner-set-bound!
		      (cdr s) LEFT
		      (ly:context-property context
					   'currentMusicalColumn))))
		 spanners)
       (for-each (lambda (f)
		   (when (null? (ly:spanner-bound f RIGHT))
		     (ly:spanner-set-bound!
		      f RIGHT
		      (ly:context-property context
					   'currentMusicalColumn))))
		 finished)
       (set! finished '()))

      ((finalize trans)
       ;; If spanner ends on spacer at end of context?
       (for-each (lambda (f)
                   (when (null? (ly:spanner-bound f RIGHT))
                     (ly:spanner-set-bound!
		      f RIGHT
                      (ly:context-property context
					   'currentMusicalColumn))))
		 finished)
       (set! finished '())
       ;; User didn't end spanner.
       (for-each (lambda (sp)
		   (ly:warning "incomplete spanner removed!")
		   (ly:grob-suicide! (cdr sp)))
		 spanners)
       (set! spanners '())))))


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

startTextSpanOne =
#(make-music 'TextSpanEvent 'span-direction START 'spanner-id "1")
stopTextSpanOne =
#(make-music 'TextSpanEvent 'span-direction STOP 'spanner-id "1")
startTextSpanTwo =
#(make-music 'TextSpanEvent 'span-direction START 'spanner-id "2")
stopTextSpanTwo =
#(make-music 'TextSpanEvent 'span-direction STOP 'spanner-id "2")

\layout {
  \context {
    \Voice
    \remove #"Text_spanner_engraver"
    \consists \alternateTextSpannerEngraver
  }
}

\relative c' {
  \override TextSpanner.style = ##f
  \override TextSpanner.thickness = 10
  % \override TextSpanner.to-barline = ##t

  a4 \tweak color #red \startTextSpan
    b \tweak color #green \startTextSpanOne
    c \tweak color #blue \startTextSpanTwo
    d \=3\startTextSpan |
  a4\stopTextSpan
    b \stopTextSpanOne
      \tweak color #red \startTextSpan
    c \stopTextSpanTwo
      \tweak color #green \startTextSpanOne
    d \=3\stopTextSpan
      \tweak color #blue \startTextSpanTwo |
  a4 \=3\startTextSpan
    b c d | \break

  a4 b c d |
  a4\stopTextSpan
    \stopTextSpanOne
    \stopTextSpanTwo
    \=3\stopTextSpan
    b 
    c \startTextSpan
    d \tweak outside-staff-priority #0 \=1\startTextSpan |
  a4 b
    c \=1\stopTextSpan
    d \stopTextSpan |
}
</lilypond>

[[Category:Contexts and engravers]]
[[Category:Editorial annotations]]
[[Category:Expressive marks]]
[[Category:Scheme]]
[[Category:Workaround]]
[[Category:Snippet]]