Changeset 11541


Ignore:
Timestamp:
Dec 17, 2008, 9:11:38 PM (11 years ago)
Author:
gb
Message:

Remove a stale comment (the init file loads in the initial listener thread.)

When starting up a standalone application, try to start and connect
to "AltConsole?.app", if that application bundle can be found in this
application bundle's Resources subdirectory.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/start.lisp

    r11397 r11541  
    9292    (#_ _exit -1))
    9393  (setq *standalone-cocoa-ide* t)
     94  ;; It's probably reasonable to do this here: it's not really IDE-specific
     95  (try-connecting-to-altconsole)
    9496  ;; TODO: to avoid confusion, should now reset *cocoa-application-path* to
    9597  ;; actual bundle path where started up.
     
    9799
    98100
    99 ;;; The saved image will be an instance of COCOA-APPLICATION (mostly
    100 ;;; so that it'll ignore its argument list.)  When it starts up, it'll
    101 ;;; run the Cocoa event loop in the cocoa event process.
    102 ;;; If you use an init file ("home:ccl-init"), it'll be loaded
    103 ;;; in an environment in which *STANDARD-INPUT* always generates EOF
    104 ;;; and where output and error streams are directed to the OSX console
    105 ;;; (see below).  If that causes problems, you may want to suppress
    106 ;;; the loading of your init file (via an :INIT-FILE nil arg to
    107 ;;; the call to SAVE-APPLICATION, below.)
     101
    108102
    109103(defun build-ide (bundle-path)
    110104  (setq bundle-path (ensure-directory-pathname bundle-path))
    111105
    112   ;; The bundle is expected to exists, we'll just add the executable into it.
     106  ;; The bundle is expected to exist, we'll just add the executable into it.
    113107  (assert (probe-file bundle-path))
    114108
     
    140134                      :application-class 'cocoa-application)))
    141135
     136;;; If we're running as a standalone .app, try to see if a bundle named
     137;;; AltConsole.app exists in our PlugIns directory.  If so, execute
     138;;; that bundle'es executable file, with its standard input/output/error
     139;;; descriptors connected to one end of a socketpair, and connect t
     140;;; descriptors 0,1,and 2 to the socket on the other end.
     141
     142(defun try-connecting-to-altconsole ()
     143  (with-autorelease-pool
     144      (let* ((main-bundle (#/mainBundle ns:ns-bundle))
     145             (resource-path (#/resourcePath main-bundle)))
     146        (block exit
     147          (when (%null-ptr-p resource-path)
     148            (return-from exit nil))
     149          (let* ((altconsole-bundle
     150                  (make-instance ns:ns-bundle
     151                                 :with-path
     152                                 (#/stringByAppendingPathComponent:
     153                                  resource-path
     154                                  #@"AltConsole.app"))))
     155            (when (%null-ptr-p altconsole-bundle)
     156              (return-from exit nil))
     157            (let* ((executable-path (#/executablePath altconsole-bundle)))
     158              (when (%null-ptr-p executable-path)
     159                (return-from exit nil))
     160              (let* ((nbytes (1+ (#/lengthOfBytesUsingEncoding:
     161                                  executable-path
     162                                  #$NSUTF8StringEncoding))))
     163                (%stack-block ((c-executable-path nbytes))
     164                  (unless (#/getCString:maxLength:encoding:
     165                           executable-path
     166                           c-executable-path
     167                           nbytes
     168                           #$NSUTF8StringEncoding)
     169                    (return-from exit nil))
     170                  (rletz ((argv (:array :address 2))
     171                          (envp (:array :address 1))
     172                          (sockets (:array :int 2)))
     173                    (setf (paref argv (:array :address) 0) c-executable-path)
     174                    (unless (eql 0 (#_socketpair #$AF_UNIX #$SOCK_STREAM 0 sockets))
     175                      (return-from exit nil))
     176                    (let* ((parent-socket (paref sockets (:array :int) 0))
     177                           (child-socket (paref sockets (:array :int) 1))
     178                           (pid (#_fork)))
     179                      (case pid
     180                        (-1
     181                         ;; Fork failed
     182                         (#_close parent-socket)
     183                         (#_close child-socket)
     184                         (return-from exit nil))
     185                        (0
     186                         ;; This runs in the child.
     187                         (#_close parent-socket)
     188                         (#_dup2 child-socket 0)
     189                         (#_dup2 child-socket 1)
     190                         (#_dup2 child-socket 2)
     191                         (#_execve c-executable-path
     192                                   argv
     193                                   envp)
     194                         ;; If the #_exec fails, there isn't
     195                         ;; much to do or say about it.
     196                         (#__exit 1))
     197                        (t
     198                         ;; We're the parent.
     199                         (#_close child-socket)
     200                         (when (eq t (ccl::check-pid pid))
     201                           (#_dup2 parent-socket 0)
     202                           (#_dup2 parent-socket 1)
     203                           (#_dup2 parent-socket 2)
     204                           pid)))))))))))))
     205                     
     206                   
     207             
    142208;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    143209
Note: See TracChangeset for help on using the changeset viewer.