From ea9aeec4f0be4f6ae9b4a4bbcfb852202e7c8e65 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Thu, 27 Apr 2006 20:10:21 +0000
Subject: [PATCH] more behavior improvement to make it more explicit and easier
 to disable

svn: r2821
---
 collects/version/tool.ss | 72 ++++++++++++++++++++++++----------------
 1 file changed, 44 insertions(+), 28 deletions(-)

diff --git a/collects/version/tool.ss b/collects/version/tool.ss
index 239877eee7..b4e19e90d6 100644
--- a/collects/version/tool.ss
+++ b/collects/version/tool.ss
@@ -34,26 +34,47 @@
           (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)))))
+    (define (show-message top first-time?)
+      ;; No info display if we got some non-drscheme window by accident
+      (cond
+       [(with-handlers ([void (lambda _ #f)]) (send top get-info-panel)) =>
+        (lambda (info)
+          (sleep 3) ; wait to make this appearance visible
+          (let* ([-check "Checking for updates..."]
+                 [-about "About to auto-check for updates, you can"]
+                 [p (make-object horizontal-panel% info)]
+                 [m (make-object message% (if first-time? -about -check) p)]
+                 [b (make-object button% "Disable" p disable)])
+            (send info change-children (lambda (l) (cons p (remq p l))))
+            (when first-time?
+              (let ([m1 (make-object message% "these checks" p)])
+                (sleep 20)
+                (send p change-children (lambda (l) (remq m1 l))))
+              (send m set-label -check))
+            (sleep 2) ; 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 p l)))
+                    (set! hide-message void))))
+          #t)] ; return #t so that the check starts
+       [else #f])) ; no standard window -- return #f to skip the whole thing
     ;; disable handler
     (define abort void) ; used to abort an active check
     (define (disable . _)
       (abort) (preferences:set 'updates:enabled? 'no))
+    ;; ask the question in a non-modal dialog
+    (define (question top ver)
+      (parameterize ([current-eventspace (make-eventspace)])
+        (message-box/custom
+         "Outdated PLT Version"
+         (string-append "PLT Scheme v"ver" is now available")
+         "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)))
     ;; main checker
     (define (check top)
-      (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))))])
@@ -65,14 +86,7 @@
         ;; 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" "&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)
+          (case (question top (cadr r))
             ;; go there
             [(1) (send-url "http://download.plt-scheme.org/")
                  (sleep 1)
@@ -84,16 +98,18 @@
             ;; 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)]
+      (let ([top  (wait-for-definitions)]
+            [cur  (current-seconds)]
+            [last 0 #;(preferences:get 'updates:last)]
             [freq (preferences:get 'updates:frequency)])
-        (when (> (- cur last) freq)
+        (when (and (> (- cur last) freq)
+                   (show-message top (zero? last))) ; last=0 => first-time
           (preferences:set 'updates:last cur)
-          (check (wait-for-definitions))))))
+          (check top)
+          (hide-message))))))
 
   (provide tool@)
   (define tool@