suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added auto-check functionality, off by default.

Browse Source 
svn: r1484
This commit is contained in:
Eli Barzilay 2005-12-02 08:46:05 +00:00
parent e06af1b483
commit 9a816b8944
2 changed files with 87 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/version/doc.txt
View File

@ -22,7 +22,7 @@ your current state -- one of these:
You have an old-but-stable version, please upgrade to `version';
you may consider also the newer alpha version
* `(error ,message [,additional-info])
An error occured, the message is a string that indicates the
An error occurred, the message is a string that indicates the
error.
The third (optional) value is a string that can be shown as the
system error that happened. This string will always be
@ -36,6 +36,12 @@ _patchlevel_ module. This module provides a single value:
which is an integer that indicates the current patch level. This is
normally zero, but may be updated by patches to DrScheme.
Furthermore, the "tool.ss" module makes this patchlevel appear in
DrScheme (but the binary version as reported by `(version)' is not
changed).
Finally, the "tool.ss" makes DrScheme use both features:
* the patchlevel appears as a version `pN' suffix in DrScheme (but the
binary version as reported by `(version)' is not changed);
* it is possible to periodically check whether a new PLT Scheme
distribution is available for download.

82
collects/version/tool.ss
View File

@ -1,13 +1,85 @@
(module tool mzscheme
(require (lib "tool.ss" "drscheme")
(lib "unitsig.ss")
(lib "framework.ss" "framework"))
(require "patchlevel.ss")
(lib "framework.ss" "framework")
(lib "mred.ss" "mred")
(lib "class.ss")
"patchlevel.ss" "check.ss"
(lib "external.ss" "browser"))
;; either 'yes, 'no, or something else, see `enabled?' below for a reason
(preferences:set-default 'updates:enabled? 'unset symbol?)
(preferences:set-default 'updates:last 0 integer?)
;; how often do we check; default: check every three days
(preferences:set-default 'updates:frequency (* 60 60 24 3) integer?)
;; time to wait if user chooses "later"; default: in a week
(define later-delay (* 60 60 24 3))
;; This is used to check if updates:enabled? is true or false. The problem
;; is that we don't want to set a default of #t or #f, so make it 'unset and
;; change it only when users explicitly set it. This makes it possible to
;; have the default be #f, but without making it always #f for all users, and
;; in the future it is possible to change it to default to a different
;; default.
(define (enabled? v)
(case v [(yes) #t] [(no) #f] [else #f])) ; default to #f
(define (check-for-updates)
;; wait until the definitions are instantiated, return top-level window
(define (wait-for-definitions)
(let ([ws (get-top-level-windows)])
(if (null? ws)
(begin (sleep 1) (wait-for-definitions))
(car ws))))
(define (check top)
(let ([r (check-version)])
;; 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)))
(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)
;; go there
[(1) (send-url "http://download.plt-scheme.org/")
(sleep 1)
((application-quit-handler))]
;; later
[(2) (preferences:set 'updates:last
(- (+ (current-seconds) later-delay)
(preferences:get 'updates:frequency)))]
;; disable
[(3) (preferences:set 'updates:enabled? 'no)]
;; only other option is escape -- check again in the normal time
))))
(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)
(check (wait-for-definitions))))))
(provide tool@)
(define tool@
(unit/sig drscheme:tool-exports^
(import drscheme:tool^)
(define (phase1) (void))
(define (phase2) (void))
(when (> patchlevel 0)
(version:add-spec 'p patchlevel)))))
(define (phase2)
(preferences:add-to-warnings-checkbox-panel
(lambda (panel)
(let ([b (make-object check-box%
"Check for newer PLT Scheme versions"
panel
(lambda (b e)
(preferences:set 'updates:enabled?
(if (send b get-value) 'yes 'no))))])
(preferences:add-callback
'updates:enabled?
(lambda (p v) (send b set-value (enabled? v))))
(send b set-value
(enabled? (preferences:get 'updates:enabled?))))))
(thread check-for-updates))
(when (> patchlevel 0) (version:add-spec 'p patchlevel)))))