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

fixed some bugs allowing executables to be created

Browse Source 
svn: r1510
This commit is contained in:
Robby Findler 2005-12-03 04:38:32 +00:00
parent f70f6c2332
commit ec2b43ad86
4 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/drscheme/acks.ss
View File

@ -55,6 +55,7 @@
"Philippe Meunier, " "Philippe Meunier, "
"Jens Axel Søgaard, " "Jens Axel Søgaard, "
"Francisco Solsona, " "Francisco Solsona, "
"Michael Sperber, "
"Reini Urban, " "Reini Urban, "
"and " "and "
"Paolo Zoppetti " "Paolo Zoppetti "

2
collects/drscheme/private/language.ss
View File

@ -826,7 +826,7 @@
init-code init-code
gui? gui?
use-copy?) use-copy?)
(with-handlers ([(λ (x) #f) ;exn:fail? (with-handlers ([(λ (x) #f) ;exn:fail?
(λ (x) (λ (x)
(message-box (message-box

9
collects/drscheme/private/tool-contracts.ss
View File

@ -970,7 +970,7 @@
".") ".")
(drscheme:language:put-executable (drscheme:language:put-executable
((is-a?/c top-level-window<%>) string? boolean? boolean? string? . -> . (union false/c string?)) ((is-a?/c top-level-window<%>) path? boolean? boolean? string? . -> . (union false/c path?))
(parent program-filename mred? launcher? title) (parent program-filename mred? launcher? title)
"Calls the MrEd primitive" "Calls the MrEd primitive"
"@flink put-file" "@flink put-file"
@ -1017,7 +1017,8 @@
"otherwise it will indicate the user's choice.") "otherwise it will indicate the user's choice.")
(drscheme:language:create-module-based-stand-alone-executable (drscheme:language:create-module-based-stand-alone-executable
(string? string? any/c any/c any/c boolean? boolean? ((union path? string?)
(union path? string?) any/c any/c any/c boolean? boolean?
. -> . . -> .
void?) void?)
(program-filename (program-filename
@ -1054,7 +1055,7 @@
"\\rawscm{namespace-require}. ") "\\rawscm{namespace-require}. ")
(drscheme:language:create-module-based-launcher (drscheme:language:create-module-based-launcher
(string? string? any/c any/c any/c boolean? boolean? ((union path? string?) (union path? string?) any/c any/c any/c boolean? boolean?
. -> . . -> .
void?) void?)
(program-filename (program-filename
@ -1305,7 +1306,7 @@
(case-> (any/c . -> . void?) (-> any/c)))) (case-> (any/c . -> . void?) (-> any/c))))
(create-executable (any/c (create-executable (any/c
(union (is-a?/c dialog%) (is-a?/c frame%)) (union (is-a?/c dialog%) (is-a?/c frame%))
string? path?
drscheme:teachpack:teachpack-cache? drscheme:teachpack:teachpack-cache?
. -> . . -> .
void?)) void?))

9
collects/lang/htdp-langs.ss
View File

@ -20,6 +20,7 @@ tracing todo:
(lib "class.ss") (lib "class.ss")
(lib "list.ss") (lib "list.ss")
(lib "file.ss") (lib "file.ss")
(lib "port.ss")
(lib "tool.ss" "drscheme") (lib "tool.ss" "drscheme")
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
(lib "bday.ss" "framework" "private") (lib "bday.ss" "framework" "private")
@ -309,7 +310,7 @@ tracing todo:
(when executable-filename (when executable-filename
(let ([wrapper-filename (make-temporary-file "drs-htdp-lang-executable~a.ss")] (let ([wrapper-filename (make-temporary-file "drs-htdp-lang-executable~a.ss")]
[teachpack-specs [teachpack-specs
(map (lambda (x) `(file ,x)) (map (lambda (x) `(file ,(path->string x)))
(drscheme:teachpack:teachpack-cache-filenames teachpack-cache))]) (drscheme:teachpack:teachpack-cache-filenames teachpack-cache))])
(call-with-output-file wrapper-filename (call-with-output-file wrapper-filename
(lambda (outp) (lambda (outp)
@ -327,11 +328,7 @@ tracing todo:
(fprintf outp "(module #%htdp-lang-executable #%htdp-lang-language\n") (fprintf outp "(module #%htdp-lang-executable #%htdp-lang-language\n")
(call-with-input-file program-filename (call-with-input-file program-filename
(lambda (inp) (lambda (inp)
(let loop () (copy-port inp outp)))
(let ([c (read-char inp)])
(unless (eof-object? c)
(display c outp)
(loop))))))
(fprintf outp "\n)\n\n") (fprintf outp "\n)\n\n")
(write `(require #%htdp-lang-executable) outp) (write `(require #%htdp-lang-executable) outp)
(newline outp)) (newline outp))