From 19ac32d5f6b577c001b286860c587ad1fde7b708 Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Wed, 10 Sep 2008 02:34:37 +0000
Subject: [PATCH] Have the handin button match the styles of other toolbar
 buttons, including correctly working when the toolbar is not horizontal.

svn: r11626
---
 collects/handin-client/client-gui.ss | 60 ++++++++++++++++------------
 1 file changed, 34 insertions(+), 26 deletions(-)

diff --git a/collects/handin-client/client-gui.ss b/collects/handin-client/client-gui.ss
index 091dc5c18b..11d40f8f52 100644
--- a/collects/handin-client/client-gui.ss
+++ b/collects/handin-client/client-gui.ss
@@ -1,6 +1,6 @@
-(module client-gui mzscheme
-  (require mzlib/class mzlib/unit mzlib/file net/sendurl mred
-           mrlib/bitmap-label drscheme/tool framework
+(module client-gui scheme/base
+  (require mzlib/class mzlib/unit mzlib/file mrlib/switchable-button
+           mrlib/bitmap-label net/sendurl mred drscheme/tool framework
            "info.ss" "client.ss" "this-collection.ss")
 
   (provide tool@)
@@ -522,7 +522,7 @@
            (when (is-shown?)
              (message-box
               "Server Error"
-              (if (exn? exn)
+              (when (exn? exn)
                 (let ([s (exn-message exn)])
                   (if (string? s) s (format "~e" s))))
               this)
@@ -776,28 +776,36 @@
 			       (send-url web-address)))))
             (super help-menu:after-about menu))
 
-	  (define button
-            (new button%
-              [label (tool-button-label this)]
-              [parent (get-button-panel)]
-              [style '(deleted)]
-              [callback
-               (lambda (button evt)
-                 (let ([content (editors->string
-                                 (list (get-definitions-text)
-                                       (get-interactions-text)))])
-                   (new handin-frame%
-                     [parent this]
-                     [content content]
-                     [on-retrieve
-                      (lambda (buf)
-                        (string->editor!
-                         buf
-                         (send (drscheme:unit:open-drscheme-window)
-                               get-editor)))])))]))
-
-	  (send (get-button-panel) change-children
-		(lambda (l) (cons button l)))))
+          (define client-panel
+            (new vertical-pane% (parent (get-button-panel))))
+          
+	  (define client-button
+            (new switchable-button%
+                 [label button-label/h]
+                 [bitmap handin-icon]
+                 [parent client-panel]                 
+                 [callback
+                  (lambda (button evt)
+                    (let ([content (editors->string
+                                    (list (get-definitions-text)
+                                          (get-interactions-text)))])
+                      (new handin-frame%
+                           [parent this]
+                           [content content]
+                           [on-retrieve
+                            (lambda (buf)
+                              (string->editor!
+                               buf
+                               (send (drscheme:unit:open-drscheme-window)
+                                     get-editor)))])))]))
+          
+          (inherit register-toolbar-button)
+          (register-toolbar-button client-button)
+          
+          (send (get-button-panel) change-children
+              (lambda (_)
+                (cons client-panel
+                      (remq client-panel _))))))
 
       (when (and server port-no)
         (drscheme:get/extend:extend-unit-frame make-new-unit-frame% #f)))))