[Openmcl-cvs-notifications] r12676 - in /trunk/source: cocoa-ide/build-application.lisp cocoa-ide/builder-utilities.lisp cocoa-ide/start.lisp lib/dumplisp.lisp
palter at clozure.com
palter at clozure.com
Tue Aug 25 13:51:59 EDT 2009
Author: palter
Date: Tue Aug 25 13:51:59 2009
New Revision: 12676
Log:
Beginnings of support for building standalone Windows applications using Co=
cotron.
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-APPLIC=
ATION
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.)
Modified:
trunk/source/cocoa-ide/build-application.lisp
trunk/source/cocoa-ide/builder-utilities.lisp
trunk/source/cocoa-ide/start.lisp
trunk/source/lib/dumplisp.lisp
Modified: trunk/source/cocoa-ide/build-application.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/build-application.lisp (original)
+++ trunk/source/cocoa-ide/build-application.lisp Tue Aug 25 13:51:59 2009
@@ -50,7 +50,8 @@
(ide-bundle-path (get-ide-bundle-path))
;; create the bundle directory
(app-bundle (make-application-bundle :name name :project-path dir=
ectory))
- (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
(recursive-copy-directory (path ide-bundle-path "Contents" "Resource=
s/")
@@ -74,7 +75,9 @@
(save-application image-path
:application-class application-class
:toplevel-function toplevel-function
- :prepend-kernel t)))
+ :prepend-kernel t
+ #+windows-target #+windows-target
+ :application-type :gui)))
=
=
=
Modified: trunk/source/cocoa-ide/builder-utilities.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/builder-utilities.lisp (original)
+++ trunk/source/cocoa-ide/builder-utilities.lisp Tue Aug 25 13:51:59 2009
@@ -262,7 +262,7 @@
(let* ((bundle-name-str (%make-nsstring name))
(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)
(#/setValue:forKey: info-dict app-name-str $cfbundle-executable-key)
@@ -299,6 +299,22 @@
"Contents" "Info.plist"))))
(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
;;; ----------------------------------------------------------------------=
--
;;; Build the directory structure of a Cocoa application bundle and
@@ -309,9 +325,9 @@
(let* ((app-bundle (path project-path =
(ensure-directory-pathname (concatenate 'string=
name ".app"))))
(contents-dir (path app-bundle (ensure-directory-pathname "Conten=
ts")))
- (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))
Modified: trunk/source/cocoa-ide/start.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/start.lisp (original)
+++ trunk/source/cocoa-ide/start.lisp Tue Aug 25 13:51:59 2009
@@ -152,7 +152,9 @@
(ensure-directories-exist image-file)
(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
;;; AltConsole.app exists in our Resources directory. If so, execute
Modified: trunk/source/lib/dumplisp.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/dumplisp.lisp (original)
+++ trunk/source/lib/dumplisp.lisp Tue Aug 25 13:51:59 2009
@@ -72,9 +72,10 @@
impurify
(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 (trans=
late-logical-pathname filename))))
(error "Directory containing ~s does not exist." filename))
@@ -86,7 +87,9 @@
(when (process-verify-quit ip)
(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 ()
(process-exit-application
@@ -108,8 +111,9 @@
(impurify nil)
(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)
(find-class application-class)
@@ -189,10 +193,11 @@
header-pos))))))))))
=
=
-(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
(when (zerop len) (return))
@@ -200,7 +205,26 @@
(declare (fixnum nread))
(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_WINDO=
WS_CUI)
+ (:gui #$IMAGE_SUBSYSTEM_WINDOWS_G=
UI)))
+ (offset (%get-long buf #x3c)))
+ (assert (< offset bufsize) () "PEF header not within first=
~D bytes" bufsize)
+ (assert (=3D (%get-byte buf (+ offset 0)) (char-code #\P))=
()
+ "File does not appear to be a PEF file")
+ (assert (=3D (%get-byte buf (+ offset 1)) (char-code #\E))=
()
+ "File does not appear to be a PEF file")
+ (assert (=3D (%get-byte buf (+ offset 2)) 0) ()
+ "File does not appear to be a PEF file")
+ (assert (=3D (%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 of=
fset 68 in the
+ ;; "optional header" which appears right after the standa=
rd 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 (=3D nwritten nread)
(error "I/O error writing to fd ~d" out-fd)))
@@ -220,7 +244,8 @@
#-(or windows-target darwin-target) string))))
=
=
-(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)
(kernel-path)
@@ -238,9 +263,9 @@
(setq mode (logior #o111 mode)))
(let* ((image-fd (fd-open filename (logior #$O_WRONLY #$O_CREAT) mode)=
))
(unless (>=3D image-fd 0) (signal-file-error image-fd filename))
+ (when prepend-fd
+ (%prepend-file image-fd prepend-fd prepend-len #+windows-target applicati=
on-type))
(fd-chmod image-fd mode)
- (when prepend-fd
- (%prepend-file image-fd prepend-fd prepend-len))
image-fd)))
=
=
More information about the Openmcl-cvs-notifications
mailing list