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

Sync up to trunk.

Browse Source 
svn: r18291
This commit is contained in:
Stevie Strickland 2010-02-23 07:25:24 +00:00
commit 8cc22294ff
8 changed files with 3093 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/drscheme/acks.ss
View File

@ -70,16 +70,18 @@
(define (get-translating-acks) (define (get-translating-acks)
(string-append (string-append
"Thanks to " "Thanks to "
"ChongKai Zhu, "
"Ian Barland, " "Ian Barland, "
"Biep Durieux, " "Biep Durieux, "
"Tim Hanson, " "Tim Hanson, "
"Chihiro Kuraya, " "Chihiro Kuraya, "
"Philippe Meunier, " "Philippe Meunier, "
"Irina Mintiy, "
"Sergey Semerikov, "
"Jens Axel Søgaard, " "Jens Axel Søgaard, "
"Francisco Solsona, " "Francisco Solsona, "
"Mike Sperber, " "Mike Sperber, "
"Reini Urban, " "Reini Urban, "
"ChongKai Zhu, "
"and " "and "
"Paolo Zoppetti " "Paolo Zoppetti "
"for their help translating DrScheme's GUI to other languages.")) "for their help translating DrScheme's GUI to other languages."))

2
collects/scribblings/more/more.scrbl
View File

