opening a document in the finder (launching)

[alanr@bruckner.media-lab.media.mit.edu (Alan Ruttenberg)]

At  3:00 PM 5/11/94 +0000, Noel Rappin wrote:
>Also, how can you launch a finder document from MCL

call the function finder-open-documents (defined below) with &rest
args being the documents you want to open.

-alan

(in-package :ccl)

(require 'appleevent-toolkit)

(defconstant $kAEOpenSelection :|sope|)
(defconstant $kAEFinderEvents :|FNDR|)
(defconstant $keySelection :|fsel|)

(defun create-alias-record (the-desc path)
  (rlet ((alias :aliashandle))
    (let ((namestring (mac-namestring path)))
      (rlet ((fsspec :fsspec))
        (with-pstrs ((name namestring))
          (#_fsmakefsspec -1 -1 name fsspec))
        (rlet ((fsp :pointer))
          (%put-ptr fsp fsspec)
          (#_NewAlias fsp fsspec alias)))
      (with-dereferenced-handles ((aliasptr (%get-ptr alias)))
        ;(print-db (#_gethandlesize (%get-ptr alias)) (pref aliasptr :aliasrecord.aliassize))
        (#_AECreatedesc #$typeAlias aliasptr (#_gethandlesize (%get-ptr alias))  the-desc)
        (#_DisposHandle :check-error (%get-ptr alias))
        ))
  the-desc))


(defun create-finder-open-selection (the-desc the-target paths &rest create-keywords)
  (apply 'create-appleevent the-desc $kAEFinderEvents $kAEOpenSelection the-target
         create-keywords)
  (let ((directory (mac-namestring (make-pathname :directory (pathname-directory (car paths))))))
    ;(print directory)
    (with-aedescs (directory-alias rest-aliases)
      (create-alias-record directory-alias  directory)
      (create-alias-list rest-aliases paths)
      (ae-error (#_AEPutParamDesc the-desc #$keyDirectObject directory-alias))
      (ae-error (#_AEPutParamDesc the-desc $keySelection rest-aliases)))))
      

(defun finder-open-documents (&rest pathnames)
  (with-aedescs (appleevent reply target)
    (create-named-process-target target "Finder")
    (create-finder-open-selection appleevent target pathnames)
    (send-appleevent appleevent reply :reply-mode :no-reply)))