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

new Create Executable in DrScheme

Browse Source 
svn: r3178
This commit is contained in:
Matthew Flatt 2006-06-02 11:52:48 +00:00
parent 5a7c97279a
commit 09d6dd95cf
18 changed files with 519 additions and 211 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
collects/compiler/bundle-dist.ss Normal file
View File

@ -0,0 +1,93 @@
(module bundle-dist mzscheme
(require (lib "etc.ss")
(lib "file.ss")
(lib "process.ss")
(lib "zip.ss")
(lib "tar.ss"))
(provide bundle-put-file-extension+style+filters
bundle-directory)
(define (bundle-file-suffix)
(case (system-type)
[(macosx) "dmg"]
[(windows) "zip"]
[(unix) "tgz"]))
(define (bundle-put-file-extension+style+filters)
(values (bundle-file-suffix)
null
(case (system-type)
[(windows) '(("Zip file" "*.zip"))]
[(macosx) '(("Disk image" "*.dmg"))]
[(unix) '(("Gzipped tar file" "*.tgz"))])))
(define (add-suffix name suffix)
(if (filename-extension name)
name
(path-replace-suffix name
(string->bytes/utf-8 (string-append "." suffix)))))
(define (with-prepared-directory dir for-exe? k)
;; If `dir' contains multiple files, create a new
;; directory that contains a copy of `dir'
(if (and for-exe?
(= 1 (length (directory-list dir))))
(k dir)
(let ([temp-dir (make-temporary-file "bundle-tmp-~a" 'directory)])
(dynamic-wind
void
(lambda ()
(let ([dest
(let-values ([(base name dir?) (split-path dir)])
(build-path temp-dir name))])
(make-directory dest)
(let loop ([src dir][dest dest])
(for-each (lambda (f)
(let ([src (build-path src f)]
[dest (build-path dest f)])
(cond
[(directory-exists? src)
(make-directory dest)
(loop src dest)]
[(file-exists? src)
(copy-file src dest)
(file-or-directory-modify-seconds
dest
(file-or-directory-modify-seconds src))])))
(directory-list src))))
(k temp-dir))
(lambda () (delete-directory/files temp-dir))))))
(define bundle-directory
(opt-lambda (target dir [for-exe? #f])
(let ([target (add-suffix target (bundle-file-suffix))])
(case (system-type)
[(macosx)
(with-prepared-directory
dir for-exe?
(lambda (dir)
(let* ([cout (open-output-bytes)]
[cerr (open-output-bytes)]
[cin (open-input-bytes #"")]
[p (process*/ports
cout cin cerr
"/usr/bin/hdiutil"
"create" "-format" "UDZO"
"-imagekey" "zlib-level=9"
"-mode" "555"
"-volname" (path->string
(path-replace-suffix (file-name-from-path target) #""))
"-srcfolder" (path->string (path->complete-path dir))
(path->string (path->complete-path target)))])
((list-ref p 4) 'wait)
(unless (eq? ((list-ref p 4) 'status) 'done-ok)
(error 'bundle-directory
"error bundling: ~a"
(regexp-replace #rx"[\r\n]*$" (get-output-string cerr) ""))))))]
[(windows unix)
(let-values ([(base name dir?) (split-path dir)])
(parameterize ([current-directory base])
((if (eq? 'unix (system-type)) tar-gzip zip) target name)))]
[else (error 'bundle-directory "don't know how")])))))

31
collects/compiler/doc.txt
View File

@ -606,8 +606,8 @@ _embedr-sig.ss_ library provides the signature, _compiler:embed^_.
> (embedding-executable-add-suffix path mred?) - Returns a path with a > (embedding-executable-add-suffix path mred?) - Returns a path with a
suitable executable suffix added, if it's not present already. suitable executable suffix added, if it's not present already.
Packaing Stand-alone Executables into a Distribution Assembling Stand-alone Executables with Shared Libraries
==================================================== ========================================================
The _distribute.ss_ library provides a function to combine a The _distribute.ss_ library provides a function to combine a
stand-alone executable created with "embed.ss" with any DLLs, stand-alone executable created with "embed.ss" with any DLLs,
@ -635,3 +635,30 @@ frameworks, or shared libraries that it needs to run on other machines
The content of each directory in the #:copy-collects argument is The content of each directory in the #:copy-collects argument is
copied into the main "collects" directory for the packaged copied into the main "collects" directory for the packaged
executables. executables.
Packing Stand-alone Executables into a Distribution
===================================================
The _bundle-dist.ss_ library provides a function to pack a directory
(usually assembled by `assemble-distribution') into a distribution
file. Under Windows, the result is a ".zip" archive; under Mac OS X,
it's a ".dmg" disk image; under Unix, it's a ".tgz" archive.
> (bundle-directory dist-file dir [for-exe?])
Packages `dir' into `dist-file'. If `dist-file' has no extension,
a file extension is added automatcially (using the first result
of `bundle-put-file-extension+style+filters').
By default, the created archive contains a directory with the same
name as `dir'. If `for-exe?' is true under Mac OS X, and if `dir'
contains a single file, then the created disk image contains just
the file.
Archive creation files if `dist-file' exists.
> (bundle-put-file-extension+style+filters)
Returns three values suitable for use as the `extension', `style',
and `filters' arguments to `put-file', respectively to select
a distribution-file name.

3
collects/drscheme/private/drsig.ss
View File

@ -207,6 +207,9 @@
create-module-based-launcher create-module-based-launcher
create-module-based-stand-alone-executable create-module-based-stand-alone-executable
create-module-based-distribution
create-distribution-for-executable
create-executable-gui create-executable-gui
put-executable put-executable

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

@ -18,7 +18,9 @@
(lib "launcher.ss" "launcher") (lib "launcher.ss" "launcher")
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
(lib "framework.ss" "framework") (lib "framework.ss" "framework")
(lib "syntax-browser.ss" "mrlib")) (lib "syntax-browser.ss" "mrlib")
(lib "distribute.ss" "compiler")
(lib "bundle-dist.ss" "compiler"))
(provide language@) (provide language@)
@ -563,9 +565,10 @@
[base (cadr executable-specs)] [base (cadr executable-specs)]
[executable-filename (caddr executable-specs)] [executable-filename (caddr executable-specs)]
[create-executable [create-executable
(if (eq? type 'launcher) (case type
create-module-based-launcher [(launcher) create-module-based-launcher]
create-module-based-stand-alone-executable)]) [(stand-alone) create-module-based-stand-alone-executable]
[(distribution) create-module-based-distribution])])
(create-executable (create-executable
program-filename program-filename
executable-filename executable-filename
@ -578,11 +581,11 @@
use-copy?))))) use-copy?)))))
;; create-executeable-gui : (union #f (is-a?/c top-level-area-container<%>)) ;; create-executable-gui : (union #f (is-a?/c top-level-area-container<%>))
;; (union #f string?) ;; (union #f string?)
;; (union #t 'launcher 'stand-alone) ;; (union #t 'launcher 'stand-alone 'distribution)
;; (union #t 'mzscheme 'mred) ;; (union #t 'mzscheme 'mred)
;; -> (union #f (list (union 'no-show 'launcher 'stand-alone) ;; -> (union #f (list (union 'no-show 'launcher 'stand-alone 'distribution)
;; (union 'no-show 'mzscheme 'mred) ;; (union 'no-show 'mzscheme 'mred)
;; string[filename])) ;; string[filename]))
(define (create-executable-gui parent program-filename show-type show-base) (define (create-executable-gui parent program-filename show-type show-base)
@ -591,7 +594,10 @@
(define filename-text-field (instantiate text-field% () (define filename-text-field (instantiate text-field% ()
(label (string-constant filename)) (label (string-constant filename))
(parent filename-panel) (parent filename-panel)
(init-value (path->string (default-executable-filename program-filename #f))) (init-value (path->string (default-executable-filename
program-filename
(if (eq? show-type #t) 'launcher show-type)
#f)))
(min-width 400) (min-width 400)
(callback void))) (callback void)))
(define filename-browse-button (instantiate button% () (define filename-browse-button (instantiate button% ()
@ -599,34 +605,34 @@
(parent filename-panel) (parent filename-panel)
(callback (callback
(λ (x y) (browse-callback))))) (λ (x y) (browse-callback)))))
(define type/base/help-panel (instantiate horizontal-panel% ()
(parent dlg)
(alignment '(center center))))
(define type/base-panel (instantiate vertical-panel% () (define type/base-panel (instantiate vertical-panel% ()
(parent type/base/help-panel) (parent dlg)
(stretchable-width #f))) (stretchable-width #f)))
(define type-panel (make-object horizontal-panel% type/base-panel)) (define type-panel (make-object horizontal-panel% type/base-panel))
(define type-rb (and (boolean? show-type) (define type-rb (and (boolean? show-type)
(instantiate radio-box% () (instantiate radio-box% ()
(label (string-constant executable-type)) (label (string-constant executable-type))
(choices (list (string-constant launcher) (choices (list (string-constant launcher-explanatory-label)
(string-constant stand-alone))) (string-constant stand-alone-explanatory-label)
(string-constant distribution-explanatory-label)))
(parent type-panel) (parent type-panel)
(callback void)))) (callback (lambda (rb e) (reset-filename-suffix))))))
(define base-panel (make-object horizontal-panel% type/base-panel)) (define base-panel (make-object horizontal-panel% type/base-panel))
(define base-rb (and (boolean? show-base) (define base-rb (and (boolean? show-base)
(instantiate radio-box% () (instantiate radio-box% ()
(label (string-constant executable-base)) (label (string-constant executable-base))
(choices (list "MzScheme" "MrEd")) (choices (list "MzScheme" "MrEd"))
(parent base-panel) (parent base-panel)
(callback void)))) (callback (lambda (rb e) (reset-filename-suffix))))))
(define help-button (make-object button% (define (reset-filename-suffix)
(string-constant help) (let ([s (send filename-text-field get-value)])
type/base/help-panel (unless (string=? s "")
(λ (x y) (let ([new-s (default-executable-filename
(send dlg show #f) (string->path s)
(drscheme:help-desk:goto-help "drscheme" "Executables")))) (current-mode)
(not (currently-mzscheme-binary?)))])
(send filename-text-field set-value (path->string new-s))))))
(define button-panel (instantiate horizontal-panel% () (define button-panel (instantiate horizontal-panel% ()
(parent dlg) (parent dlg)
@ -650,21 +656,27 @@
(split-path ftf) (split-path ftf)
(values (current-directory) "" #f))]) (values (current-directory) "" #f))])
(let* ([mzscheme? (currently-mzscheme-binary?)] (let* ([mzscheme? (currently-mzscheme-binary?)]
[launcher? (currently-launcher?)] [mode (current-mode)]
[filename [filename
(put-executable/defaults (put-executable/defaults
dlg dlg
base base
name name
launcher? mode
(not mzscheme?) (not mzscheme?)
(if launcher? (case mode
[(launcher)
(if mzscheme? (if mzscheme?
(string-constant save-a-mzscheme-launcher) (string-constant save-a-mzscheme-launcher)
(string-constant save-a-mred-launcher)) (string-constant save-a-mred-launcher))]
[(stand-alone)
(if mzscheme? (if mzscheme?
(string-constant save-a-mzscheme-stand-alone-executable) (string-constant save-a-mzscheme-stand-alone-executable)
(string-constant save-a-mred-stand-alone-executable))))]) (string-constant save-a-mred-stand-alone-executable))]
[(distribution)
(if mzscheme?
(string-constant save-a-mzscheme-distribution)
(string-constant save-a-mred-distribution))]))])
(when filename (when filename
(send filename-text-field set-value (path->string filename))))))) (send filename-text-field set-value (path->string filename)))))))
@ -674,29 +686,29 @@
(= 0 (send base-rb get-selection))] (= 0 (send base-rb get-selection))]
[else (eq? show-base 'mzscheme)])) [else (eq? show-base 'mzscheme)]))
(define (currently-launcher?) (define (current-mode)
(cond (cond
[type-rb [type-rb
(= 0 (send type-rb get-selection))] (let ([s (send type-rb get-item-label (send type-rb get-selection))])
[else (eq? show-type 'launcher)])) (cond
[(equal? s (string-constant launcher-explanatory-label)) 'launcher]
[(equal? s (string-constant stand-alone-explanatory-label)) 'stand-alone]
[(equal? s (string-constant distribution-explanatory-label)) 'distribution]))]
[else show-type]))
(define (check-filename) (define (check-filename)
(let ([filename-str (send filename-text-field get-value)] (let ([filename-str (send filename-text-field get-value)]
[mred? (not (currently-mzscheme-binary?))]) [mred? (not (currently-mzscheme-binary?))]
[mode (current-mode)])
(let-values ([(extension style filters) (let-values ([(extension style filters)
(if (currently-launcher?) (mode->put-file-extension+style+filters mode mred?)])
(if mred?
(mred-launcher-put-file-extension+style+filters)
(mzscheme-launcher-put-file-extension+style+filters))
(embedding-executable-put-file-extension+style+filters mred?))])
(cond (cond
[(string=? "" filename-str) [(string=? "" filename-str)
(message-box (string-constant drscheme) (message-box (string-constant drscheme)
(string-constant please-choose-an-executable-filename) (string-constant please-specify-a-filename)
dlg) dlg)
#f] #f]
[(not (users-name-ok? extension dlg (string->path filename-str))) [(not (users-name-ok? mode extension dlg (string->path filename-str)))
#f] #f]
[(or (directory-exists? filename-str) [(or (directory-exists? filename-str)
(file-exists? filename-str)) (file-exists? filename-str))
@ -705,10 +717,11 @@
;; ask-user-can-clobber-directory? : (is-a?/c top-level-window<%>) string -> boolean ;; ask-user-can-clobber-directory? : (is-a?/c top-level-window<%>) string -> boolean
(define (ask-user-can-clobber? filename) (define (ask-user-can-clobber? filename)
(message-box (string-constant drscheme) (eq? (message-box (string-constant drscheme)
(format (string-constant are-you-sure-delete?) filename) (format (string-constant are-you-sure-delete?) filename)
dlg dlg
'(yes-no))) '(yes-no))
'yes))
(define cancelled? #t) (define cancelled? #t)
@ -718,9 +731,7 @@
[else [else
(list (list
(if type-rb (if type-rb
(case (send type-rb get-selection) (current-mode)
[(0) 'launcher]
[(1) 'stand-alone])
'no-show) 'no-show)
(if base-rb (if base-rb
(case (send base-rb get-selection) (case (send base-rb get-selection)
@ -729,32 +740,38 @@
'no-show) 'no-show)
(send filename-text-field get-value))])) (send filename-text-field get-value))]))
;; put-executable : parent string boolean boolean -> (union false? string) (define (normalize-mode mode)
(case mode
[(launcher stand-alone distribution) mode]
;; Backward compatibility: interpret a boolean
[else (if mode 'launcher 'stand-alone)]))
;; put-executable : parent string (union boolean 'launcher 'stand-alone 'distribution) boolean -> (union false? string)
;; invokes the put-file dialog with arguments specific to building executables ;; invokes the put-file dialog with arguments specific to building executables
(define (put-executable parent program-filename launcher? mred? title) (define (put-executable parent program-filename mode mred? title)
(let-values ([(base name dir) (split-path program-filename)]) (let-values ([(base name dir) (split-path program-filename)])
(let ([default-name (default-executable-filename name mred?)]) (let ([mode (normalize-mode mode)])
(let ([default-name (default-executable-filename name mode mred?)])
(put-executable/defaults (put-executable/defaults
parent parent
base base
default-name default-name
launcher? mode
mred? mred?
title)))) title)))))
;; put-executable/defaults : parent string string boolean boolean -> (union false? string) ;; put-executable/defaults : parent string string symbol boolean -> (union false? string)
(define (put-executable/defaults parent default-dir default-name launcher? mred? title) (define (put-executable/defaults parent default-dir default-name mode mred? title)
(let-values ([(extension style filters) (let-values ([(extension style filters)
(if launcher? (mode->put-file-extension+style+filters mode mred?)])
(if mred? (let* ([dir? (case mode
(mred-launcher-put-file-extension+style+filters) [(launcher)
(mzscheme-launcher-put-file-extension+style+filters))
(embedding-executable-put-file-extension+style+filters mred?))])
(let* ([dir? (if launcher?
(if mred? (if mred?
(mred-launcher-is-directory?) (mred-launcher-is-directory?)
(mzscheme-launcher-is-directory?)) (mzscheme-launcher-is-directory?))]
(embedding-executable-is-directory? mred?))] [(stand-alone)
(embedding-executable-is-directory? mred?)]
[(distribution) #f])]
[users-name [users-name
(if dir? (if dir?
(get-directory title (get-directory title
@ -769,7 +786,7 @@
style style
filters))]) filters))])
(and users-name (and users-name
(users-name-ok? extension parent users-name) (users-name-ok? mode extension parent users-name)
(or (not dir?) (or (not dir?)
(gui-utils:get-choice (gui-utils:get-choice
(format (string-constant warning-directory-will-be-replaced) (format (string-constant warning-directory-will-be-replaced)
@ -781,33 +798,29 @@
parent)) parent))
users-name)))) users-name))))
;; users-name-ok? : string (union #f frame% dialog%) string -> boolean ;; users-name-ok? : symbol string (union #f frame% dialog%) string -> boolean
;; returns #t if the string is an acceptable name for ;; returns #t if the string is an acceptable name for
;; a saved executable, and #f otherwise. ;; a saved executable, and #f otherwise.
(define (users-name-ok? extension parent name) (define (users-name-ok? mode extension parent name)
(or (not extension) (or (not extension)
(let ([suffix-m (regexp-match #rx"[.][^.]*$" (path->string name))]) (let ([suffix-m (regexp-match #rx"[.][^.]*$" (path->string name))])
(or (and suffix-m (or (and suffix-m
(string=? (substring (car suffix-m) 1) extension)) (string=? (substring (car suffix-m) 1) extension))
(begin (and
;; FIXME: change the message to be platform-neutral and to
;; use `extension' for the message
(case (system-type)
[(macosx)
(message-box (string-constant drscheme) (message-box (string-constant drscheme)
(format (format
(string-constant macosx-executables-must-end-with-app) (string-constant ~a-must-end-with-~a)
name) (case mode
parent)] [(launcher) (string-constant launcher)]
[(windows) [(stand-alone) (string-constant stand-alone)]
(message-box (string-constant drscheme) [(distribution) (string-constant distribution)])
(format (string-constant windows-executables-must-end-with-exe) name
name) extension)
parent)]) parent)
#f))))) #f)))))
;; default-executable-filename : path -> path ;; default-executable-filename : path symbol boolean -> path
(define (default-executable-filename program-filename mred?) (define (default-executable-filename program-filename mode mred?)
(let* ([ext (filename-extension program-filename)] (let* ([ext (filename-extension program-filename)]
[program-bytename (path->bytes program-filename)] [program-bytename (path->bytes program-filename)]
;; ext-less : bytes ;; ext-less : bytes
@ -819,13 +832,25 @@
1 ;; sub1 for the period in the extension 1 ;; sub1 for the period in the extension
)) ))
program-bytename)]) program-bytename)])
(let ([ext (let-values ([(extension style filters)
(mode->put-file-extension+style+filters mode mred?)])
(and extension
(string->bytes/utf-8 (string-append "." extension))))])
(bytes->path (bytes->path
(case (system-type) (if ext
[(windows) (bytes-append ext-less #".exe")] (bytes-append ext-less ext)
[(macosx) (if mred? ext-less)))))
(bytes-append ext-less #".app")
ext-less)] (define (mode->put-file-extension+style+filters mode mred?)
[else ext-less])))) (case mode
[(launcher)
(if mred?
(mred-launcher-put-file-extension+style+filters)
(mzscheme-launcher-put-file-extension+style+filters))]
[(stand-alone)
(embedding-executable-put-file-extension+style+filters mred?)]
[(distribution)
(bundle-put-file-extension+style+filters)]))
;; create-module-based-stand-alone-executable : ... -> void (see docs) ;; create-module-based-stand-alone-executable : ... -> void (see docs)
(define (create-module-based-stand-alone-executable program-filename (define (create-module-based-stand-alone-executable program-filename
@ -909,6 +934,90 @@
(delete-file bootstrap-tmp-filename) (delete-file bootstrap-tmp-filename)
(void))) (void)))
;; create-module-based-distribution : ... -> void (see docs)
(define (create-module-based-distribution program-filename
distribution-filename
module-language-spec
transformer-module-language-spec
init-code
gui?
use-copy?)
(create-distribution-for-executable
distribution-filename
gui?
(lambda (exe-name)
(create-module-based-stand-alone-executable program-filename
exe-name
module-language-spec
transformer-module-language-spec
init-code
gui?
use-copy?))))
;; create-module-based-distribution : ... -> void (see docs)
(define (create-distribution-for-executable distribution-filename
gui?
make-executable)
;; Delete old file, if it exists:
(when (file-exists? distribution-filename)
(delete-file distribution-filename))
;; Figure out base name, and create working temp directory:
(let ([base-name (let-values ([(base name dir?) (split-path distribution-filename)])
(path-replace-suffix name #""))]
[temp-dir
(make-temporary-file "drscheme-tmp-~a" 'directory)]
[c (make-custodian)])
(let ([status-message #f]
[ready (make-semaphore)])
(with-handlers ([exn? ; Catch breaks!
(λ (x)
(custodian-shutdown-all c)
(delete-directory/files temp-dir)
(message-box
(string-constant drscheme)
(format "~a" (exn-message x)))
(void))])
(let ([orig-thread (current-thread)])
(parameterize ([current-custodian c])
(parameterize ([current-eventspace (make-eventspace)])
(queue-callback
(lambda ()
(let* ([dialog (new dialog%
[label (string-constant distribution-progress-window-title)]
[width 400])]
[label (new message%
[label (string-constant creating-executable-progress-status)]
[parent dialog]
[stretchable-width #t])]
[pane (new vertical-pane%
[parent dialog])])
(new button%
[parent pane]
[label (string-constant abort)]
[callback (lambda (c b)
(break-thread orig-thread))])
(send dialog center)
(set! status-message label)
(semaphore-post ready)
(send dialog show #t)))))))
(semaphore-wait ready)
;; Build the exe:
(make-directory (build-path temp-dir "exe"))
(let ([exe-name (build-path temp-dir "exe" (default-executable-filename base-name 'stand-alone gui?))])
(make-executable exe-name)
(when (or (file-exists? exe-name)
(directory-exists? exe-name))
(let ([dist-dir (build-path temp-dir base-name)])
;; Assemble the bundle directory:
(send status-message set-label (string-constant assembling-distribution-files-progress-status))
(assemble-distribution dist-dir (list exe-name))
;; Pack it:
(send status-message set-label (string-constant packing-distribution-progress-status))
(bundle-directory distribution-filename dist-dir #t)))
;; Clean up:
(custodian-shutdown-all c)
(delete-directory/files temp-dir))))))
(define (condense-scheme-code-string s) (define (condense-scheme-code-string s)
(let ([i (open-input-string s)] (let ([i (open-input-string s)]
[o (open-output-string)]) [o (open-output-string)])

30
collects/drscheme/private/module-language.ss
View File

@ -167,7 +167,7 @@
#t #t
#t)]) #t)])
(when executable-specs (when executable-specs
(let ([stand-alone? (eq? 'stand-alone (car executable-specs))] (let ([launcher? (eq? 'launcher (car executable-specs))]
[gui? (eq? 'mred (cadr executable-specs))] [gui? (eq? 'mred (cadr executable-specs))]
[executable-filename (caddr executable-specs)]) [executable-filename (caddr executable-specs)])
(with-handlers ([(λ (x) #f) ;exn:fail? (with-handlers ([(λ (x) #f) ;exn:fail?
@ -177,28 +177,26 @@
(if (exn? x) (if (exn? x)
(format "~a" (exn-message x)) (format "~a" (exn-message x))
(format "uncaught exception: ~s" x))))]) (format "uncaught exception: ~s" x))))])
(if stand-alone? (if (not launcher?)
(let ([short-program-name (let-values ([(base name dir) (split-path program-filename)]) (let ([short-program-name
(cond (let-values ([(base name dir) (split-path program-filename)])
[(regexp-match #rx#"(.*)\\...." (path->bytes name)) (path-replace-suffix name #""))])
=> ((if (eq? 'distribution (car executable-specs))
cadr] drscheme:language:create-distribution-for-executable
[(regexp-match #rx#"(.*)\\..." (path->bytes name)) (lambda (executable-filename gui? make)
=> (make executable-filename)))
cadr]
[(regexp-match #rx#"(.*)\\.." (path->bytes name))
=>
cadr]
[else (path->bytes name)]))])
(make-embedding-executable
executable-filename executable-filename
gui? gui?
(lambda (exe-name)
(make-embedding-executable
exe-name
gui?
#f ;; verbose? #f ;; verbose?
(list (list #f program-filename)) (list (list #f program-filename))
null null
null null
(list (if gui? "-Zmvqe-" "-mvqe-") (list (if gui? "-Zmvqe-" "-mvqe-")
(format "~s" `(require ,(string->symbol (bytes->string/latin-1 short-program-name))))))) (format "~s" `(require ,(string->symbol (path->string short-program-name)))))))))
(let ([make-launcher (if gui? make-mred-launcher make-mzscheme-launcher)]) (let ([make-launcher (if gui? make-mred-launcher make-mzscheme-launcher)])
(make-launcher (list "-mvqt-" (path->string program-filename)) (make-launcher (list "-mvqt-" (path->string program-filename))
executable-filename)))))))) executable-filename))))))))

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

@ -32,16 +32,16 @@
" copied (with \\MzLink{mz:namespace-utilities}{\\rawscm{namespace-attach-module}})" " copied (with \\MzLink{mz:namespace-utilities}{\\rawscm{namespace-attach-module}})"
" from DrScheme's original namespace:" " from DrScheme's original namespace:"
" \\begin{itemize}" " \\begin{itemize}"
" \\item \\rawscm{'mzscheme}" " \\item \\Symbol{mzscheme}"
" \\item \\rawscm{'(lib \"mred.ss\" \"mred\")}" " \\item \\scmc{'(lib \"mred.ss\" \"mred\")}"
" \\end{itemize}" " \\end{itemize}"
"" ""
"\\item" "\\item"
" \\MzLink{mz:p:read-curly-brace-as-paren}{\\rawscm{read-curly-brace-as-paren}}" " \\MzLink{mz:p:read-curly-brace-as-paren}{\\rawscm{read-curly-brace-as-paren}}"
" is \\rawscm{\\#t}," " is \\scmc{\\#t},"
"\\item" "\\item"
" \\MzLink{mz:p:read-square-bracket-as-paren}{\\rawscm{read-square-bracket-as-paren}}" " \\MzLink{mz:p:read-square-bracket-as-paren}{\\rawscm{read-square-bracket-as-paren}}"
" is \\rawscm{\\#t}," " is \\scmc{\\#t},"
"\\item " "\\item "
" \\MzLink{mz:p:error-print-width}{\\rawscm{error-print-width}} is set to 250." " \\MzLink{mz:p:error-print-width}{\\rawscm{error-print-width}} is set to 250."
"\\item" "\\item"
@ -327,7 +327,7 @@
((enabled?) ()) ((enabled?) ())
"A parameter that controls if profiling information is recorded." "A parameter that controls if profiling information is recorded."
"" ""
"Defaults to \\scm{\\#f}." "Defaults to \\scmc{\\#f}."
"" ""
"Only applies if" "Only applies if"
"@flink drscheme:debug:make-debug-eval-handler" "@flink drscheme:debug:make-debug-eval-handler"
@ -423,7 +423,7 @@
(() (filename)) (() (filename))
"Opens a drscheme frame that displays \\var{filename}," "Opens a drscheme frame that displays \\var{filename},"
"or nothing if \\var{filename} is \\rawscm{\\#f} or not supplied.") "or nothing if \\var{filename} is \\scmc{\\#f} or not supplied.")
@ -622,7 +622,7 @@
"" ""
"The argument, \\var{before}, controls if the mixin is applied before or" "The argument, \\var{before}, controls if the mixin is applied before or"
"after already installed mixins." "after already installed mixins."
"If unsupplied, this is the same as supplying \\rawscm{\\#t}.") "If unsupplied, this is the same as supplying \\scmc{\\#t}.")
(drscheme:get/extend:extend-interactions-text (drscheme:get/extend:extend-interactions-text
(case-> (case->
@ -634,7 +634,7 @@
"" ""
"The argument, \\var{before}, controls if the mixin is applied before or" "The argument, \\var{before}, controls if the mixin is applied before or"
"after already installed mixins." "after already installed mixins."
"If unsupplied, this is the same as supplying \\rawscm{\\#t}.") "If unsupplied, this is the same as supplying \\scmc{\\#t}.")
(drscheme:get/extend:get-interactions-text (drscheme:get/extend:get-interactions-text
(-> (implementation?/c drscheme:rep:text<%>)) (-> (implementation?/c drscheme:rep:text<%>))
@ -654,7 +654,7 @@
"" ""
"The argument, \\var{before}, controls if the mixin is applied before or" "The argument, \\var{before}, controls if the mixin is applied before or"
"after already installed mixins." "after already installed mixins."
"If unsupplied, this is the same as supplying \\rawscm{\\#f}.") "If unsupplied, this is the same as supplying \\scmc{\\#f}.")
(drscheme:get/extend:get-definitions-text (drscheme:get/extend:get-definitions-text
(-> (implementation?/c drscheme:unit:definitions-text<%>)) (-> (implementation?/c drscheme:unit:definitions-text<%>))
@ -674,7 +674,7 @@
"" ""
"The argument, \\var{before}, controls if the mixin is applied before or" "The argument, \\var{before}, controls if the mixin is applied before or"
"after already installed mixins." "after already installed mixins."
"If unsupplied, this is the same as supplying \\rawscm{\\#f}.") "If unsupplied, this is the same as supplying \\scmc{\\#f}.")
(drscheme:get/extend:get-interactions-canvas (drscheme:get/extend:get-interactions-canvas
(-> (subclass?/c drscheme:unit:interactions-canvas%)) (-> (subclass?/c drscheme:unit:interactions-canvas%))
@ -694,7 +694,7 @@
"The argument, \\var{before}, controls if the mixin is applied before or" "The argument, \\var{before}, controls if the mixin is applied before or"
"after already installed mixins." "after already installed mixins."
"If unsupplied, this is the same as supplying \\rawscm{\\#f}.") "If unsupplied, this is the same as supplying \\scmc{\\#f}.")
(drscheme:get/extend:get-definitions-canvas (drscheme:get/extend:get-definitions-canvas
(-> (subclass?/c drscheme:unit:definitions-canvas%)) (-> (subclass?/c drscheme:unit:definitions-canvas%))
@ -714,7 +714,7 @@
"" ""
"The argument, \\var{before}, controls if the mixin is applied before or" "The argument, \\var{before}, controls if the mixin is applied before or"
"after already installed mixins." "after already installed mixins."
"If unsupplied, this is the same as supplying \\rawscm{\\#f}.") "If unsupplied, this is the same as supplying \\scmc{\\#f}.")
(drscheme:get/extend:get-unit-frame (drscheme:get/extend:get-unit-frame
(-> (subclass?/c drscheme:unit:frame%)) (-> (subclass?/c drscheme:unit:frame%))
@ -1006,17 +1006,24 @@
".") ".")
(drscheme:language:put-executable (drscheme:language:put-executable
((is-a?/c top-level-window<%>) path? boolean? boolean? string? . -> . (or/c false/c path?)) ((is-a?/c top-level-window<%>)
(parent program-filename mred? launcher? title) path?
(or/c boolean? (symbols 'launcher 'standalone 'distribution))
boolean?
string?
. -> . (or/c false/c path?))
(parent program-filename mode mred? title)
"Calls the MrEd primitive" "Calls the MrEd primitive"
"@flink put-file" "@flink put-file"
"with arguments appropriate for creating an executable" "with arguments appropriate for creating an executable"
"from the file \\var{program-filename}. " "from the file \\var{program-filename}. "
"" ""
"The arguments \\var{mred?} and \\var{launcher?} indicate" "The arguments \\var{mred?} and \\var{mode} indicates"
"what type of executable this should be (and the dialog" "what type of executable this should be (and the dialog"
"may be slightly different on some platforms, depending" "may be slightly different on some platforms, depending"
"on these arguments)." "on these arguments). For historical reasons, \\scmc{\\#f}"
"is allowed for \\var{mode} as an alias for \\Symbol{launcher}, and"
"\\scmc{\\#t} is allowed for \\var{mode} as an alias for \\Symbol{stand-alone}."
"" ""
"The \\var{title} argument is used as the title to the primitive" "The \\var{title} argument is used as the title to the primitive"
"@flink put-file" "@flink put-file"
@ -1027,29 +1034,31 @@
(drscheme:language:create-executable-gui (drscheme:language:create-executable-gui
((or/c false/c (is-a?/c top-level-window<%>)) ((or/c false/c (is-a?/c top-level-window<%>))
(or/c false/c string?) (or/c false/c string?)
(or/c (λ (x) (eq? x #t)) (symbols 'launcher 'standalone)) (or/c (λ (x) (eq? x #t)) (symbols 'launcher 'standalone 'distribution))
(or/c (λ (x) (eq? x #t)) (symbols 'mzscheme 'mred)) (or/c (λ (x) (eq? x #t)) (symbols 'mzscheme 'mred))
. -> . . -> .
(or/c false/c (or/c false/c
(list/c (symbols 'no-show 'launcher 'stand-alone) (list/c (symbols 'no-show 'launcher 'stand-alone 'distribution)
(symbols 'no-show 'mred 'mzscheme) (symbols 'no-show 'mred 'mzscheme)
string?))) string?)))
(parent program-name show-type? show-base?) (parent program-name show-type show-base)
"Opens a dialog to prompt the user about their choice of executable." "Opens a dialog to prompt the user about their choice of executable."
"If \\var{show-type?} is \\scm{\\#t}, the user is prompted about" "If \\var{show-type} is \\scmc{\\#t}, the user is prompted about"
"a choice of executable: stand-alone, or launcher. If \\var{show-base?}" "a choice of executable: stand-alone,"
"is \\scm{\\#t}, the user is prompted about a choice of base" "launcher, or distribution; otherwise, the symbol determines the type."
"binary: mzscheme or mred." "If \\var{show-base}"
"is \\scmc{\\#t}, the user is prompted about a choice of base"
"binary: mzscheme or mred; otherwise the symbol determines the base."
"" ""
"The \\var{program-name} argument is used to construct the default" "The \\var{program-name} argument is used to construct the default"
"executable name in a platform-specific manner." "executable name in a platform-specific manner."
"" ""
"The \\var{parent} argument is used for the parent of the dialog." "The \\var{parent} argument is used for the parent of the dialog."
"" ""
"The result of this function is \\scm{\\#f} if the user cancel's" "The result of this function is \\scmc{\\#f} if the user cancel's"
"the dialog and a list of three items indicating what options" "the dialog and a list of three items indicating what options"
"they chose. If either \\var{show-type?} or \\var{show-base?}" "they chose. If either \\var{show-type} or \\var{show-base}"
"was \\scm{\\#f}, the corresponding result will be \\scm{'no-show}," "was not \\scmc{\\#t}, the corresponding result will be \\scmc{'no-show},"
"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
@ -1078,7 +1087,7 @@
"The \\var{init-code} argument is an s-expression representing" "The \\var{init-code} argument is an s-expression representing"
"the code for a module. This module is expected to provide" "the code for a module. This module is expected to provide"
"the identifer \\rawscm{init-code}, bound to a procedure of no" "the identifer \\rawscm{init-code}, bound to a procedure of no"
"arguments. That module is required and the \\scm{init-code}" "arguments. That module is required and the \\var{init-code}"
"procedure is executed to initialize language-specific" "procedure is executed to initialize language-specific"
"settings before the code in \\var{program-filename} runs." "settings before the code in \\var{program-filename} runs."
"" ""
@ -1090,6 +1099,42 @@
"\\rawscm{namespace-require/copy} or" "\\rawscm{namespace-require/copy} or"
"\\rawscm{namespace-require}. ") "\\rawscm{namespace-require}. ")
(drscheme:language:create-module-based-distribution
((or/c path? string?)
(or/c path? string?) any/c any/c any/c boolean? boolean?
. -> .
void?)
(program-filename
distribution-filename
module-language-spec
transformer-module-language-spec
init-code
gui?
use-copy?)
"Like"
"@flink drscheme:language:create-module-based-stand-alone-executable %"
", but packages the stand-alone executable into a distribution.")
(drscheme:language:create-distribution-for-executable
((or/c path? string?)
boolean?
(-> path? void?)
. -> .
void?)
(distribution-filename
gui?
make-executable)
"Creates a distribution where the given \\var{make-executable} procedure"
" creates the stand-alone executable to be distributed. "
"The \\var{make-executable} procedure is given the name of the "
"executable to create. The \\var{gui?} argument is needed in case the"
"executable's name (which \\rawscm{drscheme:language:create-distribution-for-executable} "
"must generate) depends on the type of executable. During the distribution-making "
"process, a progress dialog is shown to the user, and the user can click an "
"\\OnScreen{Abort} button that sends a break to the current thread.")
(drscheme:language:create-module-based-launcher (drscheme:language:create-module-based-launcher
((or/c path? string?) (or/c path? string?) any/c any/c any/c boolean? boolean? ((or/c path? string?) (or/c path? string?) any/c any/c any/c boolean? boolean?
. -> . . -> .
@ -1129,7 +1174,7 @@
(any/c . -> . boolean?) (any/c . -> . boolean?)
(val) (val)
"Returns \\rawscm{\\#t} if \\var{val} is a text/pos, and \\rawscm{\\#f}" "Returns \\scmc{\\#t} if \\var{val} is a text/pos, and \\scmc{\\#f}"
"otherwise.") "otherwise.")
(drscheme:language:make-text/pos (drscheme:language:make-text/pos
@ -1271,8 +1316,8 @@
"opens a help-desk window and searches for \\var{key}, according to " "opens a help-desk window and searches for \\var{key}, according to "
"\\var{lucky?}, \\var{type}, and \\var{mode}." "\\var{lucky?}, \\var{type}, and \\var{mode}."
"If the second, third, fourth, and/or fifth arguments are omitted, " "If the second, third, fourth, and/or fifth arguments are omitted, "
"they default to \rawscm{\\#t} \\rawscm{'keyword+index} and \\rawscm{'exact}," "they default to \\scmc{\\#t} \\Symbol{keyword+index} and \\Symbol{exact},"
"and \\rawscm{'all} respectively.") "and \\Symbol{all} respectively.")
; ;
; ;

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

@ -301,13 +301,13 @@ tracing todo:
(inherit get-module get-transformer-module get-init-code (inherit get-module get-transformer-module get-init-code
use-namespace-require/copy?) use-namespace-require/copy?)
(define/override (create-executable setting parent program-filename teachpack-cache) (define/override (create-executable setting parent program-filename teachpack-cache)
(let ([executable-filename (let ([dist-filename
(drscheme:language:put-executable (drscheme:language:put-executable
parent program-filename parent program-filename
#f 'distribution
#t #t
(string-constant save-a-mred-stand-alone-executable))]) (string-constant save-a-mred-distribution))])
(when executable-filename (when dist-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 ,(path->string x))) (map (lambda (x) `(file ,(path->string x)))
@ -333,9 +333,9 @@ tracing todo:
(write `(require #%htdp-lang-executable) outp) (write `(require #%htdp-lang-executable) outp)
(newline outp)) (newline outp))
'truncate) 'truncate)
(drscheme:language:create-module-based-stand-alone-executable (drscheme:language:create-module-based-distribution
wrapper-filename wrapper-filename
executable-filename dist-filename
(get-module) (get-module)
(get-transformer-module) (get-transformer-module)
(get-init-code setting teachpack-cache) (get-init-code setting teachpack-cache)

8
collects/mzlib/file.ss
View File

@ -240,8 +240,8 @@
"format string for 1 argument" "format string for 1 argument"
template))]) template))])
(format template void)) (format template void))
(unless (or (not copy-from) (path-string? copy-from)) (unless (or (not copy-from) (path-string? copy-from) (eq? copy-from 'directory))
(raise-type-error 'make-temporary-file "path, valid-path string, or #f" copy-from)) (raise-type-error 'make-temporary-file "path, valid-path string, 'directory, or #f" copy-from))
(unless (or (not base-dir) (path-string? base-dir)) (unless (or (not base-dir) (path-string? base-dir))
(raise-type-error 'make-temporary-file "path, valid-path, string, or #f" base-dir)) (raise-type-error 'make-temporary-file "path, valid-path, string, or #f" base-dir))
(let ([tmpdir (find-system-path 'temp-dir)]) (let ([tmpdir (find-system-path 'temp-dir)])
@ -256,7 +256,9 @@
(loop (- s (random 10)) (loop (- s (random 10))
(+ ms (random 10))))]) (+ ms (random 10))))])
(if copy-from (if copy-from
(copy-file copy-from name) (if (eq? copy-from 'directory)
(make-directory name)
(copy-file copy-from name))
(close-output-port (open-output-file name))) (close-output-port (open-output-file name)))
name))))] name))))]
[(template copy-from) (make-temporary-file template copy-from #f)] [(template copy-from) (make-temporary-file template copy-from #f)]

12
collects/string-constants/danish-string-constants.ss
View File

@ -790,11 +790,13 @@ please adhere to these guidelines:
(executable-base "Efternavn") (executable-base "Efternavn")
(filename "Filnavn: ") (filename "Filnavn: ")
(create "Lav") (create "Lav")
(please-choose-an-executable-filename "Vælg et filnavn til kørselsfilen.") ;; "choose-an-executable" changed to "specify-a"
(windows-executables-must-end-with-exe ;(please-choose-an-executable-filename "Vælg et filnavn til kørselsfilen.")
"Filnavnet\n\n ~a\n\ner ikke gyldigt.. Under Windows skal kørselsfiler have efternavnet .exe.") ;; Replaced by generic ~a-must-end-with-~a
(macosx-executables-must-end-with-app ;(windows-executables-must-end-with-exe
"Filnavnet\n\n ~a\n\ner ikke gyldigt. Under MacOS X skal kørselsfiler have efternavnet .app.") ; "Filnavnet\n\n ~a\n\ner ikke gyldigt.. Under Windows skal kørselsfiler have efternavnet .exe.")
;(macosx-executables-must-end-with-app
; "Filnavnet\n\n ~a\n\ner ikke gyldigt. Under MacOS X skal kørselsfiler have efternavnet .app.")
(warning-directory-will-be-replaced (warning-directory-will-be-replaced
"ADVARSEL: mappen:\n\n ~a\n\nvil blive slettet. Fortsæt?") "ADVARSEL: mappen:\n\n ~a\n\nvil blive slettet. Fortsæt?")

3
collects/string-constants/dutch-string-constants.ss
View File

@ -552,7 +552,8 @@
(executable-base "Base") (executable-base "Base")
(filename "Bestandsnaam: ") (filename "Bestandsnaam: ")
(create "Maak") (create "Maak")
(please-choose-an-executable-filename "Kies een bestandsnaam voor het programma.") ;; "choose-an-executable" changed to "specify-a"
;(please-choose-an-executable-filename "Kies een bestandsnaam voor het programma.")
(create-servlet "Maak Servlet...") (create-servlet "Maak Servlet...")

19
collects/string-constants/english-string-constants.ss
View File

@ -797,22 +797,35 @@ please adhere to these guidelines:
(save-a-mzscheme-launcher "Save a MzScheme Launcher") (save-a-mzscheme-launcher "Save a MzScheme Launcher")
(save-a-mred-stand-alone-executable "Save a MrEd Stand-alone Executable") (save-a-mred-stand-alone-executable "Save a MrEd Stand-alone Executable")
(save-a-mzscheme-stand-alone-executable "Save a MzScheme Stand-alone Executable") (save-a-mzscheme-stand-alone-executable "Save a MzScheme Stand-alone Executable")
(save-a-mred-distribution "Save a MrEd Distribution")
(save-a-mzscheme-distribution "Save a MzScheme Distribution")
(definitions-not-saved "The definitions window has not been saved. The executable will use the latest saved version of the definitions window. Continue?") (definitions-not-saved "The definitions window has not been saved. The executable will use the latest saved version of the definitions window. Continue?")
;; The "-explanatory-label" variants are the labels used for the radio buttons in
;; the "Create Executable..." dialog for the "(module ...)" language.
(launcher "Launcher") (launcher "Launcher")
(launcher-explanatory-label "Launcher (for this machine only, runs from source)")
(stand-alone "Stand-alone") (stand-alone "Stand-alone")
(stand-alone-explanatory-label "Stand-alone (for this machine only, run compiled copy)")
(distribution "Distribution")
(distribution-explanatory-label "Distribution (to install on other machines)")
(executable-type "Type") (executable-type "Type")
(executable-base "Base") (executable-base "Base")
(filename "Filename: ") (filename "Filename: ")
(create "Create") (create "Create")
(please-choose-an-executable-filename "Please choose a filename to save the executable.") (please-specify-a-filename "Please specify a filename to create.")
(windows-executables-must-end-with-exe (~a-must-end-with-~a
"The filename\n\n ~a\n\nis illegal. Under Windows, executables must end with .exe.") "The ~a filename\n\n ~a\n\nis illegal. The filename must end with \".~a\".")
(macosx-executables-must-end-with-app (macosx-executables-must-end-with-app
"The filename\n\n ~a\n\nis illegal. Under MacOS X, an executable must be a directory whose name ends with .app.") "The filename\n\n ~a\n\nis illegal. Under MacOS X, an executable must be a directory whose name ends with .app.")
(warning-directory-will-be-replaced (warning-directory-will-be-replaced
"WARNING: the directory:\n\n ~a\n\nwill be replaced. Proceed?") "WARNING: the directory:\n\n ~a\n\nwill be replaced. Proceed?")
(distribution-progress-window-title "Distribution Progress")
(creating-executable-progress-status "Creating executable for distribution...")
(assembling-distribution-files-progress-status "Assembling files for distribution...")
(packing-distribution-progress-status "Packing distribution...")
(create-servlet "Create Servlet...") (create-servlet "Create Servlet...")
; the ~a is a language such as "module" or "algol60" ; the ~a is a language such as "module" or "algol60"

12
collects/string-constants/french-string-constants.ss
View File

@ -805,11 +805,13 @@
(executable-base "Base") (executable-base "Base")
(filename "Nom de fichier : ") (filename "Nom de fichier : ")
(create "Créer") (create "Créer")
(please-choose-an-executable-filename "Veuillez sélectionner un nom de fichier pour sauvegarder l'exécutable.") ;; "choose-an-executable" changed to "specify-a"
(windows-executables-must-end-with-exe ;(please-choose-an-executable-filename "Veuillez sélectionner un nom de fichier pour sauvegarder l'exécutable.")
"Le nom de fichier\n\n ~a\n\nest illégal. Sous Windows, le nom d'un exécutable doit se terminer par .exe.") ;; Replaced by generic ~a-must-end-with-~a
(macosx-executables-must-end-with-app ;(windows-executables-must-end-with-exe
"Le nom de fichier\n\n ~a\n\nest illégal. Sous MacOS X, le nom d'un exécutable doit se terminer par .app.") ; "Le nom de fichier\n\n ~a\n\nest illégal. Sous Windows, le nom d'un exécutable doit se terminer par .exe.")
;(macosx-executables-must-end-with-app
; "Le nom de fichier\n\n ~a\n\nest illégal. Sous MacOS X, le nom d'un exécutable doit se terminer par .app.")
(warning-directory-will-be-replaced (warning-directory-will-be-replaced
"ATTENTION : le répertoire :\n\n ~a\n\nva être remplacé. Voulez-vous continuer ?") "ATTENTION : le répertoire :\n\n ~a\n\nva être remplacé. Voulez-vous continuer ?")

12
collects/string-constants/german-string-constants.ss
View File

@ -696,11 +696,13 @@
(executable-base "Hauptteil") (executable-base "Hauptteil")
(filename "Dateiname: ") (filename "Dateiname: ")
(create "Erzeugen") (create "Erzeugen")
(please-choose-an-executable-filename "Bitte Dateinamen für Programm auswählen") ;; "choose-an-executable" changed to "specify-a"
(windows-executables-must-end-with-exe ;(please-choose-an-executable-filename "Bitte Dateinamen für Programm auswählen")
"Der Dateiname\n\n ~a\n\nist unzulässig. Unter Windows müssen Programmdateien mit .exe enden.") ;; Replaced by generic ~a-must-end-with-~a
(macosx-executables-must-end-with-app ;(windows-executables-must-end-with-exe
"Der Dateiname\n\n ~a\n\nist unzulässig. Unter Mac OS X müssen Namen für Programme mit .app enden.") ; "Der Dateiname\n\n ~a\n\nist unzulässig. Unter Windows müssen Programmdateien mit .exe enden.")
;(macosx-executables-must-end-with-app
; "Der Dateiname\n\n ~a\n\nist unzulässig. Unter Mac OS X müssen Namen für Programme mit .app enden.")
(warning-directory-will-be-replaced (warning-directory-will-be-replaced
"WARNUNG: das Verzeichnis:\n\n ~a\n\nwird überschrieben werden. Weitermachen?") "WARNUNG: das Verzeichnis:\n\n ~a\n\nwird überschrieben werden. Weitermachen?")

12
collects/string-constants/japanese-string-constants.ss
View File

@ -790,11 +790,13 @@ please adhere to these guidelines:
(executable-base "Base") (executable-base "Base")
(filename "ファイル名: ") (filename "ファイル名: ")
(create "作成") (create "作成")
(please-choose-an-executable-filename "Please choose a filename to save the executable.") ;; "choose-an-executable" changed to "specify-a"
(windows-executables-must-end-with-exe ;(please-choose-an-executable-filename "Please choose a filename.")
"ファイル名\n\n ~a\n\nは正しくありません。Windows では、実行ファイルは .exe という拡張子を持たなければなりません。") ;; Replaced by generic ~a-must-end-with-~a
(macosx-executables-must-end-with-app ;(windows-executables-must-end-with-exe
"ファイル名\n\n ~a\n\nは正しくありません。MacOS X では、実行ファイルは .app という名前で終わるディレクトリでなければなりません。") ; "ファイル名\n\n ~a\n\nは正しくありません。Windows では、実行ファイルは .exe という拡張子を持たなければなりません。")
;(macosx-executables-must-end-with-app
; "ファイル名\n\n ~a\n\nは正しくありません。MacOS X では、実行ファイルは .app という名前で終わるディレクトリでなければなりません。")
(warning-directory-will-be-replaced (warning-directory-will-be-replaced
"警告: ディレクトリ:\n\n ~a\n\nは削除または上書きされます。よろしいですか？") "警告: ディレクトリ:\n\n ~a\n\nは削除または上書きされます。よろしいですか？")

12
collects/string-constants/portuguese-string-constants.ss
View File

@ -784,11 +784,13 @@ please adhere to these guidelines:
(executable-base "Base") (executable-base "Base")
(filename "Filename: ") (filename "Filename: ")
(create "Create") (create "Create")
(please-choose-an-executable-filename "Please choose a filename to save the executable.") ;; "choose-an-executable" changed to "specify-a"
(windows-executables-must-end-with-exe ;(please-choose-an-executable-filename "Please choose a filename to save the executable.")
"The filename\n\n ~a\n\nis illegal. Under Windows, executables must end with .exe.") ;; Replaced by generic ~a-must-end-with-~a
(macosx-executables-must-end-with-app ;(windows-executables-must-end-with-exe
"The filename\n\n ~a\n\nis illegal. Under MacOS X, an executable must be a directory whose name ends with .app.") ; "The filename\n\n ~a\n\nis illegal. Under Windows, executables must end with .exe.")
;(macosx-executables-must-end-with-app
; "The filename\n\n ~a\n\nis illegal. Under MacOS X, an executable must be a directory whose name ends with .app.")
(warning-directory-will-be-replaced (warning-directory-will-be-replaced
"WARNING: the directory:\n\n ~a\n\nwill be replaced. Proceed?") "WARNING: the directory:\n\n ~a\n\nwill be replaced. Proceed?")

12
collects/string-constants/simplified-chinese-string-constants.ss
View File

@ -720,11 +720,13 @@
(executable-base "基") (executable-base "基")
(filename "文件名：") (filename "文件名：")
(create "创建") (create "创建")
(please-choose-an-executable-filename "请选择可执行文件的名称。") ;; "choose-an-executable" changed to "specify-a"
(windows-executables-must-end-with-exe ; (please-choose-an-executable-filename "请选择可执行文件的名称。")
"文件名\n\n ~a\n\n不合法。Windows可执行文件必须以.exe结尾。") ;; Replaced by generic ~a-must-end-with-~a
(macosx-executables-must-end-with-app ;(windows-executables-must-end-with-exe
"文件名\n\n ~a\n\n不合法。MacOS X可执行文件必须以.app结尾。") ; "文件名\n\n ~a\n\n不合法。Windows可执行文件必须以.exe结尾。")
;(macosx-executables-must-end-with-app
; "文件名\n\n ~a\n\n不合法。MacOS X可执行文件必须以.app结尾。")
(warning-directory-will-be-replaced (warning-directory-will-be-replaced
"警告：目录：\n\n ~a\n\n将会被重置。继续操作？") "警告：目录：\n\n ~a\n\n将会被重置。继续操作？")

12
collects/string-constants/spanish-string-constants.ss
View File

@ -697,11 +697,13 @@
(executable-base "Base") (executable-base "Base")
(filename "Nombre de archivo: ") (filename "Nombre de archivo: ")
(create "Crear") (create "Crear")
(please-choose-an-executable-filename "Por favor selecciona un nombre de archivo para salvar el ejecutable.") ;; "choose-an-executable" changed to "specify-a"
(windows-executables-must-end-with-exe ;(please-choose-an-executable-filename "Por favor selecciona un nombre de archivo para salvar el ejecutable.")
"El nombre de archivo \n\n ~a\n\nes ilegal. En Windows, los ejecutables deben tener terminación .exe.") ;; Replaced by generic ~a-must-end-with-~a
(macosx-executables-must-end-with-app ;(windows-executables-must-end-with-exe
"El nombre de archivo\n\n ~a\n\nes ilegal. En MacOS X, los ejecutables deben tener terminación .app.") ; "El nombre de archivo \n\n ~a\n\nes ilegal. En Windows, los ejecutables deben tener terminación .exe.")
;(macosx-executables-must-end-with-app
; "El nombre de archivo\n\n ~a\n\nes ilegal. En MacOS X, los ejecutables deben tener terminación .app.")
(warning-directory-will-be-replaced (warning-directory-will-be-replaced
"ADVERTENCIA: el directorio:\n\n ~a\n\nserá reemplazado. ¿Continuar?") "ADVERTENCIA: el directorio:\n\n ~a\n\nserá reemplazado. ¿Continuar?")

13
collects/string-constants/traditional-chinese-string-constants.ss
View File

@ -716,11 +716,14 @@
(utable-base "基") (utable-base "基")
(filename "文檔名：") (filename "文檔名：")
(create "創建") (create "創建")
(please-choose-an-utable-filename "請選擇可執行文檔的名稱。") ;; ! FIXME ! : there are several of "utable"s in this file that should be "executable" !
(windows-utables-must-end-with-exe ;; "choose-an-executable" changed to "specify-a"
"文檔名\n\n ~a\n\n不合法。Windows可執行文檔必須以.exe結尾。") ;(please-choose-an-utable-filename "請選擇可執行文檔的名稱。")
(macosx-utables-must-end-with-app ;; Replaced by generic ~a-must-end-with-~a
"文檔名\n\n ~a\n\n不合法。MacOS X可執行文檔必須以.app結尾。") ;(windows-utables-must-end-with-exe
; "文檔名\n\n ~a\n\n不合法。Windows可執行文檔必須以.exe結尾。")
;(macosx-utables-must-end-with-app
; "文檔名\n\n ~a\n\n不合法。MacOS X可執行文檔必須以.app結尾。")
(warning-directory-will-be-replaced (warning-directory-will-be-replaced
"警告：目錄：\n\n ~a\n\n將會被重置。繼續操作？") "警告：目錄：\n\n ~a\n\n將會被重置。繼續操作？")