add on-subwindow-focus' to window<%>'

relevant to PR 12474

original commit: fd019a34787805021f9924bb7c9253966bf58f8e
This commit is contained in:
Matthew Flatt 2012-01-07 17:30:08 -07:00
parent 1c40749acf
commit d80906a5c7
4 changed files with 34 additions and 7 deletions

View File

@ -145,6 +145,7 @@
(send m on-demand)
(send wx popup-menu mwx x y)))))))]
[on-focus (lambda (x) (void))]
[on-subwindow-focus (lambda (win active?) (void))]
[on-size (lambda (w h)
(check-range-integer '(method window<%> on-size) w)
(check-range-integer '(method window<%> on-size) h))]

View File

@ -143,7 +143,7 @@
(define (make-window-glue% %) ; implies make-glue%
(class100 (make-glue% %) (mred proxy . args)
(inherit get-x get-y get-width get-height area-parent get-mred get-proxy skip-subwindow-events?)
(inherit get-x get-y get-width get-height area-parent get-mred get-proxy skip-subwindow-events? get-parent)
(private-field
[pre-wx->proxy (lambda (orig-w e k)
;; MacOS: w may not be something the user knows
@ -214,10 +214,16 @@
(as-exit (lambda () (send mred on-move x y)))))))))))]
[on-set-focus (lambda ()
(super on-set-focus)
(when expose-focus? (send (get-proxy) on-focus #t)))]
(when expose-focus?
(let ([p (get-proxy)])
(send p on-focus #t)
(on-subwindow-focus p #t))))]
[on-kill-focus (lambda ()
(super on-kill-focus)
(when expose-focus? (send (get-proxy) on-focus #f)))]
(when expose-focus?
(let ([p (get-proxy)])
(send p on-focus #f)
(on-subwindow-focus p #f))))]
[pre-on-char (lambda (w e)
(or (super pre-on-char w e)
(if (skip-subwindow-events?)
@ -236,4 +242,11 @@
(lambda (m e)
(as-exit (lambda ()
(send (get-proxy) on-subwindow-event m e))))))))])
(public
[on-subwindow-focus (lambda (win on?)
(unless (or (is-a? this wx:frame%)
(is-a? this wx:dialog%))
(send (get-parent) on-subwindow-focus win on?))
(unless (skip-subwindow-events?)
(send (get-proxy) on-subwindow-focus win on?)))])
(sequence (apply super-init mred proxy args)))))

View File

@ -338,10 +338,9 @@ Called when the window is moved. (For windows that are not top-level
Does nothing.
}}
@defmethod[(on-size [width (integer-in 0 10000)]
[height (integer-in 0 10000)])
void?]{
@ -356,8 +355,6 @@ Called when the window is resized. The window's new size (in pixels)
Does nothing.
}}
@defmethod[(on-subwindow-char [receiver (is-a?/c window<%>)]
@ -428,6 +425,20 @@ Returns @racket[#f].
}}
@defmethod[(on-subwindow-focus [receiver (is-a?/c window<%>)]
[on? boolean?])
void?]{
Called when this window or a child window receives or loses the keyboard focus.
This method is called after the @method[window<%> on-focus] method of @racket[receiver].
The
@method[window<%> on-subwindow-focus] method of the receiver's top-level window is called first (see
@method[area<%> get-top-level-window]), then the
@method[window<%> on-subwindow-focus] method is called for the next child in the path to the receiver, and
so on.}
@defmethod[(on-superwindow-enable [enabled? any/c])
void?]{

View File

@ -323,6 +323,8 @@
[on-subwindow-char (lambda args
(or (apply pre-on args)
(super on-subwindow-char . args)))]
[on-subwindow-focus (lambda (win on?)
(printf "focus ~s ~s\n" (send win get-label) on?))]
[on-activate (lambda (on?) (printf "active: ~a\n" on?))]
[on-move (lambda (x y) (printf "moved: ~a ~a\n" x y))]
[on-size (lambda (x y) (printf "sized: ~a ~a\n" x y))])