gui/editor-util.ss
(module editor-util mzscheme

  (require (lib "contract.ss")
           (lib "class.ss")
           (lib "mred.ss" "mred"))

  (define canvas/c (is-a?/c editor-canvas%))
  (define admin/c (is-a?/c editor-admin%))
  (define editor/c (is-a?/c editor<%>))
  (define pasteboard/c (is-a?/c pasteboard%))
  (define snip/c (is-a?/c snip%))

  (define opt-real/c (or/c false/c real?))

  (provide/contract
   [scroll-editor-to/xy (editor/c opt-real/c opt-real/c . -> . void?)]
   [scroll-canvas-to/xy (canvas/c opt-real/c opt-real/c . -> . void?)]
   [get-editor-scroll-step (editor/c . -> . natural-number/c)]
   [admin-position (admin/c . -> . (values real? real? real? real?))]
   [editor-position (editor/c . -> . (values real? real? real? real?))]
   [canvas-position (canvas/c . -> . (values real? real? real? real?))]
   [center-snip (pasteboard/c snip/c real? real? real? real? . -> . void?)])

  (define (scroll-editor-to/xy editor new-x new-y)
    (let*-values ([(x-step) 1] ;; seems to work
                  [(y-step) (get-editor-scroll-step editor)]
                  [(x y w h) (editor-position editor)])
      (scroll-editor-to
       editor
       (max (+ (or new-x x) (/ x-step 2)) 0)
       (max (+ (or new-y y) (/ y-step 2)) 0)
       (max (- w (* x-step 1)) 0)
       (max (- h (* y-step 1)) 0))
      (void)))

  (define (scroll-canvas-to/xy canvas x y)
    (scroll-editor-to/xy (send canvas get-editor) x y))

  (define (scroll-editor-to editor x y w h)
    (send (send editor get-admin) scroll-to x y w h))

  (define (get-editor-scroll-step editor)
    (if (is-a? editor pasteboard%)
        (send editor get-scroll-step)
        1))

  (define (admin-position admin)
    (let* ([x (box 0)]
           [y (box 0)]
           [w (box 0)]
           [h (box 0)])
      (send admin get-view x y w h)
      (values (unbox x) (unbox y) (unbox w) (unbox h))))

  (define (editor-position editor)
    (admin-position (send editor get-admin)))

  (define (canvas-position canvas)
    (editor-position (send canvas get-editor)))

  (define (center-snip pasteboard snip x y w h)
    (send pasteboard insert snip (floor x) (floor y))
    (let* ([top (box 0)]
           [lft (box 0)]
           [bot (box 0)]
           [rgt (box 0)])
      (send pasteboard get-snip-location snip top lft #f)
      (send pasteboard get-snip-location snip bot rgt #t)
      (let* ([snip-w (- (unbox rgt) (unbox lft))]
             [snip-h (- (unbox bot) (unbox top))]
             [dx (/ (- w snip-w) 2)]
             [dy (/ (- h snip-h) 2)])
        (send pasteboard move snip (floor dx) (floor dy)))))

  )