diff --git a/collects/planet/private/planet-shared.ss b/collects/planet/private/planet-shared.ss index 7964e706e3..c5ed56f516 100644 --- a/collects/planet/private/planet-shared.ss +++ b/collects/planet/private/planet-shared.ss @@ -9,6 +9,7 @@ Various common pieces of code that both the client and server need to access scheme/path scheme/port scheme/list + version/utils "../config.ss" "data.ss") @@ -254,49 +255,11 @@ Various common pieces of code that both the client and server need to access ;; Converts a string into mz-version. We need to account ;; for the change in numbering style from the 372 era to the 4.0 era. (define (string->mz-version str) - (define (minor+maint-chunks->minor chunks) - (+ (* (string->number (car chunks)) 1000) - (if (> (length chunks) 1) - (string->number (cadr chunks)) - 0))) - - (cond - ;; Old style numbering with three digits in front. The first digit - ;; goes up to three. - [(regexp-match #rx"^([0-3][0-9][0-9])\\.?([.0-9]*)$" str) - => - (lambda (ver) - (let ([major (string->number (list-ref ver 1))]) - (cond - [(= (string-length (list-ref ver 2)) 0) - (make-mz-version major 0)] - [else - (let* ([minor+maint (regexp-split #rx"\\." (list-ref ver 2))] - [minor (minor+maint-chunks->minor minor+maint)]) - (make-mz-version major minor))])))] - ;; New style numbering - [(regexp-match #rx"^([0-9]+)(\\.([.0-9]+))?$" str) - => - (lambda (ver) - (cond [(list-ref ver 3) - (let* ([chunks (regexp-split #rx"\\." (list-ref ver 3))]) - (and (andmap (λ (x) (not (equal? x ""))) chunks) - (make-mz-version (+ (* (string->number (list-ref ver 1)) - 100) - (if (> (length chunks) 0) - (begin - (string->number (car chunks))) - 0)) - (if (> (length (cdr chunks)) 0) - (minor+maint-chunks->minor (cdr chunks)) - 0))))] - [else - (make-mz-version (* (string->number (list-ref ver 1)) - 100) - 0)]))] - [else #f])) - - + (cond [(version->integer str) + => (lambda (v) + (let-values ([(q r) (quotient/remainder v 1000000)]) + (make-mz-version q r)))] + [else #f])) ;; version<= : mz-version mz-version -> boolean ;; determines if a is the version string of an earlier mzscheme release than b diff --git a/collects/planet/private/test.ss b/collects/planet/private/test.ss deleted file mode 100644 index 8d5f08fec5..0000000000 --- a/collects/planet/private/test.ss +++ /dev/null @@ -1,38 +0,0 @@ -#lang scheme - -(require "planet-shared.ss") - -(define-syntax (test stx) - (syntax-case stx () - [(_ a b) - (with-syntax ([line (syntax-line stx)] - [file (let ([s (syntax-source stx)]) - (if (string? s) - s - "<>"))]) - #`(test/proc file line a b))])) - -(define (test/proc file line got expected) - (unless (equal? got expected) - (error 'test.ss "FAILED ~a: ~s\n got ~s\nexpected ~s" file line got expected))) - - -(test (string->mz-version "372") - (make-mz-version 372 0)) - -(test (string->mz-version "372.2") - (make-mz-version 372 2000)) - -(test (string->mz-version "4.0") - (make-mz-version 400 0)) - -(test (string->mz-version "4.1") - (make-mz-version 401 0)) - -(test (string->mz-version "4.0.1") - (make-mz-version 400 1000)) - -(test (string->mz-version "4..1") - #f) - -(printf "tests passed\n") diff --git a/collects/planet/util.ss b/collects/planet/util.ss index 9d30ff7c69..1968fe2f16 100644 --- a/collects/planet/util.ss +++ b/collects/planet/util.ss @@ -22,6 +22,8 @@ setup/getinfo setup/unpack + version/utils + (prefix-in srfi1: srfi/1) (for-syntax scheme/base)) @@ -664,8 +666,7 @@ ;; core-version : string -> boolean ;; determines if the given string is something that (version) could've produced (define (core-version? s) - (and (string? s) - (string->mz-version s))) + (and (version->integer s) #t)) ;; checkinfo: syntax ;; given an info.ss function, a failure function, and a bunch of fields to check, diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index 77b6f15a8a..aaaf6a2d30 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -1011,8 +1011,16 @@ `(span ([class "mywbr"]) " ")) (render-other (substring i (cdar m)) part ri)) (ascii-ize i)))] - [(eq? i 'mdash) `(" " ndash " ")] - [(symbol? i) (list i)] + [(symbol? i) + (case i + [(mdash) '(" " ndash " ")] + ;; use "single left/right-pointing angle quotation mark" + ;; -- it's not a correct choice, but works best for now + ;; (see the "Fonts with proper angle brackets" + ;; discussion on the mailing list from June 2008) + [(lang) '(8249)] + [(rang) '(8250)] + [else (list i)])] [else (list (format "~s" i))])) (define/private (ascii-ize s)