@ -358,7 +358,7 @@ if we later change @scheme[handle] so that it, say, opens a file, then
the file handles will also belong to @scheme[cust], so they will be the file handles will also belong to @scheme[cust], so they will be
reliably closed when @scheme[cust] is shut down. reliably closed when @scheme[cust] is shut down.
In fact, it's a good idea to change @scheme[serve] to that it uses a In fact, it's a good idea to change @scheme[serve] so that it uses a
custodian, too: custodian, too:
@schemeblock[ @schemeblock[

1529
collects/string-constants/russian-string-constants.ss Normal file
View File

File diff suppressed because it is too large Load Diff

34
collects/string-constants/string-constant.ss
View File

@ -11,7 +11,9 @@
(prefix portuguese: "portuguese-string-constants.ss") (prefix portuguese: "portuguese-string-constants.ss")
(prefix japanese: "japanese-string-constants.ss") (prefix japanese: "japanese-string-constants.ss")
(prefix traditional-chinese: "traditional-chinese-string-constants.ss") (prefix traditional-chinese: "traditional-chinese-string-constants.ss")
(prefix simplified-chinese: "simplified-chinese-string-constants.ss")) (prefix simplified-chinese: "simplified-chinese-string-constants.ss")
(prefix russian: "russian-string-constants.ss")
(prefix ukrainian: "ukrainian-string-constants.ss"))
(require mzlib/file (require mzlib/file
mzlib/etc mzlib/etc
@ -26,20 +28,22 @@
;; table : (listof (list symbol regexp regexp)) ;; table : (listof (list symbol regexp regexp))
;; this table indicates what the default value of the natural language ;; this table indicates what the default value of the natural language
;; preference is. the first regexp is used under Windows and the second ;; preference is. the first regexp is used under Windows and the second
;; is used on other platofmr.s All regexps are compared to the result ;; is used on other platforms. All regexps are compared to the result
;; of (system-language+country) ;; of (system-language+country)
(define table (define table
'((english #rx"^en_" #rx"^English_") '((english #rx"^en_" #rx"^English_")
(spanish #rx"^es_" #rx"^Espanol_") (spanish #rx"^es_" #rx"^Espanol_")
(german #rx"^de_" #rx"^German_") (german #rx"^de_" #rx"^German_")
(french #rx"^fr_" #rx"French_") (french #rx"^fr_" #rx"French_")
(dutch #rx"nl_" #rx"^Netherlands_") (dutch #rx"nl_" #rx"^Netherlands_")
(danish #rx"^da_DK" #rx"^Danish_") (danish #rx"^da_DK" #rx"^Danish_")
(portuguese #rx"^pt_" #rx"Portuguese_") (portuguese #rx"^pt_" #rx"Portuguese_")
(japanese #rx"^ja_" #rx"^Japan_") (japanese #rx"^ja_" #rx"^Japan_")
(traditional-chinese #rx"^zh_(HK|TW)" #rx"Chinese_China") (traditional-chinese #rx"^zh_(HK|TW)" #rx"Chinese_China")
(simplified-chinese #rx"^zh_CN" #rx"Chinese_(Hong|Taiwan)"))) (simplified-chinese #rx"^zh_CN" #rx"Chinese_(Hong|Taiwan)")
(russian #rx"^ru_" #rx"^Russian_")
(ukrainian #rx"^uk_" #rx"^Ukrainian_")))
;; default-language : -> symbol ;; default-language : -> symbol
;; uses `table' and system-language+contry to find what language to start with ;; uses `table' and system-language+contry to find what language to start with
(define (default-language) (define (default-language)
@ -67,7 +71,7 @@
(define-struct sc (language-name constants ht)) (define-struct sc (language-name constants ht))
(define available-string-constant-sets (define available-string-constant-sets
(list (list
(make-sc 'english english:string-constants #f) (make-sc 'english english:string-constants #f)
(make-sc 'spanish spanish:string-constants #f) (make-sc 'spanish spanish:string-constants #f)
(make-sc 'french french:string-constants #f) (make-sc 'french french:string-constants #f)
@ -77,7 +81,9 @@
(make-sc 'portuguese portuguese:string-constants #f) (make-sc 'portuguese portuguese:string-constants #f)
(make-sc 'japanese japanese:string-constants #f) (make-sc 'japanese japanese:string-constants #f)
(make-sc 'traditional-chinese traditional-chinese:string-constants #f) (make-sc 'traditional-chinese traditional-chinese:string-constants #f)
(make-sc 'simplified-chinese simplified-chinese:string-constants #f))) (make-sc 'simplified-chinese simplified-chinese:string-constants #f)
(make-sc 'russian russian:string-constants #f)
(make-sc 'ukrainian ukrainian:string-constants #f)))
(define first-string-constant-set (car available-string-constant-sets)) (define first-string-constant-set (car available-string-constant-sets))

1529
collects/string-constants/ukrainian-string-constants.ss Normal file
View File

File diff suppressed because it is too large Load Diff

13
collects/teachpack/2htdp/scribblings/universe.scrbl
View File

@ -589,8 +589,7 @@ A typical program does not use all three of these functions. Furthermore,
collection of all these functions is your @tech{world} program. collection of all these functions is your @tech{world} program.
@centerline{An extended example is available in @centerline{An extended example is available in
@link["http://www.ccs.neu.edu/home/matthias/HtDP2e/"]{How to Design Worlds/2e}.} @link["http://www.ccs.neu.edu/home/matthias/HtDP2e/"]{How to Design Programs/2e}.}
@; ----------------------------------------------------------------------------- @; -----------------------------------------------------------------------------
@section[#:tag "world2"]{The World is not Enough} @section[#:tag "world2"]{The World is not Enough}
@ -979,10 +978,7 @@ optional handlers:
(on-tick tick-expr) (on-tick tick-expr)
#:contracts #:contracts
([tick-expr (-> (unsyntax @tech{UniverseState}) bundle?)])]{ ([tick-expr (-> (unsyntax @tech{UniverseState}) bundle?)])]{
tell DrScheme to apply @scheme[tick-expr] to the current list of tell DrScheme to apply @scheme[tick-expr] to the current state of the universe.}
participating worlds and the current state of the
universe.
}
@defform/none[#:literals (on-tick) @defform/none[#:literals (on-tick)
(on-tick tick-expr rate-expr) (on-tick tick-expr rate-expr)
@ -990,8 +986,7 @@ optional handlers:
([tick-expr (-> (unsyntax @tech{UniverseState}) bundle?)] ([tick-expr (-> (unsyntax @tech{UniverseState}) bundle?)]
[rate-expr (and/c real? positive?)])]{ [rate-expr (and/c real? positive?)])]{
tell DrScheme to apply @scheme[tick-expr] as above but use the specified tell DrScheme to apply @scheme[tick-expr] as above but use the specified
clock tick rate instead of the default. clock tick rate instead of the default.}
}
} }
@item{ @item{
@ -1040,7 +1035,7 @@ optional handlers:
In order to explore the workings of a universe, it is necessary to launch a In order to explore the workings of a universe, it is necessary to launch a
server and several world programs on one and the same computer. We server and several world programs on one and the same computer. We
recommend launching one server out of one DrScheme tab and as many worlds recommend launching one server out of one DrScheme tab and as many worlds
as necessary out of second lab. For the latter, the teachpack provides a as necessary out of a second tab. For the latter, the teachpack provides a
special form. special form.
@defform[(launch-many-worlds expression ...)]{ @defform[(launch-many-worlds expression ...)]{

29
collects/tests/xml/test-clark.ss
View File

@ -1,13 +1,8 @@
#lang scheme #lang scheme
(require schemeunit (require schemeunit
schemeunit/private/check
schemeunit/private/test-case
schemeunit/private/test-suite
schemeunit/text-ui schemeunit/text-ui
xml xml
scheme/runtime-path) scheme/runtime-path)
(require/expose schemeunit/private/test-suite
(current-seed))
(define (validate-xml? xml) (define (validate-xml? xml)
(error 'validate-xml? "Not implemented")) (error 'validate-xml? "Not implemented"))
@ -17,26 +12,14 @@
(define (read-xml/file f) (define (read-xml/file f)
(with-input-from-file f (with-input-from-file f
(lambda () (read-xml)))) (lambda () (read-xml))))
(define (dir->test-suite d name path->test-case) (define (dir->test-suite d name path->test-case)
(make-schemeunit-test-suite (test-suite
name name
(lambda (fdown fup fhere seed) (for ([p (directory-list d)]
(parameterize #:when (let ([ext (filename-extension p)])
([current-seed seed] (and ext (bytes=? #"xml" ext))))
[current-test-case-around (test-suite-test-case-around fhere)] (path->test-case (build-path d p)))))
[current-check-around (test-suite-check-around fhere)])
(for-each (lambda (p)
(define t (path->test-case (build-path d p)))
(if (schemeunit-test-suite? t)
(current-seed (apply-test-suite t fdown fup fhere (current-seed)))
t))
(filter (lambda (p)
(define ext (filename-extension p))
(and ext (bytes=? #"xml" ext)))
(directory-list d))))
(current-seed))
void
void))
(define (not-wf-dir->test-suite d) (define (not-wf-dir->test-suite d)
(define (path->test-case f) (define (path->test-case f)

2
collects/typed-scheme/infer/infer-unit.ss
View File

@ -388,7 +388,7 @@
(cset-meet (cg e e*) (cg e* e))] (cset-meet (cg e e*) (cg e* e))]
[((Hashtable: s1 s2) (Hashtable: t1 t2)) [((Hashtable: s1 s2) (Hashtable: t1 t2))
;; the key is contravariant, the value is invariant ;; the key is contravariant, the value is invariant
(cset-meet* (list (cg t1 s1) (cg t2 s2) (cg s2 t2)))] (cset-meet* (list (cg t1 s1) (cg s1 t1) (cg t2 s2) (cg s2 t2)))]
[((Syntax: s1) (Syntax: s2)) [((Syntax: s1) (Syntax: s2))
(cg s1 s2)] (cg s1 s2)]
;; parameters are just like one-arg functions ;; parameters are just like one-arg functions