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

macro-debugger: right-click also changes syntax selection

Browse Source 
fixes PR 12442

original commit: fa5e57335cc784ea3b50ba86f7c49cbd7240842f
This commit is contained in:
Ryan Culpepper 2012-02-24 17:51:41 -07:00
parent 0ffcc96bec
commit d62630672e
2 changed files with 32 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/macro-debugger/syntax-browser/display.rkt
View File

@ -107,7 +107,8 @@
(force lazy-interval-map-init) (force lazy-interval-map-init)
(send/i controller selection-manager<%> set-selected-syntax (send/i controller selection-manager<%> set-selected-syntax
(interval-map-ref mapping position #f))) (interval-map-ref mapping position #f)))
(send text set-clickregion start-position end-position the-callback)) (send text set-clickregion start-position end-position the-callback)
(send text set-clickregion start-position end-position the-callback 'right-down))
;; refresh : -> void ;; refresh : -> void
;; Clears all highlighting and reapplies all non-foreground styles. ;; Clears all highlighting and reapplies all non-foreground styles.

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

@ -353,13 +353,27 @@ Like clickbacks, but:
find-position) find-position)
(super-new) (super-new)
(define clickbacks (get-region-mapping 'clickregion))
;; Two mappings: one for left clicks, another for right
;; mouse-downs. Rationale: macro stepper wants to handle left
;; clicks normally, but wants to insert behavior (ie, change
;; focus) before normal processing of right-down (ie, editor
;; passes to keymap, opens popup menu).
(define clickbacks (get-region-mapping 'click-region))
(define right-clickbacks (get-region-mapping 'right-click-region))
(define tracking #f) (define tracking #f)
(define/public (set-clickregion start end callback) (define/public (set-clickregion start end callback [region 'click])
(if callback (let ([mapping
(interval-map-set! clickbacks start end callback) (case region
(interval-map-remove! clickbacks start end))) ((click) clickbacks)
((right-down) right-clickbacks)
(else (error 'set-clickregion
"bad region symbol: expected 'click or 'right-down, got ~e"
region)))])
(if callback
(interval-map-set! mapping start end callback)
(interval-map-remove! mapping start end))))
(define/private (get-event-position ev) (define/private (get-event-position ev)
(define-values (x y) (define-values (x y)
@ -370,6 +384,7 @@ Like clickbacks, but:
(define pos (find-position x y #f on-it?)) (define pos (find-position x y #f on-it?))
(and (unbox on-it?) pos)) (and (unbox on-it?) pos))
;; on-default-event called if keymap does not handle event
(define/override (on-default-event ev) (define/override (on-default-event ev)
(define admin (get-admin)) (define admin (get-admin))
(when admin (when admin
@ -388,6 +403,16 @@ Like clickbacks, but:
(send admin update-cursor))))) (send admin update-cursor)))))
(super on-default-event ev)) (super on-default-event ev))
;; on-local-event called before keymap consulted
(define/override (on-local-event ev)
(case (send ev get-event-type)
((right-down)
(when (get-admin)
(define pos (get-event-position ev))
(let ([cb (and pos (interval-map-ref right-clickbacks pos #f))])
(when cb (cb pos))))))
(super on-local-event ev))
(define/override (adjust-cursor ev) (define/override (adjust-cursor ev)
(define pos (get-event-position ev)) (define pos (get-event-position ev))
(define cb (and pos (interval-map-ref clickbacks pos #f))) (define cb (and pos (interval-map-ref clickbacks pos #f)))