text.rkt

#lang scratch

(define will-text%
  (class text%
    (init [(ic callback) void])
    (define callback ic)
    (inherit get-position
             find-wordbreak
             set-position)
    (super-new)
    (define/override (on-char evt)
      (super on-char evt)
      (callback))
    (define DOUBLE-CLICK-DELTA 500)
    (define last-click 0)
    (define highlighting-word #f)
    (define/private (select-word)
      (define s (box 0))
      (define e (box 0))
      (get-position s e)
      (find-wordbreak s e 'selection)
      (set-position (unbox s) (unbox e)))
    (define/override (on-event evt)
      (super on-event evt)
      (case (send evt get-event-type)
        [(left-down)
         (define new-click (send evt get-time-stamp))
         (when (<= (- new-click last-click) DOUBLE-CLICK-DELTA)
           (set! highlighting-word #t))
         (set! last-click new-click)]
        [(left-up)
         (set! highlighting-word #f)])
      (when highlighting-word
        (select-word)))))

(define f (new frame% [label "HI"]
               [min-width 500]
               [min-height 500]))

(define text (new will-text% [callback (λ () (writeln (send text get-text)))]))
(send text insert "This is just a small snip of text.")

(new editor-canvas% [parent f]
     [editor text])
(send f show #t)