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

Check for updates menu item

Browse Source 
svn: r3187
This commit is contained in:
Eli Barzilay 2006-06-02 19:05:54 +00:00
parent 3ed19d8855
commit 97375b0e74
12 changed files with 138 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/string-constants/danish-string-constants.ss
View File

@ -640,7 +640,6 @@ please adhere to these guidelines:
(help-menu-label "&Hjælp")
(about-info "Akkrediteringer og detaljer om dette program")
(about-menu-item "Om...")
(help-menu-check-for-updates "Undersøg, om der er opdateringer...")
;; open here's new menu item
(create-new-window-or-clear-current
@ -993,6 +992,8 @@ please adhere to these guidelines:
(kill? "Ihjel?")
;;; version checker
(version:update-menu-item "Undersøg, om der er opdateringer...")
(version:update-check "Opdateringstjek")
;; special menu
(special-menu "Speciel")

3
collects/string-constants/dutch-string-constants.ss
View File

@ -444,7 +444,6 @@
(help-menu-label "&Hulp")
(about-info "Credits and details for this application") ; <**>
(about-menu-item "Info...")
(help-menu-check-for-updates "Recentere versies...")
;;; help-desk-specific menus
(new-help-desk "Nieuwe Hulpbron")
@ -700,6 +699,8 @@
(kill? "Beëindigen?")
;;; version checker
(version:update-menu-item "Recentere versies...")
(version:update-check "Versie bijwerken")
;; special menu
(special-menu "Invoegen")

15
collects/string-constants/english-string-constants.ss
View File

@ -648,7 +648,6 @@ please adhere to these guidelines:
(help-menu-label "&Help")
(about-info "Credits and details for this application")
(about-menu-item "About...")
(help-menu-check-for-updates "Check for Updates...")
;; open here's new menu item
(create-new-window-or-clear-current
@ -1015,9 +1014,17 @@ please adhere to these guidelines:
(kill? "Kill?")
;;; version checker
;; the next two are used in the initial wizard dialog.
;; Note that vc-wizard-check-prompt can (should) have newlines so
;; it will not make the dialog too wide.
(version:update-menu-item "Check for Updates...")
(version:update-check "Update check") ; dialog title, with the next line
(version:connecting-server "Connecting to PLT version server")
(version:results-title "PLT Version Check")
(version:do-periodic-checks "Periodically check for newer PLT Scheme versions")
(version:take-me-there "Take Me There") ; ...to the download website
;; the next one can appear alone, or followed by a comma and the one after that
(version:plt-up-to-date "Your PLT version is up-to-date")
(version:but-newer-alpha "but note that there is a newer alpha-release")
;; This is used in this context: "PLT Scheme vNNN <<<*>>> http://download..."
(version:now-available-at "is now available at")
;; special menu
(special-menu "S&pecial")

6
collects/string-constants/french-string-constants.ss
View File

@ -648,7 +648,6 @@
(help-menu-label "&Aide")
(about-info "Auteurs et détails concernant ce logiciel.")
(about-menu-item "A propos de ...")
(help-menu-check-for-updates "Regarder les mises à jour...")
;; open here's new menu item
(create-new-window-or-clear-current
@ -1004,9 +1003,8 @@
(kill? "Tuer ?")
;;; version checker
;; the next two are used in the initial wizard dialog.
;; Note that vc-wizard-check-prompt can (should) have newlines so
;; it will not make the dialog too wide.
(version:update-menu-item "Regarder les mises à jour...")
(version:update-check "Vérification des mises à jour")
;; special menu
(special-menu "Spécial")

6
collects/string-constants/german-string-constants.ss
View File

@ -543,7 +543,6 @@
(help-menu-label "&Hilfe")
(about-info "Mehr über dieses Programm und seine Entstehung")
(about-menu-item "Über...")
(help-menu-check-for-updates "Nach Updates schauen...")
;; open here's new menu item
(create-new-window-or-clear-current
@ -896,9 +895,8 @@
(kill? "Abbrechen?")
;;; version checker
;; the next two are used in the initial wizard dialog.
;; Note that vc-wizard-check-prompt can (should) have newlines so
;; it will not make the dialog too wide.
(version:update-menu-item "Nach Updates schauen...")
(version:update-check "Update-Prüfung")
;; special menu
(special-menu "S&pezial")

5
collects/string-constants/japanese-string-constants.ss
View File

@ -639,7 +639,6 @@ please adhere to these guidelines:
(help-menu-label "ヘルプ(&H)")
(about-info "このアプリケーションの著作権と詳細情報を表示します")
(about-menu-item "バージョン情報...")
(help-menu-check-for-updates "アップデートの確認...")
;; open here's new menu item
(create-new-window-or-clear-current
@ -989,9 +988,7 @@ please adhere to these guidelines:
(kill? "強制終了？")
;;; version checker
;; the next two are used in the initial wizard dialog.
;; Note that vc-wizard-check-prompt can (should) have newlines so
;; it will not make the dialog too wide.
(version:update-menu-item "アップデートの確認...")
;; special menu
(special-menu "特殊(&P)")

4
collects/string-constants/portuguese-string-constants.ss
View File

@ -633,7 +633,6 @@ please adhere to these guidelines:
(help-menu-label "&Ajuda")
(about-info "Credits and details for this application")
(about-menu-item "Sobre...")
(help-menu-check-for-updates "Check for Updates...")
;; open here's new menu item
(create-new-window-or-clear-current
@ -961,9 +960,6 @@ please adhere to these guidelines:
(kill? "Kill?")
;;; version checker
;; the next two are used in the initial wizard dialog.
;; Note that vc-wizard-check-prompt can (should) have newlines so
;; it will not make the dialog too wide.
;; special menu
(special-menu "S&pecial")

5
collects/string-constants/simplified-chinese-string-constants.ss
View File

@ -563,7 +563,6 @@
(help-menu-label "帮助(&H)")
(about-info "本程序的详细信息以及致谢名单")
(about-menu-item "关于...")
(help-menu-check-for-updates "检查更新...")
;; open here's new menu item
(create-new-window-or-clear-current
@ -853,9 +852,7 @@
(kill? "终止？")
;;; version checker
;; the next two are used in the initial wizard dialog.
;; Note that vc-wizard-check-prompt can (should) have newlines so
;; it will not make the dialog too wide.
(version:update-menu-item "检查更新...")
;; special menu
(special-menu "特殊符号(&P)")

9
collects/string-constants/spanish-string-constants.ss
View File

@ -547,7 +547,6 @@
(help-menu-label "&Ayuda")
(about-info "Créditos y detalles de esta apliación")
(about-menu-item "Acerca ...")
(help-menu-check-for-updates "Buscando Actualizaciones...")
;;; help-desk-specific menus
;; open here's new menu item
@ -898,11 +897,9 @@
(kill "Terminar")
(kill? "¿Terminar?")
;; version checker
;; vc-check-prompt is gone, I'm leaving this comment to make it easier to generate
;; vc-wizard-check-note which is similar, only it is used as part of the initial
;; wizard dialog. Note that vc-wizard-check-prompt can (should) have newlines so
;; it will not make the dialog too wide.
;;; version checker
(version:update-menu-item "Buscando Actualizaciones...")
(version:update-check "Revisar Actualización")
;; special menu
(special-menu "Especial")

5
collects/string-constants/traditional-chinese-string-constants.ss
View File

@ -560,7 +560,6 @@
(help-menu-label "幫助(&H)")
(about-info "本程式的詳細信息以及致謝名單")
(about-menu-item "關於...")
(help-menu-check-for-updates "檢查更新...")
;; open here's new menu item
(create-new-window-or-clear-current
@ -850,9 +849,7 @@
(kill? "終止？")
;;; version checker
;; the next two are used in the initial wizard dialog.
;; Note that vc-wizard-check-prompt can (should) have newlines so
;; it will not make the dialog too wide.
(version:update-menu-item "檢查更新...")
;; special menu
(special-menu "特殊符號(&P)")

1
collects/version/check.ss
View File

@ -48,6 +48,7 @@
(with-handlers ([void (lambda (e) (err error-message e))]) expr)]))
;; Get server information, carefully
(define version-info
'((stable "310") (recent "310")) #;
(parameterize ([current-input-port
(try (url->port (format "~a?~a" version-url (version)))
"could not connect to website")])

166
collects/version/tool.ss
View File

@ -4,9 +4,12 @@
(lib "framework.ss" "framework")
(lib "mred.ss" "mred")
(lib "class.ss")
(lib "list.ss")
"patchlevel.ss" "check.ss"
(lib "external.ss" "browser"))
"patchlevel.ss"
"check.ss"
(lib "external.ss" "browser")
(lib "string-constant.ss" "string-constants"))
(define download-url "http://download.plt-scheme.org/")
;; either 'yes, 'no, or something else, see `enabled?' below for a reason
(preferences:set-default 'updates:enabled? 'unset symbol?)
@ -22,19 +25,24 @@
;; 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)
(define (is-enabled? v)
(case v [(yes) #t] [(no) #f] [else #f])) ; default to #f
(define (check-for-updates)
(define (check-for-updates . top?)
(define enabled? (is-enabled? (preferences:get 'updates:enabled?)))
(define explicit? (pair? top?)) ; top => explicit check for updates
(define top (and (pair? top?) (car top?)))
;; 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))))
#| ;; Cute code, but may resize the window if too much space, and people
;; didn't like this way of asking if you want update checks.
;; show a message and a disable button
(define hide-message void) ; set by show-message
(define (show-message top first-time?)
(define (show-message 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)) =>
@ -59,57 +67,98 @@
(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)))
|#
;; show results in a dialog in a non-modal dialog (if it was not an
;; explicit call) , so the window can be left around as a reminder.
(define (message style fmt . args)
(define (run)
(let-values ([(result new-enabled?)
(message+check-box/custom
(string-constant version:results-title)
(apply format fmt args)
(string-constant version:do-periodic-checks)
(string-constant ok)
(and (eq? 'newer style)
(string-constant version:take-me-there))
#f
(and explicit? top)
`(,@(case style
[(#f) '()] [(newer) '(stop)] [else (list style)])
,@(if enabled? '(checked) '())
default=1))])
(unless (eq? enabled? new-enabled?)
(preferences:set 'updates:enabled? (if new-enabled? 'yes 'no))
(set! enabled? new-enabled?))
result))
(if explicit?
(run)
;; non-modal
(parameterize ([current-eventspace (make-eventspace)]) (run))))
;; main checker
(define (check top)
(let ([r #f])
(define (check)
(let ([result #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 (question top (cadr r))
;; 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
))))
(let* ([d #f]
[t (thread (lambda ()
(set! result (check-version))
(when d (send d show #f))))])
(unless (sync/timeout .4 t) ; still checking, pop message
(when explicit? ; unless it's an automatic check
(queue-callback
(lambda ()
(set! d (new (class dialog%
(super-new
[label (string-constant version:update-check)]
[parent #f])
(make-object message%
(string-constant version:connecting-server)
this)
(make-object button% (string-constant abort) this
(lambda (b e)
(kill-thread t)
(send this show #f))
'(border))
(send this center))))
(send d show #t)))
(sleep/yield .5))
(thread-wait t)))
(cond
[(and (pair? result) (eq? 'newer (car result)))
(when (equal? 2 (message 'newer "PLT Scheme v~a ~a ~a"
(cadr result)
(string-constant version:now-available-at)
download-url))
;; 2 = go there
(send-url download-url)
;; (sleep 1) ((application-quit-handler))
)]
;; implicit auto-check => show a message only if there is a newer
;; version => the rest are only for explicit calls
[(not explicit?) (void)]
[(eq? result 'ok)
(message #f (string-constant version:plt-up-to-date))]
[(not (pair? result)) (void)] ; either #f (canceled) or ok
[else (case (car result)
[(error)
(message 'stop "~a: ~a~a"
(string-constant error) (cadr result)
(if (pair? (cddr result))
(string-append "\n" (caddr result)) ""))]
[(ok-but)
(message 'caution "~a,\n~a (v~a)"
(string-constant version:plt-up-to-date)
(string-constant version:but-newer-alpha)
(cadr result))]
[else (error 'check-for-updates "internal error")])])))
;; start the check if enabled and enough time passed
(when (enabled? (preferences:get 'updates:enabled?))
(let ([top (wait-for-definitions)]
[cur (current-seconds)]
(when (or explicit? enabled?)
(unless top (set! top (wait-for-definitions)))
(let ([cur (current-seconds)]
[last (preferences:get 'updates:last)]
[freq (preferences:get 'updates:frequency)])
(when (and (> (- cur last) freq)
(show-message top (zero? last))) ; last=0 => first-time
(when (or explicit? (> (- cur last) freq))
(preferences:set 'updates:last cur)
(check top)
(hide-message)))))
(check)))))
(provide tool@)
(define tool@
@ -120,15 +169,24 @@
(preferences:add-to-warnings-checkbox-panel
(lambda (panel)
(let ([b (make-object check-box%
"Periodically check for newer PLT Scheme versions"
(string-constant version:do-periodic-checks)
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))))
(lambda (p v) (send b set-value (is-enabled? v))))
(send b set-value
(enabled? (preferences:get 'updates:enabled?))))))
(is-enabled? (preferences:get 'updates:enabled?))))))
(drscheme:get/extend:extend-unit-frame
(lambda (f%)
(class f%
(define/override (help-menu:after-about m)
(make-object menu-item%
(string-constant version:update-menu-item) m
(lambda (b e) (check-for-updates this)))
(super help-menu:after-about m))
(super-new))))
(thread check-for-updates))
(when (> patchlevel 0) (version:add-spec 'p patchlevel)))))