Changeset 12676

Timestamp:

Aug 25, 2009, 10:51:59 AM (15 years ago)

Author:

Gary Palter

Message:

Beginnings of support for building standalone Windows applications using Cocotron.
Tweak SAVE-APPLICATION to set the Windows subsystem byte in the executable file's
header appropriately (i.e., to either GUI or console). Update BUILD-APPLICATION
and BUILD-IDE to save GUI applications.

The IDE actually runs standalone!

BUILD-APPLICATION needs more work to get the frameworks into the bundle.
(The code which does that is only loaded when building the IDE so a bit of
refactoring is in order.)

Location:

trunk/source

Files:

• cocoa-ide/build-application.lisp (modified) (2 diffs)
• cocoa-ide/builder-utilities.lisp (modified) (3 diffs)
• cocoa-ide/start.lisp (modified) (1 diff)
• lib/dumplisp.lisp (modified) (7 diffs)

trunk/source/cocoa-ide/build-application.lisp

@@ -51 +51 @@
          ;; create the bundle directory
          (app-bundle (make-application-bundle :name name :project-path directory))
-         (image-path (namestring (path app-bundle "Contents" "MacOS" name))))
+         (image-path (namestring (path (bundle-executable-path app-bundle)
+                                       (bundle-executable-name name)))))
     ;; maybe copy IDE resources to the bundle
     (when copy-ide-resources
@@ -75 +76 @@
                       :application-class application-class
                       :toplevel-function toplevel-function
-                      :prepend-kernel t)))
+                      :prepend-kernel t
+                      #+windows-target #+windows-target
+                      :application-type :gui)))
 
 

trunk/source/cocoa-ide/builder-utilities.lisp

@@ -263 +263 @@
            (type-str (%make-nsstring package-type))
            (sig-str (%make-nsstring bundle-signature))
-           (app-name-str (%make-nsstring name))
+           (app-name-str (%make-nsstring (bundle-executable-name name)))
            (app-plist-path-str (%make-nsstring (namestring out-path))))
       (#/setValue:forKey: info-dict bundle-name-str $cfbundle-bundle-name-key)
@@ -300 +300 @@
     (read-info-plist ide-plist-path-str)))
 
+;;; BUNNDLE-EXECUTABLE-PATH app-path
+;;; ------------------------------------------------------------------------
+;;; Returns the pathname of the executable directory given the pathname of
+;;; an application bundle
+(defun bundle-executable-path (app-path)
+  (path app-path "Contents" 
+        #-windows-target (ensure-directory-pathname "MacOS")
+        #+windows-target (ensure-directory-pathname "Windows")))
+
+;;; BUNNDLE-EXECUTABLE-NAME name
+;;; ------------------------------------------------------------------------
+;;; Returns the name of the executable file for an application bundle
+(defun bundle-executable-name (name)
+  #-windows-target name
+  #+windows-target (concatenate 'string name ".exe"))
+
 ;;; MAKE-APPLICATION-BUNDLE name package-type bundle-signature project-path
 ;;; ------------------------------------------------------------------------
@@ -310 +326 @@
                            (ensure-directory-pathname (concatenate 'string name ".app"))))
          (contents-dir (path app-bundle (ensure-directory-pathname "Contents")))
-         (macos-dir (path contents-dir (ensure-directory-pathname "MacOS")))
+         (executable-dir (bundle-executable-path app-bundle))
          (rsrc-dir (path contents-dir  "Resources" 
                          (ensure-directory-pathname "English.lproj"))))
-    (ensure-directories-exist macos-dir)
+    (ensure-directories-exist executable-dir)
     (ensure-directories-exist rsrc-dir)
     app-bundle))

trunk/source/cocoa-ide/start.lisp

@@ -153 +153 @@
       (save-application image-file
                         :prepend-kernel t
-                        :application-class 'cocoa-application)))
+                        :application-class 'cocoa-application
+                        #+windows-target #+windows-target
+                        :application-type :gui)))
 
 ;;; If we're running as a standalone .app, try to see if a bundle named

trunk/source/lib/dumplisp.lisp

