Permalink
Browse files

Racketize the `version' collection.

Also some other style things, and get rid of the redundant "doc.txt".
  • Loading branch information...
1 parent 303aaec commit 2c058f5f03e9c54f0289c38b458c819ea58b8669 @elibarzilay elibarzilay committed Jun 20, 2012
View
@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang racket/base
(define version-url "http://download.racket-lang.org/version.txt")
(define timeout 30)
@@ -13,9 +13,9 @@
(require scheme/tcp)
(define (url->port url)
- (define-values (host path)
+ (define-values [host path]
(apply values (cdr (regexp-match #rx"^http://([^/:@]+)(/.*)$" url))))
- (define-values (i o) (tcp-connect host 80))
+ (define-values [i o] (tcp-connect host 80))
(fprintf o "GET ~a HTTP/1.0\r\nHost: ~a\r\n\r\n" path host)
(flush-output o)
(close-output-port o)
@@ -27,29 +27,26 @@
(case-lambda
[(what) `(error ,what)]
[(what more)
- `(error ,what
- ,(cond [(list? more) (format "~a" more)]
- [(exn? more) (format "(~a)" (exn-message more))]
- [else (format "(~a)" more)]))]))
+ `(error ,what ,(cond [(list? more) (format "~a" more)]
+ [(exn? more) (format "(~a)" (exn-message more))]
+ [else (format "(~a)" more)]))]))
(define (with-timeout timeout thunk)
(define result #f)
- (let ([r (sync/timeout timeout
- (thread (lambda ()
- (set! result
- (with-handlers
- ([void (lambda (e)
- (error-value "internal error" e))])
- (thunk))))))])
- (if r result (error-value "timeout"))))
+ (define r (sync/timeout timeout
+ (thread (λ ()
+ (set! result
+ (with-handlers
+ ([void (λ (e)
+ (error-value "internal error" e))])
+ (thunk)))))))
+ (if r result (error-value "timeout")))
(define (check-version-raw)
(let/ec escape
(define (err . args) (escape (apply error-value args)))
- (define-syntax try
- (syntax-rules ()
- [(_ expr error-message)
- (with-handlers ([void (lambda (e) (err error-message e))]) expr)]))
+ (define-syntax-rule (try expr error-message)
+ (with-handlers ([void (λ (e) (err error-message e))]) expr))
;; Get server information, carefully
(define version-info
(parameterize ([current-input-port
@@ -60,38 +57,35 @@
(cond [(assq key version-info) => cadr]
[else (err (format "no `~s' in response" key) version-info)]))
(define (getver key)
- (let ([ver (get key)])
- (if (valid-version? ver)
- ver
- (err "bad version string from server" key))))
+ (define ver (get key))
+ (if (valid-version? ver) ver (err "bad version string from server" key)))
(unless (and (list? version-info)
- (andmap (lambda (x)
- (and (list? x)
- (= 2 (length x))
- (symbol? (car x))
- (string? (cadr x))))
+ (andmap (λ (x) (and (list? x)
+ (= 2 (length x))
+ (symbol? (car x))
+ (string? (cadr x))))
version-info))
(err "bad response from server" version-info))
;; Make a decision
- (let ([current (version)]
- [stable (getver 'stable)]
- [recent (getver 'recent)])
- (cond
- ;; we have the newest version (can be > if we have a build from git)
- [(version<=? recent current) 'ok]
- ;; we're stable, but there's a newer version
- [(version<=? stable current) `(ok-but ,recent)]
- ;; new version out -- no alphas or we have an alpha => show recent
- [(or (equal? recent stable)
- (and (alpha-version? current)
- ;; but if we have an alpha that is older then the current
- ;; stable then go to the next case
- (version<=? stable current)))
- `(newer ,recent)]
- ;; new version out, we have an outdated stable, there is also an alpha
- ;; (alternatively, we have an alpha that is older than the current
- ;; stable)
- [else `(newer ,stable ,recent)]))))
+ (define current (version))
+ (define stable (getver 'stable))
+ (define recent (getver 'recent))
+ (cond
+ ;; we have the newest version (can be > if we have a build from git)
+ [(version<=? recent current) 'ok]
+ ;; we're stable, but there's a newer version
+ [(version<=? stable current) `(ok-but ,recent)]
+ ;; new version out -- no alphas or we have an alpha => show recent
+ [(or (equal? recent stable)
+ (and (alpha-version? current)
+ ;; but if we have an alpha that is older then the current
+ ;; stable then go to the next case
+ (version<=? stable current)))
+ `(newer ,recent)]
+ ;; new version out, we have an outdated stable, there is also an alpha
+ ;; (alternatively, we have an alpha that is older than the current
+ ;; stable)
+ [else `(newer ,stable ,recent)])))
;; Check the version on the server and compare to our version. Possible return
;; values (message is always a string):
View
@@ -1,47 +0,0 @@
-_version_: Racket version checking
-==================================
-
-The version collection contains several version-related pieces that
-are used by Racket. First, the "check.ss" module provides a single
-function:
-
-> (check-version)
-
-This procedure checks the currently available version on the Racket
-website (doanload.racket-lang.org), and returns a value that indicates
-your current state -- one of these:
-
- * `ok
- You're fine.
- * `(ok-but ,version)
- You have a fine stable version, but note that there is a newer
- alpha version available
- * `(newer ,version)
- You have an old version, please upgrade to `version'
- * `(newer ,version ,alpha)
- 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 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
- parenthesized, so `message' is a short error and
- `(string-append message " " additional-info)' is a verbose one.
-
-The second functionality that is provided by this collection is in the
-_patchlevel_ module. This module provides a single value:
-
-> patchlevel
-
-which is an integer that indicates the current patch level. This is
-normally zero, but may be updated by patches to DrRacket.
-
-
-Finally, the "tool.rkt" makes DrRacket use both features:
-
-* the patchlevel appears as a version `pN' suffix in DrRacket (but the
- binary version as reported by `(version)' is not changed);
-
-* it is possible to periodically check whether a new Racket
- distribution is available for download.
@@ -1,5 +1,5 @@
;; This file contains the current patch level of Racket.
;; It is usually `0' in the repository, changes only when a patch is made.
-#lang scheme/base
+#lang racket/base
(define patchlevel 0)
(provide patchlevel)
Oops, something went wrong.

0 comments on commit 2c058f5

Please sign in to comment.