diff --git a/collects/mred/private/wxme/pasteboard.rkt b/collects/mred/private/wxme/pasteboard.rkt index 68cd415b95..4c07fd665a 100644 --- a/collects/mred/private/wxme/pasteboard.rkt +++ b/collects/mred/private/wxme/pasteboard.rkt @@ -158,7 +158,8 @@ (define sequence-streak? #f) (define changed? #f) - + + (define prev-mouse-snip #f) (super-new) @@ -241,28 +242,42 @@ (def/override (on-event [mouse-event% event]) (when s-admin (let-values ([(dc x y scrollx scrolly) - (if (or (send event button-down?) s-caret-snip) - ;; first, find clicked-on snip: - (let ([x (send event get-x)] - [y (send event get-y)]) - (let-boxes ([scrollx 0.0] - [scrolly 0.0] - [dc #f]) - (set-box! dc (send s-admin get-dc scrollx scrolly)) - ;; FIXME: old code returned if !dc - (values dc (+ x scrollx) (+ y scrolly) scrollx scrolly))) - (values #f 0.0 0.0 0.0 0.0))]) - (let ([snip (if (send event button-down?) - (find-snip x y) - s-caret-snip)]) - (if (and snip - (eq? snip s-caret-snip)) - (let ([loc (snip-loc snip)]) - (send s-caret-snip on-event + ;; first, find clicked-on snip: + (let ([x (send event get-x)] + [y (send event get-y)]) + (let-boxes ([scrollx 0.0] + [scrolly 0.0] + [dc #f]) + (set-box! dc (send s-admin get-dc scrollx scrolly)) + ;; FIXME: old code returned if !dc + (values dc (+ x scrollx) (+ y scrolly) scrollx scrolly)))]) + (let ([snip (find-snip x y)]) + (when (and prev-mouse-snip + (not (eq? snip prev-mouse-snip))) + (let ([loc (snip-loc prev-mouse-snip)]) + (send prev-mouse-snip on-event dc (- (loc-x loc) scrollx) (- (loc-y loc) scrolly) (loc-x loc) (loc-y loc) - event)) - (on-local-event event)))))) + event))) + (set! prev-mouse-snip #f) + (when (and snip + (has-flag? (snip->flags snip) HANDLES-ALL-MOUSE-EVENTS) + (not (eq? snip s-caret-snip))) + (let ([loc (snip-loc snip)]) + (set! prev-mouse-snip snip) + (send snip on-event + dc (- (loc-x loc) scrollx) (- (loc-y loc) scrolly) + (loc-x loc) (loc-y loc) + event))) + (if (and s-caret-snip + (or (not (send event button-down?)) + (eq? snip s-caret-snip))) + (let ([loc (snip-loc s-caret-snip)]) + (send s-caret-snip on-event + dc (- (loc-x loc) scrollx) (- (loc-y loc) scrolly) + (loc-x loc) (loc-y loc) + event)) + (on-local-event event)))))) (def/override (on-default-event [mouse-event% event]) (when s-admin @@ -729,6 +744,8 @@ (define/private (-delete del-snip del) (when (snip-loc del-snip) + (when (eq? del-snip prev-mouse-snip) + (set! prev-mouse-snip #f)) (set! write-locked (add1 write-locked)) (begin-edit-sequence) (let ([ok? (or (can-delete? del-snip) diff --git a/collects/mred/private/wxme/snip-flags.rkt b/collects/mred/private/wxme/snip-flags.rkt index 2d16d0ae3f..86adcea738 100644 --- a/collects/mred/private/wxme/snip-flags.rkt +++ b/collects/mred/private/wxme/snip-flags.rkt @@ -20,6 +20,7 @@ (define CAN-SPLIT #x1000) ;; safety feature (define OWNED #x2000) (define CAN-DISOWN #x4000) +(define HANDLES-ALL-MOUSE-EVENTS #x8000) (define-syntax-rule (has-flag? flags flag) (not (zero? (bitwise-and flags flag)))) @@ -61,7 +62,8 @@ WIDTH-DEPENDS-ON-X HEIGHT-DEPENDS-ON-Y WIDTH-DEPENDS-ON-Y - HEIGHT-DEPENDS-ON-X))) + HEIGHT-DEPENDS-ON-X + HANDLES-ALL-MOUSE-EVENTS))) (define (symbols->flags symbols) (let-syntax ([syms @@ -89,4 +91,5 @@ WIDTH-DEPENDS-ON-X HEIGHT-DEPENDS-ON-Y WIDTH-DEPENDS-ON-Y - HEIGHT-DEPENDS-ON-X))) + HEIGHT-DEPENDS-ON-X + HANDLES-ALL-MOUSE-EVENTS))) diff --git a/collects/mred/private/wxme/snip.rkt b/collects/mred/private/wxme/snip.rkt index bac2db39e5..c970389b20 100644 --- a/collects/mred/private/wxme/snip.rkt +++ b/collects/mred/private/wxme/snip.rkt @@ -157,7 +157,18 @@ (unless (send s-admin recounted this #t) (set! s-count old-count))))) - (def/public (set-flags [symbol-list? new-flags]) + (def/public (set-flags [(make-list (symbol-in is-text + can-append + invisible + newline + hard-newline + handles-events + width-depends-on-x + height-depends-on-y + width-depends-on-y + height-depends-on-x + handles-all-mouse-events)) + new-flags]) (s-set-flags (symbols->flags new-flags))) (define/public (s-set-flags new-flags) diff --git a/collects/mred/private/wxme/text.rkt b/collects/mred/private/wxme/text.rkt index 884f230429..f932224d08 100644 --- a/collects/mred/private/wxme/text.rkt +++ b/collects/mred/private/wxme/text.rkt @@ -170,6 +170,8 @@ (define sticky-styles? #t) (define overwrite-mode? #f) + (define prev-mouse-snip #f) + (def/public (set-styles-sticky [bool? s?]) (set! sticky-styles? (and s? #t))) (def/public (get-styles-sticky) sticky-styles?) @@ -441,18 +443,15 @@ (not (send event leaving?))) (end-streaks '(except-key-sequence cursor delayed))) (let-values ([(dc x y scrollx scrolly) - (if (or (send event button-down?) s-caret-snip) - ;; first, find clicked-on snip: - (let ([x (send event get-x)] - [y (send event get-y)]) - (let-boxes ([scrollx 0.0] - [scrolly 0.0] - [dc #f]) - (set-box! dc (send s-admin get-dc scrollx scrolly)) - ;; FIXME: old code returned if !dc - (values dc (+ x scrollx) (+ y scrolly) scrollx scrolly))) - (values #f 0.0 0.0 0.0 0.0))]) - (when (send event button-down?) + ;; first, find clicked-on snip: + (let ([x (send event get-x)] + [y (send event get-y)]) + (let-boxes ([scrollx 0.0] + [scrolly 0.0] + [dc #f]) + (set-box! dc (send s-admin get-dc scrollx scrolly)) + ;; FIXME: old code returned if !dc + (values dc (+ x scrollx) (+ y scrolly) scrollx scrolly)))]) (let ([snip (let-boxes ([onit? #f] [how-close 0.0] @@ -476,12 +475,26 @@ #f snip))) #f)))]) - (set-caret-owner snip))) - (if (and s-caret-snip (has-flag? (snip->flags s-caret-snip) HANDLES-EVENTS)) - (let-boxes ([x 0.0] [y 0.0]) - (get-snip-position-and-location s-caret-snip #f x y) - (send s-caret-snip on-event dc (- x scrollx) (- y scrolly) x y event)) - (on-local-event event))))) + (when (send event button-down?) + (set-caret-owner snip)) + (when (and prev-mouse-snip + (not (eq? snip prev-mouse-snip))) + (let-boxes ([x 0.0] [y 0.0]) + (get-snip-position-and-location prev-mouse-snip #f x y) + (send prev-mouse-snip on-event dc (- x scrollx) (- y scrolly) x y event))) + (set! prev-mouse-snip #f) + (if (and s-caret-snip (has-flag? (snip->flags s-caret-snip) HANDLES-EVENTS)) + (let-boxes ([x 0.0] [y 0.0]) + (get-snip-position-and-location s-caret-snip #f x y) + (send s-caret-snip on-event dc (- x scrollx) (- y scrolly) x y event)) + (begin + (when (and snip + (has-flag? (snip->flags snip) HANDLES-ALL-MOUSE-EVENTS)) + (let-boxes ([x 0.0] [y 0.0]) + (get-snip-position-and-location snip #f x y) + (set! prev-mouse-snip snip) + (send snip on-event dc (- x scrollx) (- y scrolly) x y event))) + (on-local-event event))))))) (def/override (on-default-event [mouse-event% event]) (when s-admin @@ -4004,6 +4017,8 @@ (set! snip-count (add1 snip-count))))) (define/private (delete-snip snip) + (when (eq? snip prev-mouse-snip) + (set! prev-mouse-snip #f)) (cond [(snip->next snip) (splice-snip (snip->next snip) (snip->prev snip) (snip->next (snip->next snip)))] diff --git a/collects/scribblings/gui/snip-class.scrbl b/collects/scribblings/gui/snip-class.scrbl index 3d27c532bf..56e07c02bb 100644 --- a/collects/scribblings/gui/snip-class.scrbl +++ b/collects/scribblings/gui/snip-class.scrbl @@ -23,7 +23,7 @@ create a useful snip: @item{@method[snip% split] if the snip can contain more than one @techlink{item}} - @item{@method[snip% size-cache-invalid] if the snip caches the result to@method[snip% get-extent]} + @item{@method[snip% size-cache-invalid] if the snip caches the result to @method[snip% get-extent]} @item{@method[snip% get-text] (not required)} @@ -336,7 +336,11 @@ following symbols: snip; only an owning editor should set this flag} @item{@indexed-scheme['handles-events] --- this snip can handle - keyboard and mouse events} + keyboard and mouse events when it has the keyboard focus} + + @item{@indexed-scheme['handles-all-mouse-events] --- this snip can handle + mouse events that touch the snip, even if the snip does not + have the keyboard focus} @item{@indexed-scheme['width-depends-on-x] --- this snip's display width depends on the snip's x-@techlink{location} within the