Re: how to invoke Mac applications from MCL?

[slh@digitool.com (Steve Hain)]

At 8:14 PM 5/22/95, Ping Luo wrote:
>I am sure this is not something new; can someone tell me how to do it,
>say bringing up MS World from MCL?
>
>Thanks a million.
>
>-ping

The following code may not be the optimal way to do it, but it works for us:

; -*- Mode:Lisp; Package:CCL; -*-
(in-package :ccl)

(eval-when (:execute :compile-toplevel)
  (require 'lispequ)
  (require 'sysequ)
  (defconstant $AppParmHandle #xAEC)     ; handle to hold application parameters
  (defrecord LaunchStruct
    (pfName :pointer)
    (param :integer)
    (LC :unsigned-integer)                 ; extended parameters:
    (extBlockLen :longint)              ; number of bytes in extension = 6
    (fFlags :integer)                   ; Finder file info flags
    (launchFlags :unsigned-integer)        ; bit 15,14=1 for sublaunch, others reserved
    (reserved :integer)))

(defun sublaunch (path &optional file (stay-in-background-p nil))
  (when file (store-app-param-handle file))
  (rlet ((launch :LaunchStruct))
    (%stack-iopb (pb np)
      ;Get the Finder flags
      (%path-to-iopb path pb :errchk)
      (%put-ostype pb "ERIK" $ioWDProcID)
      (%put-ptr pb (%null-ptr) $ioFileName)
      (#_OpenWD :errchk pb)
      (#_SetVol :errchk pb)
      (%put-ptr pb np $ioFileName)
      (%put-long pb 0 $ioDirID)
      (%put-word pb 0 $ioFDirIndex)
      (#_GetCatInfo :errchk pb)
      (rset launch :LaunchStruct.pfName np)
      (rset launch :LaunchStruct.param 0)
      (rset launch :LaunchStruct.LC #x4C43)
      (rset launch :LaunchStruct.extBlockLen 6)
      ;Copy flags; set bit 6 of low byte to 1 for RO access:
      (rset launch :LaunchStruct.fFlags (%get-signed-word pb $fdFlags))
      (rset launch :LaunchStruct.launchFlags (logior 
                                              #$launchContinue
                                              (if stay-in-background-p #$launchDontSwitch 0)))
      (rset launch :LaunchStruct.reserved 0)
      (let ((err (%register-trap #xA9F2 #x108 launch)))
        (when (< err 0)
          (case err                     ; Process Manager errors
            ((-600) (error "No elegible process with specified descriptor"))
            ((-601) (error "Not enough room to launch application w/special requirements"))
            ((-602) (error "Memory mode is 32-bit, but application not 32-bit clean"))
            ((-603) (error "Application made module calls in improper order"))
            ((-604) (error "Hardware configuration not correct for call"))
            ((-605) (error "Application SIZE not big enough for launch"))
            ((-606) (error "Application is background-only, and launch flags disallow this"))
            (t (%err-disp err))))))))

(defun store-app-param-handle (file)
  (with-macptrs ((ploc (%int-to-ptr $appparmhandle)))
    (let ((params (%get-ptr ploc)))
      (when (%null-ptr-p params)
        (%put-ptr ploc (setq params (#_NewHandle :errchk 0))))
      (%stack-iopb (pb np)
        (%path-to-iopb file pb :errchk)
        (%put-ostype pb "ERIK" $ioWDProcID)
        (%put-ptr pb (%null-ptr) $ioFileName)
        (#_OpenWD :errchk pb)
        (#_SetHandleSize :errchk params (+ 13 (%get-byte np)))
        (with-dereferenced-handle (p params)
          (%put-word p 0 0)
          (%put-word p 1 2)
          (%put-word p (%get-word pb $ioVRefNum) 4)
          (%put-ptr pb np $ioFileName)
          (%put-long pb 0 $ioDirID)
          (%put-word pb 0 $ioFDirIndex)
          (#_GetCatInfo :errchk pb)
          (%put-ostype p (%get-ostype pb $fdType) 6)
          (%put-word p 0 10)
          (#_BlockMove np (%inc-ptr p 12) (1+ (%get-byte np))))))))

- Steve Hain

Digitool, Inc.
______________________________________________________________________________
                       One Main Street   7th Floor   Cambridge, MA 02142   USA
                              Internet: slh@digitool.com   AppleLink: digitool
                                      World Wide Web: http://www.digitool.com/
                                         Tel: 617 441-5000   Fax: 617 576-7680