\version "2.19.82"

% 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 'combineWithNext boolean? "Is it okay for this music to share a staff with the music in the next staff?")

%%%

#(define (segment pred lst)
   "Segments a list into sublists, such that all elements satisfy pred
    except the last element of each sublist."
   (fold-right
    (lambda (x y)
      (if (and (pred x) (pair? y))
        (cons (cons x (car y)) (cdr y))
        (cons (list x) y)))
    '()
    lst))

% #(display (segment cdr '((1 . #f) (2 . #f) (3 . #f))))

#(define (proper-subset? x y)
   "Is y a proper subset of x?"
   (and (every 
         (lambda (x) x) 
         (map 
          (lambda (ely) (member ely x))
          y))
        (< (length y) (length x))))

Condense_staves_engraver =
#(lambda (ctx)
   (let* ((all-hk-spanners '())
          (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-parts
                (ly:context-property child-ctx 'sharingParts)))
          (set! all-staves
                (assoc-set! all-staves child-parts child-ctx))
          (set! all-hk-spanners
                (assoc-set! all-hk-spanners child-parts grob))

          ; 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: combineWithNext value for solo staves
               (combine-which-parts (fold-right
                                     (lambda (kv result)
                                       (acons (car kv)
                                         (ly:context-property (cdr kv) 'combineWithNext)
                                         result))
                                     '()
                                     solo-staves))

               ; Split the list by which parts can be combined
               ; Then just keep the part indices
               (groups (map
                        (lambda (sublst)
                          (map caar sublst))
                        (segment cdr combine-which-parts)))
               ; Use the index lists to select staves
               (live-ctxs (if (pair? groups)
                              (map
                               (lambda (k) (assoc-get k all-staves))
                               groups)
                              '()))
               )
         (display (ly:context-current-moment ctx))
         ; (display live-ctxs)
         (display 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)))
      
      ((finalize translator)
       (let* ((get-subgroups (lambda (me)
                               (filter
                                (lambda (them)
                                  (proper-subset? (car me) (car them)))
                                all-hk-spanners)))
              (set-my-enemies (lambda (me)
                                (map
                                 (lambda (enemy)
                                   (ly:pointer-group-interface::add-grob
                                    (cdr me) 'make-dead-when (cdr enemy)))
                                 (get-subgroups me)))))
         (map set-my-enemies all-hk-spanners)
         )))))