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

refactored the executable creation code to make it more legible

Browse Source
This commit is contained in:
Robby Findler 2010-06-05 14:51:14 -05:00
parent 31367705bb
commit 608f78b29f
1 changed files with 31 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/drracket/private/module-language.rkt
View File

@ -360,9 +360,9 @@
(let* ([executable-specs (drracket:language:create-executable-gui (let* ([executable-specs (drracket:language:create-executable-gui
parent program-filename #t #t)]) parent program-filename #t #t)])
(when executable-specs (when executable-specs
(let ([launcher? (eq? 'launcher (car executable-specs))] (let ([executable-type (list-ref executable-specs 0)]
[gui? (eq? 'mred (cadr executable-specs))] [gui? (eq? 'mred (list-ref executable-specs 1))]
[executable-filename (caddr executable-specs)]) [executable-filename (list-ref executable-specs 2)])
(with-handlers ([(λ (x) #f) ;exn:fail? (with-handlers ([(λ (x) #f) ;exn:fail?
(λ (x) (λ (x)
(message-box (message-box
@ -370,33 +370,36 @@
(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 (not launcher?) (let ([call-create-embedding-executable
(λ (exe-name)
(let ([short-program-name (let ([short-program-name
(let-values ([(base name dir) (split-path program-filename)]) (let-values ([(base name dir) (split-path program-filename)])
(path-replace-suffix name #""))]) (path-replace-suffix name #""))])
((if (eq? 'distribution (car executable-specs))
drracket:language:create-distribution-for-executable
(lambda (executable-filename gui? make)
(make executable-filename)))
executable-filename
gui?
(lambda (exe-name)
(create-embedding-executable (create-embedding-executable
exe-name exe-name
#:mred? gui? #:gracket? gui?
#:verbose? #f ;; verbose? #:verbose? #f
#:modules (list (list #f program-filename)) #:modules (list (list #f program-filename))
#:configure-via-first-module? #t #:configure-via-first-module? #t
#:literal-expression #:literal-expression
(begin
(parameterize ([current-namespace (make-base-empty-namespace)]) (parameterize ([current-namespace (make-base-empty-namespace)])
(namespace-require 'racket/base) (namespace-require 'racket/base)
(compile (compile
`(namespace-require '',(string->symbol (path->string short-program-name)))))) `(namespace-require '',(string->symbol (path->string short-program-name)))))
#:cmdline '("-U" "--"))))) #:cmdline '("-U" "--"))))])
(case executable-type
[(launcher)
(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 "-qt-" (path->string program-filename)) (make-launcher (list "-qt-" (path->string program-filename))
executable-filename)))))))) executable-filename))]
[(distribution)
(drracket:language:create-distribution-for-executable
executable-filename
gui?
call-create-embedding-executable)]
[(stand-alone)
(call-create-embedding-executable executable-filename)])))))))
(super-new (super-new
[module #f] [module #f]