Re: HELP: Pathname Translations

[moon (David A. Moon)]

This doesn't have anything to do with Lisp's file name interface,
but it does seem to be the answer to your question.

This is how you find out where MPW is, the same way the Finder does
(this does not work in System 6):

(in-package CCL)

;;; A handy subroutine, only works in system 7
;;; Returns the pathname of the application or nil if not found on any volume
;;; Several undocumented errors can occur, I hope I found them all
(defun application-pathname (signature)
  (rlet ((pb :dtpbrec)
         (iopb :hparamblockrec))
    (%stack-block ((name 256)) 
      (setf (rref iopb :hparamblockrec.ioCompletion) (%null-ptr)
            (rref iopb :hparamblockrec.ioNamePtr) name)
      (loop for volume-index from 1 do
        (setf (rref iopb :hparamblockrec.ioVolIndex) volume-index
              (rref iopb :hparamblockrec.ioVRefNum) 0)
        (let ((err (#_PBHGetVInfo iopb)))
          (unless (zerop err)
            (if (= err #$nsvErr)
              (return-from application-pathname nil)
              (error "_PBHGetVInfo error #~D" err))))
        (setf (rref pb :dtpbrec.ioCompletion) (%null-ptr)
              (rref pb :dtpbrec.ioNamePtr) name
              (rref pb :dtpbrec.ioVRefNum) (rref iopb :hparamblockrec.ioVRefNum))
        (let ((err (#_PBDTGetPath pb)))
          (unless (zerop err)
            (unless (= err #$wrgVolTypErr)
              (error "_PBDTGetPath error #~D" err))))
        (setf (rref pb :dtpbrec.ioIndex) 0
              (rref pb :dtpbrec.ioFileCreator) signature)
        (let ((err (#_PBDTGetAPPL pb)))
          (cond ((zerop err)
                 (setf (rref iopb :hparamblockrec.ioDirID) (rref pb :dtpbrec.ioAPPLParID))
                 (return-from application-pathname (%path-from-iopb iopb)))
                ((and (/= err #$afpItemNotFound) (/= err #$fnfErr))
                 (error "_PBDTGetAPPL error #~D" err))))))))

(application-pathname "MPS ")

"MPS " is the Macintosh application signature of the MPW Shell.

(make-pathname :defaults (or (application-pathname "MPS ")
                             (error "Unable to find MPW."))
               :name nil :type nil :version nil)

if you want to get a pathname with just the directory in it.