diff --git a/collects/drscheme/acks.ss b/collects/drscheme/acks.ss index 51f7a728da..e126fe4e65 100644 --- a/collects/drscheme/acks.ss +++ b/collects/drscheme/acks.ss @@ -55,6 +55,7 @@ "Philippe Meunier, " "Jens Axel Søgaard, " "Francisco Solsona, " + "Michael Sperber, " "Reini Urban, " "and " "Paolo Zoppetti " diff --git a/collects/drscheme/private/language.ss b/collects/drscheme/private/language.ss index 307fc7d50c..9bf546d2de 100644 --- a/collects/drscheme/private/language.ss +++ b/collects/drscheme/private/language.ss @@ -826,7 +826,7 @@ init-code gui? use-copy?) - + (with-handlers ([(λ (x) #f) ;exn:fail? (λ (x) (message-box diff --git a/collects/drscheme/private/tool-contracts.ss b/collects/drscheme/private/tool-contracts.ss index eb6db3177c..6655adbe4c 100644 --- a/collects/drscheme/private/tool-contracts.ss +++ b/collects/drscheme/private/tool-contracts.ss @@ -970,7 +970,7 @@ ".") (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) "Calls the MrEd primitive" "@flink put-file" @@ -1017,7 +1017,8 @@ "otherwise it will indicate the user's choice.") (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?) (program-filename @@ -1054,7 +1055,7 @@ "\\rawscm{namespace-require}. ") (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?) (program-filename @@ -1305,7 +1306,7 @@ (case-> (any/c . -> . void?) (-> any/c)))) (create-executable (any/c (union (is-a?/c dialog%) (is-a?/c frame%)) - string? + path? drscheme:teachpack:teachpack-cache? . -> . void?)) diff --git a/collects/lang/htdp-langs.ss b/collects/lang/htdp-langs.ss index ef0c96924c..9407338d93 100644 --- a/collects/lang/htdp-langs.ss +++ b/collects/lang/htdp-langs.ss @@ -20,6 +20,7 @@ tracing todo: (lib "class.ss") (lib "list.ss") (lib "file.ss") + (lib "port.ss") (lib "tool.ss" "drscheme") (lib "mred.ss" "mred") (lib "bday.ss" "framework" "private") @@ -309,7 +310,7 @@ tracing todo: (when executable-filename (let ([wrapper-filename (make-temporary-file "drs-htdp-lang-executable~a.ss")] [teachpack-specs - (map (lambda (x) `(file ,x)) + (map (lambda (x) `(file ,(path->string x))) (drscheme:teachpack:teachpack-cache-filenames teachpack-cache))]) (call-with-output-file wrapper-filename (lambda (outp) @@ -327,11 +328,7 @@ tracing todo: (fprintf outp "(module #%htdp-lang-executable #%htdp-lang-language\n") (call-with-input-file program-filename (lambda (inp) - (let loop () - (let ([c (read-char inp)]) - (unless (eof-object? c) - (display c outp) - (loop)))))) + (copy-port inp outp))) (fprintf outp "\n)\n\n") (write `(require #%htdp-lang-executable) outp) (newline outp))