\version "2.19.25"

% TODO: rename malte-length and malte-abs-time?
% TODO: rename replace-all-in-all?

% adds property 'malte-length to all music
add-length =
#(define-music-function (music) (ly:music?)
   (music-map
    (lambda (m)
      (ly:music-set-property! m 'malte-length (ly:music-length m))
      m)
    music))

% adds property 'malte-abs-time (time since beginning) to all music
add-abs-time =
#(define-music-function (music) (ly:music?)
   (let loop ((cur-time (ly:make-moment 0))
              (music music))
     (ly:music-set-property! music 'malte-abs-time cur-time)
     (cond
      ((music-is-of-type? music 'music-wrapper-music)
       (loop cur-time (ly:music-property music 'element))
       music)
      ((music-is-of-type? music 'simultaneous-music)
       (map
        (lambda (element)
          (loop cur-time element))
        (ly:music-property music 'elements))
       music)
      ((music-is-of-type? music 'sequential-music)
       (map
        (lambda (element)
          (loop cur-time element)
          (set! cur-time (ly:moment-add cur-time (ly:music-property element 'malte-length))))
        (ly:music-property music 'elements))
       music)
      (else
       music))))

% extracts music between begin-moment (inclusive) and end-moment (exclusive),
% correctly extracting only parts of quotes (but not yet other wrappers like tuplets)
extract-music-between =
#(define-music-function (begin-moment end-moment original-music) (ly:moment? ly:moment? ly:music?)
   (let ((music (ly:music-deep-copy original-music))) ; TODO: deep-copy necessary?
     (let loop ((music music))
       (cond
        ((eq? (ly:music-property music 'name) 'QuoteMusic)
         (let* ((quote-begin (ly:music-property music 'malte-abs-time))
                (quote-end (ly:moment-add quote-begin (ly:music-property music 'malte-length)))
                (shortened? #f))
           (if (ly:moment<? quote-begin begin-moment)
               (begin
                (set! quote-begin begin-moment)
                (set! shortened? #t)))
           (if (ly:moment<? end-moment quote-end)
               (begin
                (set! quote-end end-moment)
                (set! shortened? #t)))
           (if shortened?
               (let ((newdur (ly:moment-sub quote-end quote-begin)))
                 (ly:music-set-property! music 'element
                   (make-music 'SkipEvent
                     'duration (make-duration-of-length newdur)))
                 (ly:music-set-property! music 'malte-abs-time quote-begin)
                 (ly:music-set-property! music 'malte-length newdur)))
           music))
        ((music-is-of-type? music 'music-wrapper-music) ; wrapper except QuoteMusic
          (loop (ly:music-property music 'element))
          (ly:music-set-property! music 'malte-length (ly:music-length music))
          (ly:music-set-property! music 'malte-abs-time
            (ly:music-property (ly:music-property music 'element) 'malte-abs-time))
          music)
        ((music-is-of-type? music 'simultaneous-music) ; TODO: shorten?
          (map loop
            (ly:music-property music 'elements))
          music)
        ((music-is-of-type? music 'sequential-music)
         (ly:music-set-property! music 'elements
           (drop-while (lambda (element)
                         (and
                          (ly:moment<? (ly:music-property element 'malte-abs-time) begin-moment)
                          (not (and
                                ;(eq? (ly:music-property element 'name) 'QuoteMusic)
                                (ly:moment<? begin-moment (ly:moment-add
                                                           (ly:music-property element 'malte-abs-time)
                                                           (ly:music-property element 'malte-length)))))))
             (take-while (lambda (element)
                           (ly:moment<? (ly:music-property element 'malte-abs-time) end-moment))
               (ly:music-property music 'elements))))
         (let ((elements (ly:music-property music 'elements)))
           (map loop elements)
           (ly:music-set-property! music 'malte-abs-time
             (ly:music-property (car elements) 'malte-abs-time)))
         (ly:music-set-property! music 'malte-length (ly:music-length music))
         music)
        (else ; TODO?
          music)))))

% replaces \quoteDuring #name by extracted music from original-quoted
replace-one-in-one =
#(define-music-function (name original-quoted original-quoting) (string? ly:music? ly:music?)
   (let ((quoting (ly:music-deep-copy original-quoting)) ; TODO: deep-copy necessary?
          (quoted (ly:music-deep-copy original-quoted))) ; TODO: deep-copy necessary?
     (music-map
      (lambda (m)
        (if (and
             (eq? (ly:music-property m 'name) 'QuoteMusic)
             (equal? (ly:music-property m 'quoted-music-name) name))
            (ly:music-transpose ; TODO: don’t transpose if quoted-transposition is c'?
              (extract-music-between
               (ly:music-property m 'malte-abs-time)
               (ly:moment-add
                (ly:music-property m 'malte-abs-time)
                (ly:music-property m 'malte-length))
               quoted)
              (ly:music-property m 'quoted-transposition (ly:make-pitch 0 0 0))) ; default: c'
            m))
      quoting)))

% (string? . ly:music?)
#(define (quote-list-entry? entry)
   (and
    (pair? entry)
    (string? (car entry))
    (ly:music? (cdr entry))))

% list of (string? . ly:music?)
#(define (quote-list? thelist)
   (and
    (list? thelist)
    (every quote-list-entry? thelist)))

% list of string?
#(define (string-list? thelist)
   (and
    (list? thelist)
    (every string? thelist)))

replace-all-in-all-helper =
#(define-syntax-function quote-list? (names everything) (string-list? quote-list?)
   (if (null? names)
       everything
       (replace-all-in-all-helper (cdr names)
         (map
          (lambda (element)
            (cons
             (car element)
             (replace-one-in-one (car names) (assoc-ref everything (car names)) (cdr element))))
          everything))))

% replaces all occurences of \quoteDuring #name by real music
replace-all-in-all =
#(define-syntax-function ly:music-list? (everything) (quote-list?)
   (map cdr (replace-all-in-all-helper (map car everything) everything)))

% global alist containing (name . music) pairs, to be filled by new \addQuote
#(define quotes-alist '())

% doesn’t use (add-quotable …) but only serves my purpose
addQuote =
#(define-void-function (name music) (string? ly:music?)
   (set! quotes-alist
         (cons
          (cons name (add-abs-time (add-length music)))
          quotes-alist)))

% This (re)defines music variables. The user has to take care of possible
% variable name changes. For example, if something like
%   \addQuote "bsn" \bassoon
% is used, the new variable bsn contains the replaced quotes, not bassoon.
% Another side effect (when using alignTo.ily): If you have something like
%   \addQuote "bassoon" \alignTo \global \bassoon
% you now have to use
%   << \global \bassoon >>
% instead of
%   \useAndAlignTo \global \bassoon
% because bassoon is now already aligned (and \bassoon instead of
% \alignTo \bassoon).

replaceQuotes =
#(define-void-function () ()
   (let ((replaced-quotes-list (replace-all-in-all quotes-alist)))
     (for-each
      (lambda (element-qal element-rql)
        (ly:parser-define! (string->symbol (car element-qal)) element-rql))
      quotes-alist
      replaced-quotes-list)))