Basic grace echo purger

One subtype of the infamous grace synchronisation issue #34 is the ‘grace echo’: if a score-wide collected event comes from at least one voice ‘in time’, while from one or more other voices it comes ‘after the grace notes, which do not exist in this/these voice(s)’, the resulting grob gets created multiple times.

For metronome marks, bar lines, and time signatures a very simple workaround is to delete these echoed grobs, which the engraver in this snippet does. Bar lines and time signatures are checked also for equality and only removed by this engraver if they are identical. Additionally, by setting the grob property keep-grace-echo to #t, you can inhibit this grob removal to obtain special output.

See also snippet Repeat commands grace echo purger, which handles a similar situation for \repeat volta commands.

\version "2.24"

#(define (Basic_grace_echo_purger ctx)
   (let ((last-main-moment -1)
         (current-main-moment -1)
         (barline-found #f)
         (purge-barline #f)
         (last-barline-type '())
         (current-barline-type '())
         (metronomemark-found #f)
         (purge-metronomemark #f)
         (timesignature-found #f)
         (timesignature-style-got '())
         (timesignature-style-found '())
         (timesignature-fraction-found '())
         (purge-timesignature #f)
         ;; Collected items that are eventually handled by
         ;; `ly:grob-suicide!`.
         (grobs-to-delete '()))

     `((acknowledgers
        (bar-line-interface ; `BarLine` and `SpanBar` grobs
         . ,(lambda (trans grob source)
              (let ((keep-this-echo
                     (ly:grob-property grob 'keep-grace-echo #f))
                    (grob-name (grob::name grob)))
                (when (equal? (symbol->string grob-name) "BarLine")
                  (let ((barline-symbol (ly:grob-property grob
                                                          'glyph '())))
                    (when (not (null? barline-symbol))
                      (if (and purge-barline
                               (not keep-this-echo)
                               (equal? last-barline-type
                                       barline-symbol))
                          (begin
                            (ly:grob-set-property! grob 'glyph '())
                            (ly:context-set-property! ctx
                                                      'forbidBreak #t))
                          (begin
                            (set! barline-found #t)
                            (set! current-barline-type
                                  barline-symbol)))))))))

        (metronome-mark-interface
         . ,(lambda (trans grob source)
              (let ((keep-this-echo
                     (ly:grob-property grob 'keep-grace-echo #f)))
                (if (and purge-metronomemark
                         (not keep-this-echo))
                    (set! grobs-to-delete (cons grob grobs-to-delete))
                    (set! metronomemark-found #t)))))

        (time-signature-interface
         . ,(lambda (trans grob source)
              (let ((keep-this-echo
                     (ly:grob-property grob 'keep-grace-echo #f)))
                (if (and purge-timesignature
                         (not keep-this-echo)
                         (equal? timesignature-style-found
                                 (ly:grob-property grob 'style))
                         (equal? timesignature-fraction-found
                                 (ly:context-property
                                  ctx 'timeSignatureFraction)))
                    (set! grobs-to-delete (cons grob grobs-to-delete))
                    (begin
                      (set! timesignature-style-got
                            (ly:grob-property grob 'style))
                      (set! timesignature-found #t))))))
        ) ; end of `acknowledgers` block

       (start-translation-timestep
        . ,(lambda (trans)
             (let* ((now-mom (ly:context-current-moment ctx))
                    (now-main-mom (ly:moment-main now-mom)))
               (set! current-main-moment now-main-mom)
               (if (or
                    ;; Special case for the beginning of music.
                    (and (equal? last-main-moment -1)
                         (equal? now-main-mom 0))
                    ;; Normal case.
                    (equal? last-main-moment now-main-mom))
                   (begin
                     (when barline-found
                       (set! purge-barline #t))
                     (when metronomemark-found
                       (set! purge-metronomemark #t))
                     (when timesignature-found
                       (set! timesignature-fraction-found
                             (ly:context-property ctx
                                                  'timeSignatureFraction))
                       (set! timesignature-style-found
                             timesignature-style-got)
                       (set! purge-timesignature #t)))
                   (begin
                     (set! barline-found #f)
                     (set! purge-barline #f)
                     (set! metronomemark-found #f)
                     (set! purge-metronomemark #f)
                     (set! timesignature-found #f)
                     (set! purge-timesignature #f))))))

       (stop-translation-timestep
        . ,(lambda (trans)
             (for-each ly:grob-suicide! grobs-to-delete)
             (set! grobs-to-delete '())
             (set! last-barline-type current-barline-type)
             (set! last-main-moment current-main-moment)))
       )))

% This function is a copy from `scm/define-grob-properties.scm`.
#(define (define-grob-property symbol type? description)
   (if (not (equal? (object-property symbol 'backend-doc) #f))
       (ly:error (G_ "symbol ~S redefined") symbol))

   (set-object-property! symbol 'backend-type? type?)
   (set-object-property! symbol 'backend-doc description)
   symbol)

% A generic loop to set up grob properties.
#(for-each
  (lambda (x)
    (apply define-grob-property x))
  `((keep-grace-echo
     ,boolean?
     "Do not purge this grob, it is wanted and not the result of
a 'grace note echo' from different voices.")))


% Example.

Music = {
  % Test the `keep-grace-echo` property:
  % \once \override Score.MetronomeMark.keep-grace-echo = ##t
  \tempo "A"
  \partial 4 \tag #'Grace \acciaccatura b8 c'4 |
  \tempo "B"
  \tag #'Grace \acciaccatura b8 c'1 |
  \repeat volta 2 {
    \tag #'Grace \acciaccatura b8 c'1 |
  }
  \tag #'Grace \acciaccatura b8 c'2 \bar ";"
    \tempo "C"
    \tag #'Grace \acciaccatura b8 c'2
    % Test the `keep-grace-echo` property:
    % \once \override Staff.TimeSignature.keep-grace-echo = ##t
    % \once \override Staff.BarLine.keep-grace-echo = ##t
    \bar "||"
  \time 3/4 \tag #'Grace \acciaccatura b8 c'2. \bar "|."
}

% Test: only purge identical bar lines and time signatures.
Appendix = {
  \time 2/4 \grace { s128 \time 3/4 } e'2. |
  \time 4/4 \grace { s128 \numericTimeSignature \time 4/4 } g'1 \bar ";"
  \grace { s128 \bar "S-||" s128 \bar ".." } s128 \bar "|."
}

Group = \new StaffGroup <<
  \new Staff {
    \Music
    % Test_only: \Appendix
  }
  \new Staff {
    \removeWithTag #'Grace \Music
    % Text_only: \Appendix
  }
>>

\layout {
  indent = 0
  ragged-right = ##f
}

\markup { Without \typewriter Basic_grace_echo_purger }
\score {
  \Group
}

\markup { With \typewriter Basic_grace_echo_purger }
\score {
  \Group
  \layout {
    \context {
      \Score
      \consists #Basic_grace_echo_purger
    }
  }
}