Finding System folder, partial solution

[psto@xs4all.nl (Peter Stone)]

>#include <GestaltEqu.h>
>
>#define BTstQ(arg, bitnbr)        (arg & (1 << bitnbr))
>
>static OSErr findPrefFolder( short *foundVRefNum, long *foundDirID )
>{
>  long          gesResponse;
>  SysEnvRec     envRec;
>  WDPBRec       myWDPB;
>  unsigned char volName[34];
>  OSErr         err;
>
>  *foundVRefNum = 0;
>  *foundDirID = 0;
>  if ( !Gestalt( gestaltFindFolderAttr, &gesResponse )
>                && BTstQ( gesResponse, gestaltFindFolderPresent ) )
>  { /* Folder Manager exists */
>    err = FindFolder( kOnSystemDisk, kPreferencesFolderType, kCreateFolder,
>                       foundVRefNum, foundDirID );
>  }
>  else
>  { /* Gestalt can't give us the answer, so we resort to SysEnvirons */
>    if ( !(err = SysEnvirons( curSysEnvVers, &envRec )) )
>    {  myWDPB.ioVRefNum = envRec.sysVRefNum;
>       volName[0] = '\000';                   /* Zero volume name */
>       myWDPB.ioNamePtr = volName;
>       myWDPB.ioWDIndex = 0;
>       myWDPB.ioWDProcID = 0;
>       if ( !(err = PBGetWDInfo( &myWDPB, 0 )) )
>       { *foundVRefNum = myWDPB.ioWDVRefNum;
>         *foundDirID = myWDPB.ioWDDirID;
>       }
>    }
>  }
>  return (err);
>}

..argh..it's c, but I understand enough to test folder-manager-present,
and then I can find the preferences folder in System 7, otherwise I'm 
just setting the preferences in relation to the application. Push it
to *lisp-startup-functions* and it sets up *setup-folder* at startup.
Modify when required, and keep posted if you make it locating System 
folder in 6.

Peter

(defun str-cat (&rest l)
  (cond ((null l) "")
        (t (ccl::%str-cat (car l) (apply 'str-cat (cdr l))))))

(defun folder-manager-present ()
  (rlet ((response :pointer))
    (zerop (#_Gestalt #$gestaltFindFolderAttr response))))

(defun set-pref-folder ()
  (if (folder-manager-present)
    (setq *setup-folder* 
          (str-cat (mac-namestring 
                       (find-special-folder #$kPreferencesFolderType))
                   ":"))
    (setq *setup-folder* 
          (mac-namestring "ccl:Modules;Setup;"))))

;;; find-special-folder

#|

Directory                       Folder Type   Constant
Apple Menu Items                'amnu'        kAppleMenuFolderType
Control Panels                  'ctrl'        kControlPanelFolderType
Desktop Folder                  'desk'        kDesktopFolderType
Extensions                      'extn'        kExtensionFolderType
Preferences                     'pref'        kPreferencesFolderType
PrintMonitor Documents          'prnt'        kPrintMonitorDocsFolderType
Shared, network Trash directory 'empt'        kWhereToEmptyTrashFolderType
Single-user Trash directory     'trsh'        kTrashFolderType
Startup Items                   'strt'        kStartupFolderType
System Folder                   'macs'        kSystemFolderType
Temporary Items                 'temp'        kTemporaryFolderType

Example: (find-special-folder #$kPreferencesFolderType)

|#

(defun find-special-folder (type &optional (create-p t))
  (let ((kCreate (if create-p #$kCreateFolder #$kDontCreateFolder)))
    (rlet ((vrefnum_p :Integer)
           (foundDirId_p :LongInt)
           (fsSpec_p  :FSSpec))
      (#_FindFolder #$kOnSystemDisk type kCreate vrefnum_p foundDirId_p)
      (with-pstrs ((empty_cstr ""))
          (#_FSMakeFSSpec
            (%get-word vrefnum_p)
            (%get-long foundDirId_p)
            empty_cstr
            fsSpec_p))
      (%path-from-fsSpec fsSpec_p))))