suzanne.soy/macro-debugger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

macro-debugger: refine position of mouse events

Browse Source 
original commit: de9538d1eb3633e6a9bffc9766d4e8badf4b18e2
This commit is contained in:
Ryan Culpepper 2010-11-11 21:59:41 -07:00
parent b50316679a
commit e1dc035fa6
1 changed files with 17 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/macro-debugger/syntax-browser/text.rkt
View File

@ -115,14 +115,16 @@
find-position) find-position)
(define/override (on-default-event ev) (define/override (on-default-event ev)
(define gx (send ev get-x))
(define gy (send ev get-y))
(define-values (x y) (dc-location-to-editor-location gx gy))
(define pos (find-position x y))
(super on-default-event ev) (super on-default-event ev)
(case (send ev get-event-type) (case (send ev get-event-type)
((enter motion leave) ((enter motion leave)
(update-hover-position pos)))) (define-values (x y)
(let ([gx (send ev get-x)]
[gy (send ev get-y)])
(dc-location-to-editor-location gx gy)))
(define on-it? (box #f))
(define pos (find-position x y #f on-it?))
(update-hover-position (and (unbox on-it?) pos)))))
(define/public (update-hover-position pos) (define/public (update-hover-position pos)
(void)) (void))
@ -344,10 +346,13 @@ Like clickbacks, but:
(interval-map-remove! clickbacks start end))) (interval-map-remove! clickbacks start end)))
(define/private (get-event-position ev) (define/private (get-event-position ev)
(define gx (send ev get-x)) (define-values (x y)
(define gy (send ev get-y)) (let ([gx (send ev get-x)]
(define-values (x y) (dc-location-to-editor-location gx gy)) [gy (send ev get-y)])
(find-position x y)) (dc-location-to-editor-location gx gy)))
(define on-it? (box #f))
(define pos (find-position x y #f on-it?))
(and (unbox on-it?) pos))
(define/override (on-default-event ev) (define/override (on-default-event ev)
(define admin (get-admin)) (define admin (get-admin))
@ -355,11 +360,11 @@ Like clickbacks, but:
(define pos (get-event-position ev)) (define pos (get-event-position ev))
(case (send ev get-event-type) (case (send ev get-event-type)
((left-down) ((left-down)
(set! tracking (interval-map-ref clickbacks pos #f)) (set! tracking (and pos (interval-map-ref clickbacks pos #f)))
(send admin update-cursor)) (send admin update-cursor))
((left-up) ((left-up)
(when tracking (when tracking
(let ([cb (interval-map-ref clickbacks pos #f)] (let ([cb (and pos (interval-map-ref clickbacks pos #f))]
[tracking* tracking]) [tracking* tracking])
(set! tracking #f) (set! tracking #f)
(when (eq? tracking* cb) (when (eq? tracking* cb)
@ -369,7 +374,7 @@ Like clickbacks, but:
(define/override (adjust-cursor ev) (define/override (adjust-cursor ev)
(define pos (get-event-position ev)) (define pos (get-event-position ev))
(define cb (interval-map-ref clickbacks pos #f)) (define cb (and pos (interval-map-ref clickbacks pos #f)))
(if cb (if cb
arrow-cursor arrow-cursor
(super adjust-cursor ev))))) (super adjust-cursor ev)))))