Re: I'm trying to have lisp launch an application (its not working)

[bill@cambridge.apple.com (Bill St. Clair)]

>To do this I'm attempting to use the applevents toolkit and the Open
>Selection applevent for the finder. I've written:

You could call the process manager yourself.

Here's a file that I use every day. It allows you bring MCL to the front
by holding down the Control, Option, & Command keys and defines keys to
select a number of applications that I use a lot. The beginning of
the file is the process manager stuff. I don't know if it will work
in 2.0b1.

---------------------------------------------------------------------------

; processes.lisp
;
; Enough process stuff to select AppleLink and get back with the keyboard

(in-package :ccl)

(defmacro with-processInfoRec (sym &body body)
  (let ((name (gensym))
        (fsspec (gensym)))
    `(rlet ((,sym :ProcessInfoRec)
            (,name (string 32))
            (,fsSpec :FSSpec))
       (setf (pref ,sym processInfoRec.processInfoLength) (record-length :processInfoRec)
             (pref ,sym processInfoRec.processName) ,name
             (pref ,sym processInfoRec.processAppSpec) ,fsSpec)
       ,@body)))  

(defun launch-application (filename)
  (rlet ((fsspec :FSSpec))
    (rlet ((pb :launchParamBlockRec
               :launchBlockID #$extendedBlock
               :launchEPBLength #$extendedBlockLen
               :launchControlFlags (+ #$launchContinue #$launchNoFileFlags)
               :launchAppSpec fsspec
               :launchAppParameters (%null-ptr)))
      (with-pstrs ((name (mac-namestring (probe-file filename))))
        (#_FSMakeFSSpec 0 0 name fsspec))
      (when (eql 0 (#_LaunchApplication pb))
        filename))))

; Given a four-character creator code, finds the most recent application.
; Searches the mounted devices in the order mounted (same as the Finder?)
; until it finds one.
(defun get-creator-path (creator)
  (let ((devs (directory "*:")))
    (dolist (vrefnum (sort (mapcar 'volume-number devs) #'>))
      (rlet ((pb :DTPBRec
                 :ioNamePtr (%null-ptr)
                 :ioVRefnum vrefnum)
             (fsspec :fsspec))
        (when (eql 0 (#_PBDTGetPath pb))
          (setf (rref pb :DTPBRec.ioNamePtr)
                (%inc-ptr fsspec (get-field-offset :fsspec.name))
                (pref pb :DTPBRec.ioIndex) 0
                (pref pb :DTPBRec.ioFileCreator) creator)
          (when (eql 0 (#_PBDTGetAPPL pb))
            (setf (pref fsspec :fsspec.vRefnum) vrefnum
                  (pref fsspec :fsspec.parID) (pref pb :DTPBRec.ioAPPLParID))
            (return (%path-from-fsspec fsspec))))))))
                               
(defun launch-creator (creator)
  (let ((file (get-creator-path creator)))
    (when file
      (launch-application file))))

; From IM VI p. 29-11
(defun find-process (signature &optional psn)
  (unless psn (setq psn  (make-record :processSerialNumber)))
  (with-processInfoRec infoRec
    (setf (pref psn :processSerialNumber.highLongOfPSN) 0
          (pref psn :processSerialNumber.lowLongOfPSN) 0)
    (loop
      (unless (eql (#_GetNextProcess psn) #$noErr) (return nil))
      (when (and (eql (#_getProcessInformation psn infoRec) #$noErr)
                 (%equal-ostype infoRec :APPL
                                (get-field-offset :processInfoRec.processType))
                 (%equal-ostype infoRec signature
                                (get-field-offset :processInfoRec.processSignature)))
        (return psn)))))
                 
(defun select-process (creator &optional (launch? t))
  (rlet ((psn :processSerialNumber))
    (if (find-process creator psn)
      (#_setFrontProcess psn)
      (unless (and launch? (launch-creator creator))
        (ed-beep)))))

(defun select-applelink (&optional ignore)
  (declare (ignore ignore))
  (select-process :GEOL))

(def-fred-command (:control :shift #\A) select-applelink)

(defun select-macx (&optional ignore)
  (declare (ignore ignore))
  (select-process :|MacX|))
(def-fred-command (:control :shift #\X) select-macx)

(defun select-techmail (&optional ignore)
  (declare (ignore ignore))
  (select-process :MITM))
(def-fred-command (:control :shift #\T) select-techmail)

(defun select-Eudora (&optional ignore)
  (declare (ignore ignore))
  (select-process :|CSOm|))
(def-fred-command (:control :shift #\E) select-eudora)

(defun select-macterminal (&optional ignore)
  (declare (ignore ignore))
  (select-process :|Term|))
(def-fred-command (:control :shift #\M) select-macterminal)

(defun select-zterm (&optional ignore)
  (declare (ignore ignore))
  (select-process :\zTRM))
(def-fred-command (:control :shift #\Z) select-zterm)

(defun select-msword (&optional ignore)
  (declare (ignore ignore))
  (select-process :MSWD))
(def-fred-command (:control :shift #\W) select-msword)

(defun select-mcl ()
  (rlet ((psn :processSerialNumber))
    (#_getCurrentProcess psn)
    (#_setFrontProcess psn)))

(defun select-mcl-eventhook (&rest ignore)
  (declare (ignore ignore))
  (unless *foreground*
    (let ((*current-event* nil))
      (makunbound '*current-event*)
      (when (and (control-key-p) (option-key-p) (command-key-p))
        (select-mcl))))
  nil)

(push 'select-mcl-eventhook *eventhook*)

(provide :processes)