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

avoid duplicate subwindow callbacks in a text-field%

Browse Source 
svn: r12648
This commit is contained in:
Matthew Flatt 2008-11-30 13:34:12 +00:00
parent 88b0e558c3
commit 35599a8955
2 changed files with 33 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/mred/private/wxtextfield.ss
View File

@ -142,6 +142,7 @@
[p (if horiz? [p (if horiz?
this this
(let ([p (make-object wx-vertical-pane% #f proxy this null)]) (let ([p (make-object wx-vertical-pane% #f proxy this null)])
(send p skip-subwindow-events? #t)
(send (send p area-parent) add-child p) (send (send p area-parent) add-child p)
p))]) p))])
(sequence (sequence
@ -166,7 +167,9 @@
'(hide-hscroll)) '(hide-hscroll))
'(hide-vscroll hide-hscroll))))]) '(hide-vscroll hide-hscroll))))])
(sequence (sequence
(send c skip-subwindow-events? #t)
(when l (when l
(send l skip-subwindow-events? #t)
(send l x-margin 0)) (send l x-margin 0))
(send c set-x-margin 2) (send c set-x-margin 2)
(send c set-y-margin 2) (send c set-y-margin 2)

49
collects/mred/private/wxwindow.ss
View File

@ -18,29 +18,36 @@
[focus? #f] [focus? #f]
[container this] [container this]
[visible? #f] [visible? #f]
[active? #f]) [active? #f]
[skip-sub-events? #f])
(public (public
[on-visible [on-visible
(lambda () (lambda ()
(let ([vis? (is-shown-to-root?)]) (let ([vis? (is-shown-to-root?)])
(unless (eq? vis? visible?) (unless (eq? vis? visible?)
(set! visible? vis?) (set! visible? vis?)
(as-exit (unless skip-sub-events?
(lambda () (as-exit
(send (wx->proxy this) on-superwindow-show vis?))))))] (lambda ()
(send (wx->proxy this) on-superwindow-show vis?)))))))]
[queue-visible [queue-visible
(lambda () (lambda ()
(parameterize ([wx:current-eventspace (send (get-top-level) get-eventspace)]) (parameterize ([wx:current-eventspace (send (get-top-level) get-eventspace)])
(wx:queue-callback (entry-point (lambda () (on-visible))) wx:middle-queue-key)))]) (wx:queue-callback (entry-point (lambda () (on-visible))) wx:middle-queue-key)))]
[skip-subwindow-events?
(case-lambda
[() skip-sub-events?]
[(skip?) (set! skip-sub-events? skip?)])])
(public (public
[on-active [on-active
(lambda () (lambda ()
(let ([act? (is-enabled-to-root?)]) (let ([act? (is-enabled-to-root?)])
(unless (eq? act? active?) (unless (eq? act? active?)
(set! active? act?) (set! active? act?)
(as-exit (unless skip-sub-events?
(lambda () (as-exit
(send (wx->proxy this) on-superwindow-enable act?))))))] (lambda ()
(send (wx->proxy this) on-superwindow-enable act?)))))))]
[queue-active [queue-active
(lambda () (lambda ()
(parameterize ([wx:current-eventspace (send (get-top-level) get-eventspace)]) (parameterize ([wx:current-eventspace (send (get-top-level) get-eventspace)])
@ -127,7 +134,7 @@
(define (make-window-glue% %) ; implies make-glue% (define (make-window-glue% %) ; implies make-glue%
(class100 (make-glue% %) (mred proxy . args) (class100 (make-glue% %) (mred proxy . args)
(inherit get-x get-y get-width get-height area-parent get-mred get-proxy) (inherit get-x get-y get-width get-height area-parent get-mred get-proxy skip-subwindow-events?)
(private-field (private-field
[pre-wx->proxy (lambda (orig-w e k) [pre-wx->proxy (lambda (orig-w e k)
;; MacOS: w may not be something the user knows ;; MacOS: w may not be something the user knows
@ -211,16 +218,20 @@
(as-exit (lambda () (super on-kill-focus)))))] (as-exit (lambda () (super on-kill-focus)))))]
[pre-on-char (lambda (w e) [pre-on-char (lambda (w e)
(or (super pre-on-char w e) (or (super pre-on-char w e)
(as-entry (if (skip-subwindow-events?)
(lambda () #f
(pre-wx->proxy w e (as-entry
(lambda (m e) (lambda ()
(as-exit (lambda () (pre-wx->proxy w e
(send (get-proxy) on-subwindow-char m e)))))))))] (lambda (m e)
(as-exit (lambda ()
(send (get-proxy) on-subwindow-char m e))))))))))]
[pre-on-event (entry-point [pre-on-event (entry-point
(lambda (w e) (lambda (w e)
(pre-wx->proxy w e (if (skip-subwindow-events?)
(lambda (m e) #f
(as-exit (lambda () (pre-wx->proxy w e
(send (get-proxy) on-subwindow-event m e)))))))]) (lambda (m e)
(as-exit (lambda ()
(send (get-proxy) on-subwindow-event m e))))))))])
(sequence (apply super-init mred proxy args))))) (sequence (apply super-init mred proxy args)))))