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

add 'handles-all-mouse-events snip% flag

Browse Source
This commit is contained in:
Matthew Flatt 2010-06-26 10:05:06 -06:00
parent 0107404cee
commit dc98077ca4
5 changed files with 94 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
collects/mred/private/wxme/pasteboard.rkt
View File

@ -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)

7
collects/mred/private/wxme/snip-flags.rkt
View File

@ -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)))

13
collects/mred/private/wxme/snip.rkt
View File

@ -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)

51
collects/mred/private/wxme/text.rkt
View File

@ -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)))]

8
collects/scribblings/gui/snip-class.scrbl
View File

@ -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