From b8b78d43492ce3d273e6333e408a1a5859623fba Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Thu, 27 Apr 2006 16:08:45 +0000
Subject: [PATCH] use a status-bar notification

svn: r2816
---
 collects/version/check.ss |  2 +-
 collects/version/tool.ss  | 50 +++++++++++++++++++++++++++++++--------
 2 files changed, 41 insertions(+), 11 deletions(-)

diff --git a/collects/version/check.ss b/collects/version/check.ss
index 6e0d6b648d..25697e2c55 100644
--- a/collects/version/check.ss
+++ b/collects/version/check.ss
@@ -64,7 +64,7 @@
                            version-info))
         (err "bad response from server" version-info))
       ;; Make a decision
-      (let ([current (version)]
+      (let ([current "300"#;(version)]
             [stable (get 'stable)]
             [recent (get 'recent)])
         (cond
diff --git a/collects/version/tool.ss b/collects/version/tool.ss
index a8f4415e5b..7aa91026d8 100644
--- a/collects/version/tool.ss
+++ b/collects/version/tool.ss
@@ -4,6 +4,7 @@
            (lib "framework.ss" "framework")
            (lib "mred.ss" "mred")
            (lib "class.ss")
+           (lib "list.ss")
            "patchlevel.ss" "check.ss"
            (lib "external.ss" "browser"))
 
@@ -31,20 +32,47 @@
         (if (null? ws)
           (begin (sleep 1) (wait-for-definitions))
           (car ws))))
+    ;; show a message and a disable button
+    (define hide-message void) ; set by show-message
+    (define (show-message top)
+      (sleep 3) ; wait to make this appearance visible
+      (let* ([info    (send top get-info-panel)]
+             [panel   (make-object horizontal-panel% info)]
+             [message (make-object message% "Checking for updates..." panel)]
+             [button  (make-object button% "Disable" panel disable)])
+        (send info change-children (lambda (l) (cons panel (remq panel l))))
+        (sleep 1) ; wait before and after check to make it visible
+        (set! hide-message
+              (lambda now?
+                (unless (and (pair? now?) (car now?)) (sleep 1))
+                (send info change-children (lambda (l) (remq panel l)))
+                (set! hide-message void)))))
+    ;; disable handler
+    (define abort void) ; used to abort an active check
+    (define (disable . _)
+      (abort) (preferences:set 'updates:enabled? 'no))
+    ;; main checker
     (define (check top)
-      ;; some wants a non-modal dialog that can be pushed back as a reminder
-      ;; instead of dismiss
-      (set! top #f)
-      (let ([r (check-version)])
+      (show-message top)
+      (let ([r #f])
+        ;; run the check in a thread, with a chance to abort it
+        (let ([t (thread (lambda () (set! r (check-version))))])
+          (set! abort (lambda () (kill-thread t)))
+          (thread-wait t)
+          (set! abort void))
         ;; do nothing if we have a good version, if there was an error, or if
         ;; there is a suggested alpha -- only show a message if there is a
         ;; newer version
         (when (and (pair? r) (eq? 'newer (car r)))
+          (hide-message 'now)
           (case (message-box/custom
                  "Outdated PLT Version"
                  (string-append "PLT Scheme v"(cadr r)" is now available")
-                 "Quit && &Take Me There" "Remind Me &Later" "&Stop Checking"
-                 top '(default=2) #f)
+                 "Quit && &Take Me There" "Remind Me &Later" "&Disable Checking"
+                 ;; don't use `top' for the parent -- some wants a non-modal
+                 ;; dialog that can be pushed back as a reminder instead of
+                 ;; dismissed
+                 #f '(default=2) #f)
             ;; go there
             [(1) (send-url "http://download.plt-scheme.org/")
                  (sleep 1)
@@ -56,13 +84,15 @@
             ;; disable
             [(3) (preferences:set 'updates:enabled? 'no)]
             ;; only other option is escape -- check again in the normal time
-            ))))
+            )))
+      (hide-message))
+    ;; start the check if enabled and enough time passed
     (when (enabled? (preferences:get 'updates:enabled?))
       (let ([cur  (current-seconds)]
             [last (preferences:get 'updates:last)]
             [freq (preferences:get 'updates:frequency)])
-        (when (> (- cur last) freq)
-          (preferences:set 'updates:last cur)
+        (when '(> (- cur last) freq)
+          '(preferences:set 'updates:last cur)
           (check (wait-for-definitions))))))
 
   (provide tool@)
@@ -74,7 +104,7 @@
         (preferences:add-to-warnings-checkbox-panel
          (lambda (panel)
            (let ([b (make-object check-box%
-                      "Check for newer PLT Scheme versions"
+                      "Periodically check for newer PLT Scheme versions"
                       panel
                       (lambda (b e)
                         (preferences:set 'updates:enabled?