\version "2.14.2"

#(define (grobParentByInterface grob intf axis)
   (if (memq intf (ly:grob-interfaces grob))
       grob
       (grobParentByInterface (ly:grob-parent grob axis) intf axis)))

#(define (extent-combine extents)
   (if (pair? (cdr extents))
       (interval-union (car extents) (extent-combine (cdr extents)))
       (car extents)))

#(define (crossStaffLength grob)
   (let* ((papercolumn (grobParentByInterface grob 'paper-column-interface X))
          (elementarray (ly:grob-object papercolumn 'elements))
          (yref (ly:grob-common-refpoint-of-array grob elementarray Y))
          (elements (ly:grob-object grob 'spanned-stems))
          (extents (map (lambda (x) (ly:grob-extent x yref Y)) elements))
          (foo (ly:message "extents: ~a" extents))
          (maxextent (extent-combine extents))
          (foo (ly:message "maxextent: ~a" maxextent))
          (length (- (car maxextent) (cdr maxextent))))
     length))

#(define (stemSpanStencil grob)
   (let* ((length (crossStaffLength grob)))
     (make-filled-box-stencil '(0.2 . 0.4) (cons 0 length))))

#(define (reparentStems ctx stems trans)
   (if (and (pair? stems) (pair? (cdr stems)))
       (let* ((stem (car stems))
              (parent (ly:grob-parent stem Y))
              (new-stem (ly:engraver-make-grob trans 'Stem '())))
         (ly:message "stems: ~a" stems)
         (ly:message "new-stem: ~a" new-stem)
         (set! (ly:grob-property stem 'axes) (list X))
         (ly:axis-group-interface::add-element stem new-stem)
         (set! (ly:grob-object new-stem 'spanned-stems) stems)
         (set! (ly:grob-object new-stem 'Y-offset) 5)
         (set! (ly:grob-property new-stem 'stencil) stemSpanStencil)
         (set! (ly:grob-property new-stem 'length) crossStaffLength))))

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

    `((acknowledgers
       (stem-interface
        . ,(lambda (trans grob source)
             (set! stems (cons grob stems)))))

      (process-acknowledged
       . ,(lambda (trans)
             (reparentStems ctx stems trans) (set! stems '()))))))

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

\new PianoStaff <<
  \new Staff { \stemUp g' a' b' c'' }
  \new Staff { \stemUp f' e' <f' d'> r }
>>