\version "2.19.82"

#(debug-enable 'debug)

unfrench = #'(
               bass-figure-interface
               chord-name-interface
               cluster-beacon-interface
               fret-diagram-interface
               lyric-syllable-interface
               note-head-interface
               tab-note-head-interface
               lyric-interface
               percent-repeat-item-interface
               percent-repeat-interface
               ;; need this, as stanza numbers are items, and appear only once.
               stanza-number-interface

               multi-measure-rest-interface
               )

% From define-context-properties.scm
#(define (translator-property-description symbol type? description)
   (if (not (and
             (symbol? symbol)
             (procedure? type?)
             (string? description)))
       (throw 'init-format-error))


   (if (not (equal? #f (object-property symbol 'translation-doc)))
       (ly:error (_ "symbol ~S redefined") symbol))

   (set-object-property! symbol 'translation-type? type?)
   (set-object-property! symbol 'translation-doc description)
   (set! all-translation-properties (cons symbol all-translation-properties))
   symbol)


#(translator-property-description 'sharingParts list? "List of consecutive ints, indices of parts sharing this staff.")
#(translator-property-description 'combineNext boolean? "Is it okay for this music to share a staff with the music in the next staff?")

%% modified from lily-library.scm
#(define (split-at-predicate pred lst)
   "Split LST into two lists at the first element that returns #t for
  (PRED element).  Return the two parts as a pair.
  Example: (split-at-predicate odd? '(0 2 3 2 0)) ==> ((0 2 3) . (2 0))"
   (let ((i (and (pair? lst)
                 (list-index pred
                   lst))))
     (if i
         (call-with-values
          (lambda () (split-at lst (1+ i)))
          cons)
         (list lst))))

#(define (rsplit pred lst)
   (let ((splitted (split-at-predicate pred lst)))
     (if (pair? (cdr splitted))
         (cons (car splitted) (rsplit pred (cdr splitted)))
         splitted)))

% #(display (rsplit (lambda (x) (not (cdr x))) '((1 . #f) (2 . #t) (3 . #t))))

Staff_sharing_engraver = #(lambda (ctx)
                            (let* ((all-staves '())
                                   (solo-staves '()))
                              (make-engraver
                               (acknowledgers
                                ((hara-kiri-group-spanner-interface
                                  engraver grob source-engraver)
                                 ; We need an alist of child contexts, but getting them this way
                                 ; means the engraver can't operate on the first measure.
                                 ; Not sure what the proper way to get them is?
                                 (let* (
                                         (child-ctx (ly:translator-context source-engraver))
                                         (child-id (ly:context-id child-ctx))
                                         (child-parts (ly:context-property child-ctx 'sharingParts))
                                         )
                                   (set! all-staves (assoc-set! all-staves child-parts child-ctx))

                                   ; Build alist of just the staves for a single part.
                                   (if (and (eq? 1 (length child-parts))
                                            (not (assoc child-parts solo-staves)))
                                       (set! solo-staves
                                             (merge solo-staves
                                               (acons child-parts child-ctx '())
                                               (lambda (x y) (< (caar x) (caar y)))))))
                                 ))


                               ((process-music translator)
                                (let* (
                                        ; Build alist of index: combineNext value for solo staves
                                        (combine-which-parts (fold-right
                                                              (lambda (kv result)
                                                                (acons (car kv)
                                                                  (ly:context-property (cdr kv) 'combineNext)
                                                                  result))
                                                              '()
                                                              solo-staves))

                                        ; Split the list by which parts can be combined
                                        (split-alist (rsplit
                                                      (lambda (x) (not (cdr x)))
                                                      combine-which-parts))
                                        ; Then just keep the part indices
                                        (groups (map
                                                 (lambda (sublst)
                                                   (map caar sublst))
                                                 split-alist))
                                        ; Use the index lists to select staves
                                        (live-ctxs (if (pair? (car groups))
                                                       (map
                                                        (lambda (k) (assoc-get k all-staves))
                                                        groups)
                                                       '()))
                                        )
                                  ; Set keepAliveInterfaces = '() for all staves
                                  (map (lambda (kv)
                                         (ly:context-set-property! (cdr kv)
                                           'keepAliveInterfaces '()))
                                    all-staves)
                                  ; Set keepAliveInterfaces to the default for just the staves
                                  ; Corresponding to the current part combinations
                                  (map (lambda (ctx)
                                         (ly:context-unset-property ctx 'keepAliveInterfaces))
                                    live-ctxs)
                                  
                                  ; Some code to verify that the engraver is indeed modifying
                                  ; keepAliveInterfaces as intended
                                  (map (lambda (kv)
                                         (display
                                          (cons (car kv)
                                            (pair?
                                             (ly:context-property (cdr kv) 'keepAliveInterfaces))
                                            )))
                                    all-staves)
                                  ))
                               )))

\layout {
  \context {
    \Score
    keepAliveInterfaces = \unfrench
  }
}

\new StaffGroup \with {
  \consists \Staff_sharing_engraver
  combineNext = ##t
  \override VerticalAxisGroup.remove-empty = ##t
  % \consists Keep_alive_together_engraver
} <<
  \new Staff = "1" \with {
    sharingParts = #'(1)
    \override VerticalAxisGroup.remove-layer = 0
    shortInstrumentName = "1"
  } {
    R1*2
    \set Staff.combineNext = ##f
    R1*6
  }
  \new Staff = "2" \with {
    sharingParts = #'(2)
    \override VerticalAxisGroup.remove-layer = 0
    shortInstrumentName = "2"
  } {
    R1*6
    \set Staff.combineNext = ##f
    R1*2
  }
  \new Staff = "3" \with {
    sharingParts = #'(3)
    \override VerticalAxisGroup.remove-layer = 0
    shortInstrumentName = "3"
  } { R1*8 }
  \new Staff = "1+2" \with {
    sharingParts = #'(1 2)
    \override VerticalAxisGroup.remove-layer = 1
    shortInstrumentName = "1 2"
  } { R1*8 }
  \new Staff = "2+3" \with {
    sharingParts = #'(2 3)
    \override VerticalAxisGroup.remove-layer = 1
    shortInstrumentName = "2 3"
  } { R1*8 }
  \new Staff = "1+2+3" \with {
    sharingParts = #'(1 2 3)
    \override VerticalAxisGroup.remove-layer = 2
    shortInstrumentName = "1 2 3"
  } \repeat unfold 8 {
    R1 \break
  }
>>

% Define custom context properties (initialize) — these can just be defined in \with
% Catch changes to combineDown (process-music)
% Nice to have: check if both parts have MMRests, if yes assume combineDown
% Build part lists from combineDown status
% Push property change events into the stream for specific contexts:
% Unset keepAliveInterfaces to corresponding staves, set to #'() for all others