@@ -73 +73 @@
                          (mode #o644)
                          prepend-kernel
-                         )
+                         #+windows-target (application-type :console))
   (declare (ignore toplevel-function error-handler application-class
                    clear-clos-caches init-file impurify))
+  #+windows-target (check-type application-type (member :console :gui))
   (unless (probe-file (make-pathname :defaults nil
                                      :directory (pathname-directory (translate-logical-pathname filename))))
@@ -87 +88 @@
       (let* ((fd (open-dumplisp-file filename
                                      :mode mode
-                                     :prepend-kernel prepend-kernel)))
+                                     :prepend-kernel prepend-kernel
+                                     #+windows-target  #+windows-target 
+                                     :application-type application-type)))
         (process-interrupt ip
                            #'(lambda ()
@@ -109 +112 @@
                                       (init-file nil init-file-p)
                                       (clear-clos-caches t)
-                                      prepend-kernel)
-  (declare (ignore mode prepend-kernel))
+                                      prepend-kernel
+                                      #+windows-target application-type)
+  (declare (ignore mode prepend-kernel #+windows-target application-type))
   (when (and application-class (neq  (class-of *application*)
                                      (if (symbolp application-class)
@@ -190 +194 @@
                   
   
-(defun %prepend-file (out-fd in-fd len)
+(defun %prepend-file (out-fd in-fd len #+windows-target application-type)
   (declare (fixnum out-fd in-fd len))
   (fd-lseek in-fd 0 #$SEEK_SET)
-  (let* ((bufsize (ash 1 15)))
+  (let* ((bufsize (ash 1 15))
+         #+windows-target (first-buf t))
     (%stack-block ((buf bufsize))
       (loop
@@ -201 +206 @@
             (if (< nread 0)
               (%errno-disp nread))
-            (let* ((nwritten (fd-write out-fd buf nread)))
+            #+windows-target
+            (when (shiftf first-buf nil)
+              (let* ((application-byte (ecase application-type
+                                         (:console #$IMAGE_SUBSYSTEM_WINDOWS_CUI)
+                                         (:gui #$IMAGE_SUBSYSTEM_WINDOWS_GUI)))
+                     (offset (%get-long buf #x3c)))
+                (assert (< offset bufsize) () "PEF header not within first ~D bytes" bufsize)
+                (assert (= (%get-byte buf (+ offset 0)) (char-code #\P)) ()
+                        "File does not appear to be a PEF file")
+                (assert (= (%get-byte buf (+ offset 1)) (char-code #\E)) ()
+                        "File does not appear to be a PEF file")
+                (assert (= (%get-byte buf (+ offset 2)) 0) ()
+                        "File does not appear to be a PEF file")
+                (assert (= (%get-byte buf (+ offset 3)) 0) ()
+                        "File does not appear to be a PEF file")
+                ;; File is a PEF file -- Windows subsystem byte goes at offset 68 in the
+                ;;  "optional header" which appears right after the standard header (20 bytes)
+                ;;  and the PEF cookie (4 bytes)
+                (setf (%get-byte buf (+ offset 4 20 68)) application-byte)))
+            (let* ((nwritten (fd-write out-fd buf nread)))
               (declare (fixnum nwritten))
               (unless (= nwritten nread)
@@ -221 +245 @@
 
 
-(defun open-dumplisp-file (path &key (mode #o666) prepend-kernel)
+(defun open-dumplisp-file (path &key (mode #o666) prepend-kernel
+                           #+windows-target application-type)
   (let* ((prepend-path (if prepend-kernel
                          (if (eq prepend-kernel t)
@@ -239 +264 @@
     (let* ((image-fd (fd-open filename (logior #$O_WRONLY #$O_CREAT) mode)))
       (unless (>= image-fd 0) (signal-file-error image-fd filename))
+      (when prepend-fd
+        (%prepend-file image-fd prepend-fd prepend-len #+windows-target application-type))
       (fd-chmod image-fd mode)
-      (when prepend-fd
-        (%prepend-file image-fd prepend-fd prepend-len))
       image-fd)))