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

.

Browse Source 
original commit: 461118ee5270b7512f715d7421972de5642e0a36
This commit is contained in:
Matthew Flatt 2005-02-17 22:05:26 +00:00
parent bef4ea8733
commit ac137dea94
2 changed files with 36 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/mred/private/wxitem.ss
View File

@ -219,15 +219,24 @@
(define wx-button% (make-window-glue%
(class100 (make-simple-control% wx:button%) (parent cb label x y w h style font)
(inherit command)
(private-field [border? (memq 'border style)])
(public [has-border? (lambda () border?)])
(inherit command set-border get-top-level)
(private-field
[border? (memq 'border style)]
[border-on? border?])
(public
[defaulting (lambda (on?)
(set! border-on? on?)
(when border?
(set-border border-on?)))]
[has-border? (lambda () border-on?)])
(override
[char-to (lambda ()
(as-exit
(lambda ()
(command (make-object wx:control-event% 'button)))))])
(sequence (super-init style parent cb label x y w h style font)))))
(sequence (super-init style parent cb label x y w h style font)
(when border?
(send (get-top-level) add-border-button this))))))
(define wx-check-box% (class100 (make-window-glue% (make-simple-control% wx:check-box%)) (mred proxy parent cb label x y w h style font)
(inherit set-value get-value command)
(override

23
collects/mred/private/wxtop.ss
View File

@ -79,6 +79,8 @@
[focus #f]
[target #f]
[border-buttons null]
[show-ht (make-hash-table)])
(override
@ -99,6 +101,23 @@
[set-focus-window
(lambda (w)
(unless (eq? 'macosx (system-type))
(set! border-buttons (filter weak-box-value border-buttons))
(if (not w)
;; Non-border button losing focus?
(when (and (focus . is-a? . wx:button%)
(not (memq focus (map weak-box-value border-buttons))))
(send focus defaulting #f))
;; Something gaining focus... adjust border buttons
(begin
(for-each (lambda (bb)
(let ([b (weak-box-value bb)])
(when b
(send b defaulting (or (not (w . is-a? . wx:button%))
(eq? b w))))))
border-buttons)
(when (w . is-a? . wx:button%)
(send w defaulting #t)))))
(set! focus w)
(when w
(set! target w)))]
@ -128,6 +147,10 @@
w))
focus)))]
[add-border-button
(lambda (b)
(set! border-buttons (cons (make-weak-box b) border-buttons)))]
;; add-child: update panel pointer.
;; input: new-panel: panel in frame (descendant of
;; panel%)