\version "2.14.0"

#(define ((connectableStem? xref yref stemone dir below?) stemtwo)
   (cond
    ((not (memq 'stem-interface (ly:grob-interfaces stemtwo))) #f)
    ((equal? stemone stemtwo) #f)
    ((inf? (car (ly:grob-extent stemtwo xref X))) #f)
    ((not (equal? (ly:grob-extent stemone xref X) (ly:grob-extent stemtwo xref X))) #f)
    ((not (equal? dir (ly:grob-property stemtwo 'direction))) #f)
    ((below? (car (ly:grob-extent stemtwo yref Y)) (car (ly:grob-extent stemone yref Y))) #f)
    (else #t)))

#(define ((lowerStem? ref below?) lower upper)
   (below? (car (ly:grob-extent lower ref Y)) (car (ly:grob-extent upper ref Y))))

#(define (crossStaffLength grob ctx stems)
   (let* ((papercolumn (ly:context-property ctx 'currentMusicalColumn))
          (foo (ly:message "papercolumn: ~a" papercolumn))
          (xref (ly:grob-common-refpoint grob (car stems) X))
          (foo (ly:message "xref: ~a" xref))
          (yref (ly:grob-common-refpoint grob (car stems) Y))
          (foo (ly:message "yref: ~a" yref))
          (dir (ly:grob-property grob 'direction))
          (below? (if (= dir UP) < >))
          (foo (ly:message "stems: ~a" stems))
          (goodstems (filter (connectableStem? xref yref grob dir below?) stems))
          (foo (ly:message "stems1: ~a" stems))
          (beststems (sort goodstems (lowerStem? yref below?)))
          (foo (ly:message "stems2: ~a" stems))
          (peer (car (append beststems (list grob))))
          (foo (ly:message "peer: ~a" peer)))
     (ly:message "grob: ~a" (ly:grob-extent grob yref Y))
     (ly:message "peer: ~a" (ly:grob-extent peer yref Y))
     (if (equal? grob peer)
         (begin (ly:programming-error "No suitable stem to connect to") 4)
         (if (> dir 0)
             (* 2 (- (car (ly:grob-extent peer yref Y))
                     (car (ly:grob-extent grob yref Y))))
             (* 2 (- (cdr (ly:grob-extent grob yref Y))
                     (cdr (ly:grob-extent peer yref Y))))))))

#(define (connectStems ctx stems)
   (ly:message "stems: ~a" stems)
   (if (and (pair? stems) (pair? (cdr stems)))
       (let ((stem (car stems))
             (otherstems (cdr stems)))
         (ly:message "otherstems: ~a" otherstems)
         (ly:message "length: ~a"
           (crossStaffLength stem ctx otherstems)))))

#(define (Cross_staff_stem_engraver ctx)
  (let ((stems '()))

    `((acknowledgers
       (stem-interface
        . ,(lambda (trans grob source)
             (ly:message "acknowledger: ~a" grob)
             (set! stems (cons grob stems))))

       (note-column-interface
        . ,(lambda (trans grob source)
             (ly:message "acknowledger: ~a" grob))))

      (process-music
       . ,(lambda (trans) (ly:message "process-music") (connectStems ctx stems)))

      (process-acknowledged
       . ,(lambda (trans) (ly:message "process-acknowledged")))

      (stop-translation-timestep
       . ,(lambda (trans) (ly:message "stop-translation-timestep") (connectStems ctx stems)))

      (finalize
       . ,(lambda (trans) (ly:message "finalize") (connectStems ctx stems))))))

\layout {
  \context {
    \StaffGroup
    \consists #Cross_staff_stem_engraver
  }
}

\new StaffGroup <<
  \new Staff { g' }
  \new Staff { c' }
>>