a connection is required to create the manage gui, it is now possible to abort this

svn: r7271

collects/handin-client/client-gui.ss

@@ -268,14 +268,17 @@
       (center)
       (show #t)))
 
+  (provide manage-handin-dialog%)
   (define manage-handin-dialog%
-    (class dialog% (init [parent #f] [user-fields #f])
+    (class dialog% (init [parent #f])
 
       (inherit show is-shown? center)
       (super-new [label manage-dialog-name]
                  [alignment '(left center)]
                  [parent parent])
 
+      (define user-fields (get-user-fields parent))
+
       (define status
         (new message%
              [label (if user-fields
@@ -568,13 +571,50 @@
       (center)
       (show #t)))
 
-  (provide manage-handin-account)
+  ;; A simple dialog during connection, with an option to cancel (used
-  (define (manage-handin-account parent)
+  ;; by `get-user-fields' below, since its value is needed to
-    (new manage-handin-dialog%
+  ;; construct the above dialog).
-         [parent parent]
+  (define connection-dialog%
-         [user-fields (cond [(with-handlers ([void (lambda (_) #f)]) (connect))
+    (class dialog% (init receiver [parent #f])
-                             => retrieve-user-fields]
+      (inherit show is-shown? center)
-                            [else #f])]))
+      (super-new [label manage-dialog-name]
+                 [alignment '(right center)]
+                 [parent parent])
+      (define status
+        (new message% [label "Connecting to server..."]
+                      [parent this]
+                      [stretchable-width #t]))
+      (define comm-cust (make-custodian))
+      (define/augment (on-close)
+        (inner (void) on-close)
+        (custodian-shutdown-all comm-cust))
+      (define button
+        (new button% [label "Cancel"] [parent this]
+                     [callback (lambda (b e)
+                                 (custodian-shutdown-all comm-cust)
+                                 (show #f))]
+                     [style '(border)]))
+      (send button focus)
+      (parameterize ([current-custodian comm-cust])
+        (thread
+         (lambda ()
+           (unless (with-handlers ([void (lambda (_) #f)])
+                     (receiver (connect)) #t)
+             (begin (send status set-label "Connection failure!")
+                    ;; (send button enable #f)
+                    (sleep 5)))
+           (queue-callback (lambda () (show #f))))))
+      (center)
+      (show #t)))
+
+  (define cached-user-fields #f)
+  (define (get-user-fields parent)
+    (unless cached-user-fields
+      (new connection-dialog%
+           [receiver (lambda (h)
+                       (set! cached-user-fields (retrieve-user-fields h)))]
+           [parent parent]))
+    cached-user-fields)
 
   (define (scale-by-half file)
     (let* ([bm (make-object bitmap% file 'unknown/mask)]

collects/handin-client/handin-multi.ss

@@ -116,7 +116,7 @@
                            [stretchable-width #t] [callback callback]))])
         (button "&Submit"   (lambda _ (do-submit)))
         (button "&Retrieve" (lambda _ (do-retrieve)))
-        (button "A&ccount"  (lambda _ (manage-handin-account this)))
+        (button "A&ccount"  (lambda _ (new manage-handin-dialog% [parent this])))
         (when update (button "&Update" (lambda _ (update this #t))))
         (button "C&lose"    (lambda _ (close))))