Created
October 11, 2019 01:08
-
-
Save LeifAndersen/965a186bd5c9f2db9a34ea44ec7199d9 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#lang scratch | |
(define will-text% | |
(class text% | |
(inherit get-start-position) | |
(super-new) | |
(define DOUBLE-CLICK-DELTA 500) | |
(define last-click 0) | |
(define/private (select-word) | |
(define s (box (get-start-position))) | |
(define e (box (get-start-position))) | |
(send text find-wordbreak s e 'selection) | |
(send text set-position (unbox s) (unbox e))) | |
(define/override (on-event evt) | |
(super on-event evt) | |
(when (eq? 'left-down (send evt get-event-type)) | |
(define new-click (send evt get-time-stamp)) | |
(when (<= (- new-click last-click) DOUBLE-CLICK-DELTA) | |
(select-word)) | |
(set! last-click new-click))))) | |
(define f (new frame% [label "HI"] | |
[min-width 500] | |
[min-height 500])) | |
(define text (new will-text%)) | |
(send text insert "This is just a small snip of text.") | |
(new editor-canvas% [parent f] | |
[editor text]) | |
(send f show #t) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment