cleaned up the rest of the executable creation code

svn: r9949

collects/drscheme/private/language.ss

@@ -4,7 +4,7 @@
 ;;          (esp. useful when debugging the users's io)
 
 #lang scheme/unit
-  (require "drsig.ss"
+(require "drsig.ss"
            string-constants
            mzlib/pconvert
            mzlib/pretty
@@ -1106,19 +1106,16 @@
       
       ((if gui? make-mred-launcher make-mzscheme-launcher)
        (list
-        "-qmvt"
         (path->string
          (build-path (collection-path "drscheme" "private") 
-                     "launcher-bootstrap.ss"))
+                     (if gui? 
-        "--"
+                         "launcher-mred-bootstrap.ss"
+                         "launcher-mz-bootstrap.ss")))
         (condense-scheme-code-string (format "~s" init-code))
         (path->string program-filename)
         (format "~s" module-language-spec)
         (format "~s" transformer-module-language-spec)
-        (format "~s" use-copy?)
+        (format "~s" use-copy?))
-        (format "~s" (if gui?  
-                         (list 'mzscheme '(lib "mred/mred.ss"))
-                         (list 'mzscheme))))
        (if (path? executable-filename)
            (path->string executable-filename)
            executable-filename))))

collects/drscheme/private/launcher-bootstrap.ss

@@ -1,7 +1,12 @@
-(module launcher-bootstrap mzscheme
+#lang scheme/base
-  (require mzlib/string
+
-           mzlib/file)
+(provide startup)
-  
+
+(require scheme/file)
+
+(define (read-from-string s) (read (open-input-string s)))
+
+(define (startup)
   (define argv (current-command-line-arguments))
   ;; skip first six
   (define program-argv (list->vector (cddr (cddddr (vector->list argv)))))
@@ -11,34 +16,23 @@
   (define language-module-spec (read-from-string (vector-ref argv 2)))
   (define transformer-module-spec (read-from-string (vector-ref argv 3)))
   (define use-require/copy? (read-from-string (vector-ref argv 4)))
-  (define to-be-copied-module-specs (read-from-string (vector-ref argv 5)))
-  
-  (define to-be-copied-module-names
-    (let ([get-name
-           (λ (spec)
-             (if (symbol? spec)
-                 spec
-                 ((current-module-name-resolver) spec #f #f)))])
-      (map get-name to-be-copied-module-specs)))
   
   (define init-code-tmp-filename (make-temporary-file "drs-launcher-init~a"))
   (define-values (_1 init-code-mod-name _2) (split-path init-code-tmp-filename))
   
-  (set! init-code (cons (car init-code)
+  (define stupid-internal-define-syntax2
-                        (cons (string->symbol (path->string init-code-mod-name))
+    (set! init-code (cons (car init-code)
-                              (cddr init-code))))
+                          (cons (string->symbol (path->string init-code-mod-name))
+                                (cddr init-code)))))
   
-  (call-with-output-file init-code-tmp-filename
+  (define stupid-internal-define-syntax1
-    (λ (port)
+    (call-with-output-file init-code-tmp-filename
-      (write init-code port))
+      (λ (port)
-    #:exists 'truncate #:mode 'text)
+        (write init-code port))
+      #:exists 'truncate #:mode 'text))
   
   (define init-code-proc (dynamic-require init-code-tmp-filename 'init-code))
   
-  (define original-namespace (current-namespace))
-  (current-namespace (make-namespace 'empty))
-  (for-each (λ (x) (namespace-attach-module original-namespace x))
-            to-be-copied-module-names)
   (namespace-set-variable-value! 'argv program-argv)
   (current-command-line-arguments program-argv)
   (when language-module-spec
@@ -53,4 +47,4 @@
   ;; safe to do this earlier?
   (delete-file init-code-tmp-filename)
   
-  (load program-filename))
+  (load program-filename))

collects/drscheme/private/launcher-mred-bootstrap.ss

@@ -0,0 +1,9 @@
+#lang scheme/base
+
+(require scheme/gui/base "launcher-bootstrap.ss")
+
+(current-namespace (make-gui-empty-namespace))
+(namespace-require 'scheme/gui/base)
+(namespace-require 'scheme/class)
+
+(startup)

collects/drscheme/private/launcher-mz-bootstrap.ss

@@ -0,0 +1,8 @@
+#lang scheme/base
+
+(require "launcher-bootstrap.ss")
+
+(current-namespace (make-base-empty-namespace))
+(namespace-require 'scheme/base)
+
+(startup)

collects/drscheme/private/module-language.ss

@@ -207,17 +207,18 @@
                        executable-filename 
                        gui?
                        (lambda (exe-name)
-                         (make-embedding-executable
+                         (create-embedding-executable
                           exe-name
-                          gui?
+                          #:mred? gui?
-                          #f ;; verbose?
+                          #:verbose? #f ;; verbose?
-                          (list (list #f program-filename))
+                          #:modules (list (list #f program-filename))
-                          null
+                          #:literal-expression
-                          (parameterize ([current-namespace (make-empty-namespace)])
+                          (begin
-                            (namespace-require 'mzscheme)
+                            (parameterize ([current-namespace (make-base-empty-namespace)])
-                            (compile 
+                              (namespace-require 'scheme/base)
-                             `(namespace-require '',(string->symbol (path->string short-program-name)))))
+                              (compile 
-                          null))))
+                               `(namespace-require '',(string->symbol (path->string short-program-name))))))
+                          #:cmdline null))))
                     (let ([make-launcher (if gui? make-mred-launcher make-mzscheme-launcher)])
                       (make-launcher (list "-qt-" (path->string program-filename))
                                      executable-filename))))))))