www

commit d62630672ec8dd26225467bb25467efa919dfbac
parent 0ffcc96bec7b984806e34195db7b2206e30d2f6a
Author: Ryan Culpepper <ryanc@racket-lang.org>
Date:   Fri, 24 Feb 2012 17:51:41 -0700

macro-debugger: right-click also changes syntax selection
  fixes PR 12442

original commit: fa5e57335cc784ea3b50ba86f7c49cbd7240842f

Diffstat:
M
collects/macro-debugger/syntax-browser/display.rkt
 | 
3
++-
M
collects/macro-debugger/syntax-browser/text.rkt
 | 
35
++++++++++++++++++++++++++++++-----

2 files changed, 32 insertions(+), 6 deletions(-)
diff --git a/collects/macro-debugger/syntax-browser/display.rkt b/collects/macro-debugger/syntax-browser/display.rkt
@@ -107,7 +107,8 @@
         (force lazy-interval-map-init)
         (send/i controller selection-manager<%> set-selected-syntax
                 (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
     ;; Clears all highlighting and reapplies all non-foreground styles.
diff --git a/collects/macro-debugger/syntax-browser/text.rkt b/collects/macro-debugger/syntax-browser/text.rkt
@@ -353,13 +353,27 @@ Like clickbacks, but:
              find-position)
 
     (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/public (set-clickregion start end callback)
-      (if callback
-          (interval-map-set! clickbacks start end callback)
-          (interval-map-remove! clickbacks start end)))
+    (define/public (set-clickregion start end callback [region 'click])
+      (let ([mapping
+             (case region
+               ((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-values (x y)
@@ -370,6 +384,7 @@ Like clickbacks, but:
       (define pos (find-position x y #f on-it?))
       (and (unbox on-it?) pos))
 
+    ;; on-default-event called if keymap does not handle event
     (define/override (on-default-event ev)
       (define admin (get-admin))
       (when admin
@@ -388,6 +403,16 @@ Like clickbacks, but:
              (send admin update-cursor)))))
       (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 pos (get-event-position ev))
       (define cb (and pos (interval-map-ref clickbacks pos #f)))