switch to #lang, reindent, minor fix (when -> if), merge stuff with csu660 version

svn: r11675

collects/handin-client/client-gui.ss

@@ -1,6 +1,7 @@
-(module client-gui scheme/base
+#lang scheme/base
-  (require mzlib/class mzlib/unit mzlib/file mrlib/switchable-button
+
-           mrlib/bitmap-label net/sendurl mred drscheme/tool framework
+(require mzlib/class mzlib/unit mzlib/file mred net/sendurl
+         mrlib/switchable-button mrlib/bitmap-label drscheme/tool framework
          "info.ss" "client.ss" "this-collection.ss")
 
 (provide tool@)
@@ -110,31 +111,37 @@
             [on-retrieve 'retrieve]
             [else (error 'handin-frame "bad initial values")]))
 
-      (define status (new message%
+    (define status
+      (new message%
            [label (format "Making secure connection to ~a..." server)]
            [parent this]
            [stretchable-width #t]))
-      (define username (new text-field%
+    (define username
+      (new text-field%
            [label "Username:"]
            [init-value (remembered-user)]
            [parent this]
            [callback (lambda (t e) (activate-ok))]
            [stretchable-width #t]))
-      (define passwd (new cached-passwd%
+    (define passwd
+      (new cached-passwd%
            [label "Password:"]
            [parent this]
            [callback (lambda (t e) (activate-ok))]
            [stretchable-width #t]))
-      (define assignment (new choice%
+    (define assignment
+      (new choice%
            [label "Assignment:"]
            [choices null]
            [parent this]
            [callback void]
            [stretchable-width #t]))
 
-      (define button-panel (new horizontal-pane%
+    (define button-panel
+      (new horizontal-pane%
            [parent this]
            [stretchable-height #f]))
+
     (make-object vertical-pane% button-panel) ; spacer
 
     (define retrieve?
@@ -212,7 +219,8 @@
                            (not (string=? "" (send username get-value)))
                            (not (string=? "" (send passwd get-value))))))
 
-      (define cancel  (new button%
+    (define cancel
+      (new button%
            [label "Cancel"]
            [parent button-panel]
            [callback (lambda (b e) (do-cancel-button))]))
@@ -239,10 +247,11 @@
                       [parent d]
                       [stretchable-height #f]
                       [alignment '(center center)])])
-	    (make-object button% "Continue Commit" d (lambda (b e) (send d show #f)))
+          (make-object button% "Continue Commit" d
-	    (make-object button% "Try to Cancel" d (lambda (b e)
+                       (lambda (b e) (send d show #f)))
-						     (set! continue-abort? #t)
+          (make-object button% "Try to Cancel" d
-						     (send d show #f))))))
+                       (lambda (b e)
+                         (set! continue-abort? #t) (send d show #f))))))
 
     (define interface-widgets
       (list ok username passwd assignment retrieve?))
@@ -466,7 +475,8 @@
                 (delete-directory/files (in-this-collection))
                 (set! uninstalled? #t)
                 (send uninstall-button enable #f)
-               (message-box "Uninstall"
+                (message-box
+                 "Uninstall"
                  (format "The ~a tool has been uninstalled. ~a~a"
                          handin-name
                          "The Handin button and associated menu items will"
@@ -522,9 +532,9 @@
          (when (is-shown?)
            (message-box
             "Server Error"
-              (when (exn? exn)
+            (if (exn? exn)
-                (let ([s (exn-message exn)])
+              (let ([s (exn-message exn)]) (if (string? s) s (format "~e" s)))
-                  (if (string? s) s (format "~e" s))))
+              (format "~e" exn))
             this)
            (set! comm-cust (make-custodian))))))
 
@@ -562,9 +572,9 @@
           (check-length pw1 50 l1 k)
           ;; not really needed, but leave just in case
           (unless (string=? (send pw1 get-value) (send pw2 get-value))
-              (message-box "Password Error"
+            (message-box
-                (format "The \"~a\" and \"~a\" passwords are not the same."
+             "Password Error"
-                        l1 l2))
+             (format "The \"~a\" and \"~a\" passwords are not the same." l1 l2))
             (k (void))))
         (for-each (lambda (t f) (check-length t 100 f k))
                   (if new? add-user-fields change-user-fields)
@@ -706,9 +716,7 @@
          [stream (make-object editor-stream-out% base)])
     (write-editor-version stream base)
     (write-editor-global-header stream)
-      (for-each (lambda (ed)
+    (for-each (lambda (ed) (send ed write-to-file stream)) editors)
-		  (send ed write-to-file stream))
-		editors)
     (write-editor-global-footer stream)
     (send base get-bytes)))
 
@@ -770,10 +778,9 @@
         (define/override (help-menu:after-about menu)
           (when web-menu-name
             (new menu-item%
-		   (label web-menu-name)
+                 [label web-menu-name]
-		   (parent menu)
+                 [parent menu]
-		   (callback (lambda (item evt)
+                 [callback (lambda (item evt) (send-url web-address))]))
-			       (send-url web-address)))))
           (super help-menu:after-about menu))
 
         (define client-panel
@@ -803,9 +810,7 @@
         (register-toolbar-button client-button)
 
         (send (get-button-panel) change-children
-              (lambda (_)
+              (lambda (l) (cons client-panel (remq client-panel l))))))
-                (cons client-panel
-                      (remq client-panel _))))))
 
     (when (and server port-no)
-        (drscheme:get/extend:extend-unit-frame make-new-unit-frame% #f)))))
+      (drscheme:get/extend:extend-unit-frame make-new-unit-frame% #f))))