From ac137dea947136bf99314f62a4b1503ac20ba538 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 17 Feb 2005 22:05:26 +0000
Subject: [PATCH] .

original commit: 461118ee5270b7512f715d7421972de5642e0a36
---
 collects/mred/private/wxitem.ss | 17 +++++++++++++----
 collects/mred/private/wxtop.ss  | 23 +++++++++++++++++++++++
 2 files changed, 36 insertions(+), 4 deletions(-)

diff --git a/collects/mred/private/wxitem.ss b/collects/mred/private/wxitem.ss
index 67baaf06..c9d854c2 100644
--- a/collects/mred/private/wxitem.ss
+++ b/collects/mred/private/wxitem.ss
@@ -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
diff --git a/collects/mred/private/wxtop.ss b/collects/mred/private/wxtop.ss
index c69ff39a..810917d7 100644
--- a/collects/mred/private/wxtop.ss
+++ b/collects/mred/private/wxtop.ss
@@ -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%)