gui/trace-sidebar.ss
(module trace-sidebar mzscheme

  (require (lib "contract.ss")
           (lib "class.ss")
           (lib "mred.ss" "mred")
           (lib "etc.ss")
           "interfaces.ss"
           "util-mixins.ss"
           "pasteboard-mixins.ss"
           "snip-mixins.ss"
           "trace-header.ss"
           "draw.ss"
           "../model/view.ss"
           "../model/action-util.ss"
           )

  (provide/contract
   [trace-sidebar% (class/c editor-canvas% updatee<%>)])

  (define trace-sidebar%
    (class*
      (ensure-iface editor-canvas-util<%>
                    editor-canvas-util-mixin
                    editor-canvas%)
      (updatee<%>)

      (inherit set-editor)

      (init-field trace-display)
      (super-new [style '(auto-hscroll auto-vscroll)]
                 [min-width (+ SIDEBAR-WIDTH SCROLLBAR-WIDTH)]
                 [horizontal-inset 0]
                 [vertical-inset 0])

      (public on-update)
      (override on-scroll/xy)

      (define editor
        (new trace-action-editor% [trace-display trace-display]))
      (set-editor editor)

      (define (on-scroll/xy x y dx dy)
        (unless (= 0 dy)
          (send trace-display scroll-trace/xy #f y)))

      (define (on-update)
        (send editor on-update))))

  (define trace-action-editor%
    (class*
      (ensure-iface pasteboard-util<%>
                    pasteboard-util-mixin
                    (static-pasteboard-mixin pasteboard%))
      (updatee<%>)

      (super-new)
      (inherit insert)

      (init-field trace-display)
      (public on-update)
      (override on-double-click)

      (define sidebar-snip
        (new trace-sidebar-snip% [trace-display trace-display]))
      (insert sidebar-snip 0 0)

      (on-update)

      (define (on-double-click snip event)
        (send sidebar-snip on-double-click event))

      (define (on-update)
        (send sidebar-snip on-update))

      ))

  (define SIDEBAR-LABEL-HORIZ-OFFSET 10)
  (define SIDEBAR-LABEL-VERT-OFFSET 10)
  (define SIDEBAR-ARROW-HORIZ-OFFSET 10)
  (define SIDEBAR-ARROW-VERT-OFFSET 12)

  (define trace-sidebar-snip%
    (class (updatable-snip-mixin
            (custom-snip-mixin snip%))
      (super-new)

      (inherit get-admin)
      (init-field trace-display)
      (override paint extent)
      (public on-double-click)
      (private get-view)

      (define (get-view)
        (send trace-display get-view))

      (define (on-double-click event)
        (let*-values ([(x y)
                       (send (send (get-admin) get-editor)
                             dc-location-to-editor-location
                             (send event get-x) (send event get-y))]
                      [(action-index)
                       (inexact->exact (floor (/ y ACTION-HEIGHT)))])
          (when (<= 0 action-index (- (view-count-actions (get-view)) 1))
            (let* ([action (view-get-action (get-view) action-index)]
                   [object
                    (cond
                     [(<= 0 x (* SIDEBAR-WIDTH 1/3))
                      (action-source action)]
                     [(<= (* SIDEBAR-WIDTH 2/3) x SIDEBAR-WIDTH)
                      (action-target action)]
                     [else #f])])
              (when object
                (send trace-display scroll-trace/object object))))))

      (define (extent dc x y)
        (values SIDEBAR-WIDTH
                (view-height (get-view))
                0 0 0 0))

      (define (paint easel)
        (draw-sidebar easel (get-view)))))

  )