Extracting unmodified fragments of a music expression

This snippet provides an \extractMusic function that can be used as follows:

\extractMusic music from during

For example, in the second Staff of the score below, the following has been used :

\extractMusic \music s1 s1*2

This has kept the music beginning after the first measure (i.e., at the second measure) for two measures.
All data (notes, scripts, dynamics and various \overrides) outside this range have been deleted.

Note that this function should also work with multiple voices, \repeat structures etc.

A full and updated version of \extractMusic can be found here. There are some additional useful features and other enhancement functions on that page, with a description of each of them in a small document (in pdf format) with multiple voices, \repeat structures etc.

\version "2.24.0"

%% http://lsr.di.unimi.it/LSR/Item?id=542


#(use-modules (srfi srfi-39))

#(define *current-moment* (make-parameter (ly:make-moment 0/1 0/1)))

#(define moment-null (ly:make-moment 0/1 0/1))

#(define (music-has-no-length? music)
  "Is music empty of notes, rests or skips?"
  (equal? (ly:music-length music) moment-null))

#(define (simultaneous? music)
  (memq (ly:music-property music 'name)
    (list 'SimultaneousMusic 'EventChord)))

#(define (defined-music? music)
  (not (eq? 'Music (ly:music-property music 'name))))

#(define (chord-event? music)
  (eq? 'EventChord (ly:music-property music 'name)))

#(define (get-duration music)
  (ly:music-property music 'duration))

#(define (moment>=? momentA momentB)
  (not (ly:moment<? momentA momentB)))

#(define (moment-inside? moment from-moment to-moment)
  (and
    (moment>=? moment from-moment)
    (ly:moment<? moment to-moment)))

#(define (whole-music-inside? begin-music end-music left-range right-range)
  (and
    (moment>=? begin-music left-range)
    (moment>=? right-range end-music )
    (not (equal? begin-music right-range))))

#(define (whole-music-outside? begin-music end-music left-range right-range)
  (or
    (moment>=? left-range end-music)
    (moment>=? begin-music right-range)))

#(define (moment->duration moment)
  ;see duration.cc in Lilypond sources (Duration::Duration)
  (let* ((p (ly:moment-main-numerator moment))
         (q (ly:moment-main-denominator moment))
         (k (- (ly:intlog2 q) (ly:intlog2 p)))
         (dots 0))
   ;(ash p k) = p * 2^k
   (if (< (ash p k) q) (set! k (1+ k)))
   (set! p (- (ash p k) q))
   (while (begin (set! p (ash p 1))(>= p q))
    (set! p (- p q))
    (set! dots (1+ dots)))
   (if (> k 6)
    (ly:make-duration 6 0)
    (ly:make-duration k dots))
))

#(define (extract-music music from to)
  "Keeps only music between `from' and `to', `from' and `to' as moment"
  (let ((begin-pos (*current-moment*))
        (end-pos (ly:moment-add
                   (*current-moment*)
                   (ly:music-length music))))
   (cond
    ((whole-music-inside? begin-pos end-pos from to)
      (*current-moment* end-pos)
      music)
    ((whole-music-outside? begin-pos end-pos from to)
      (*current-moment* end-pos)
      (make-music 'Music))
    ; the intervals [begin-pos end-pos] [from to] overlap
    (else
    (cond
    ; inside a chords or for multiRest events
    ((ly:duration? (get-duration music))
      (if (moment-inside? begin-pos from to)
        (set! end-pos to)
        (begin
          (set! begin-pos from)
          (if (not (moment-inside? end-pos from to))(set! end-pos to))))
      (ly:music-set-property! music 'duration 
          (moment->duration  (ly:moment-sub end-pos begin-pos)))
      (*current-moment* end-pos)
      music)
    (else     ; for containers of chords
      (let ((elts (ly:music-property music 'elements))
          (elt  (ly:music-property music 'element)))
        (if (ly:music? elt)
        (ly:music-set-property! music 'element (extract-music elt from to)))
        (if (pair? elts) 
        (cond  
          ((simultaneous? music)    ; simultaneous music OR EventChords
          (ly:music-set-property! music 'elements (filter
            (lambda (evt)
              (or (music-has-no-length? evt) ; i.e for 'VoiceSeparator
                (begin
                  (*current-moment* begin-pos)  ; restore *current-moment*
                  (set! evt (extract-music evt from to))
                  (defined-music? evt)))) ; keeps if not (make-music 'Music)
            elts))
          (*current-moment* end-pos))
         (else              ; sequential music
          (ly:music-set-property! music 'elements (filter
            (lambda (evt)
              (set! evt (extract-music evt from to))
              (defined-music? evt))
            elts)))))
        music)))))))

%%%%%%%%%%%%%%%%%%%%%% the main function %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
extractMusic =
#(define-music-function (music from during) (ly:music? ly:music? ly:music?)
  (let* ((from-length (ly:music-length from))
         (during-length (ly:music-length during))
         (to-length (ly:moment-add during-length from-length)))
    (parameterize ((*current-moment* (ly:make-moment 0/1 0/1)))
                  (extract-music music from-length to-length))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

music = \relative c' {
  \override Staff.NoteHead.color = #blue
  <c e>4-- d\< \tuplet 3/2 { e8 f g } a8^"a text" c\!
  b8 c b a^"another text" << { g4 f8 e } \\ { e4 d8 c } >>
  \override Voice.NoteHead.color = #green
  d2 g
  \override Voice.NoteHead.color = #red
  g16 a g f e8 d c2
}

\score {
  <<
    \new Staff \new Voice {
      \music
      c'1
    } 
    \new Staff \new Voice {
      s1
      \extractMusic \music  s1 s1*2
      s1
      c'1
    }
  >>
}