{From ftp.apple.com /dts/mac/sc/snippets}
{Requires DLOG, DITL, and STR# resources ID 250}
{ GetFolder Unit }
{ Greg Robbins 5/92  }

{ Think Pascal 4.01; requires System 7 }

unit GetFolder;
interface
	uses
		StandardFile, Script, Folders, Aliases; { MPW users need to use more }

	procedure StandardGetFolder (var theSFR: StandardFileReply);

implementation

	const
		kSelectItem = 10; { select button }

		kDlgID = 250; { dialog resource number }

		kStrListID = 250;
		kSelectStrNum = 1; { word 'Select: ' for button }
		kDesktopStrNum = 2; { word 'Desktop' for button }

		kSelectKey = 's'; { command key equivalent for Select }

	type
		UserDataRec = record { for standard file dialog hook }
				SFRPtr: ^StandardFileReply; { so the hook routine can look at what's in the reply record }
				oldSelectionFSSpec: FSSpec; { tracks the previous selection so we can tell when to change the button name }
				theDlgPtr: DialogPtr;
			end;
		UserDataRecPtr = ^UserDataRec;

	function GetSelectLabel: Str255;
	begin
		GetIndString(GetSelectLabel, kStrListID, kSelectStrNum);
	end;

	function GetDesktopName: Str255;
	begin
		GetIndString(GetDesktopName, kStrListID, kDesktopStrNum);
	end;

	{ 'Select' button name needs to reflect the current selection }
	{ quoteFlag indicates that the button name should be in quotes, like Select ÒFoofileÓ }
	procedure SetButtonName (theDlgPtr: DialogPtr; buttonID: Integer; buttonName: Str255; quoteFlag: Boolean);
		var
			buttonType: Integer;
			buttonHandle: Handle;
			buttonRect: Rect;
			textWidth: Integer;
			retCode: OSErr;
	begin
		GetDItem(theDlgPtr, buttonID, buttonType, buttonHandle, buttonRect);
		if quoteFlag then begin
				textWidth := (buttonRect.right - buttonRect.left) - (StringWidth(GetSelectLabel) + StringWidth('Ò Ó'));
				retCode := TruncString(textWidth, buttonName, smTruncMiddle);
				SetCTitle(ControlHandle(buttonHandle), Concat(GetSelectLabel, 'Ò', buttonName, 'Ó'))
			end
		else begin
				textWidth := (buttonRect.right - buttonRect.left) - (StringWidth(GetSelectLabel) + CharWidth(' '));
				retCode := TruncString(textWidth, buttonName, smTruncMiddle);
				SetCTitle(ControlHandle(buttonHandle), Concat(GetSelectLabel, buttonName))
			end;
		ValidRect(buttonRect); { avoids flickering due to unnecessary redrawing }
	end;

	{ briefly highlight the button as feedback for key equivalents }
	procedure FlashButton (theDlgPtr: DialogPtr; buttonID: Integer);
		var
			buttonType: Integer;
			buttonHandle: Handle;
			buttonRect: Rect;
			finalTicks: LongInt;
	begin
		GetDItem(theDlgPtr, buttonID, buttonType, buttonHandle, buttonRect);
		HiliteControl(ControlHandle(buttonHandle), inButton);
		Delay(5, finalTicks);
		HiliteControl(ControlHandle(buttonHandle), 0);
	end;

	function SameFSSpec (itemFSSpec1, itemFSSpec2: FSSpec): Boolean;
	begin
		SameFSSpec := (itemFSSpec1.vRefNum = itemFSSpec2.vRefNum) and (itemFSSpec1.parID = itemFSSpec2.parID) and (itemFSSpec1.name = itemFSSpec2.name);
	end;

	{ dialog filter maps a key to the Select button }
	function MyModalDlgFilter (theDlgPtr: DialogPtr; var myEvtRec: EventRecord; var item: Integer; myDataPtr: Ptr): Boolean;
	begin
		MyModalDlgFilter := FALSE;

	{ make certain the proper dialog is showing }
		if WindowPeek(theDlgPtr)^.refCon <> LongInt(sfMainDialogRefCon) then
			Exit(MyModalDlgFilter);

	{ check if select button hit }
		if myEvtRec.what = keyDown then
			if (BAND(cmdKey, myEvtRec.modifiers) <> 0) and (Char(BAND(myEvtRec.message, charCodeMask)) = kSelectKey) then begin
					item := kSelectItem;
					MyModalDlgFilter := TRUE;
					FlashButton(theDlgPtr, kSelectItem);
				end;
	end;

	{ filter out everything but folders from the dialog }
	function MyCustomFileFilter (myCInfoPBPtr: CInfoPBPtr; myDataPtr: Ptr): Boolean;
	begin
		MyCustomFileFilter := not BTST(myCInfoPBPtr^.ioFlAttrib, 4);
	end;

	{ the hook routine maps the select button to Open and sets the Select button name }
	function MyDlgHook (item: Integer; theDlgPtr: DialogPtr; myDataPtr: Ptr): Integer;
		var
			theUserDataRecPtr: UserDataRecPtr;
			desktopVRefNum: Integer;
			desktopDirID: LongInt;
			tempFSSpec: FSSpec;
			retCode: OSErr;
	begin

	{ make certain the proper dialog is showing }
		if WindowPeek(theDlgPtr)^.refCon <> LongInt(sfMainDialogRefCon) then begin
				MyDlgHook := item;
				Exit(MyDlgHook)
			end;

		theUserDataRecPtr := UserDataRecPtr(myDataPtr);

		if item = kSelectItem then
			item := sfItemOpenButton;

		MyDlgHook := item;


	{ find desktop folder }
		retCode := FindFolder(theUserDataRecPtr^.SFRPtr^.sfFile.vRefNum, kDesktopFolderType, kDontCreateFolder, desktopVRefNum, desktopDirID);

	{ change button if selection has changed or this is the first call }
		if (not SameFSSpec(theUserDataRecPtr^.oldSelectionFSSpec, theUserDataRecPtr^.SFRPtr^.sfFile)) or (item = sfHookFirstCall) or (item = sfHookChangeSelection) or (item = sfHookRebuildList) then

			if theUserDataRecPtr^.SFRPtr^.sfFile.name <> '' then { selecting a folder }
				SetButtonName(theDlgPtr, kSelectItem, theUserDataRecPtr^.SFRPtr^.sfFile.name, TRUE)
			else { no name selected }

		{ is the desktop selected? }
				if (theUserDataRecPtr^.SFRPtr^.sfFile.vRefNum = desktopVRefNum) and (theUserDataRecPtr^.SFRPtr^.sfFile.parID = desktopDirID) then
			{ set button to Desktop }
					SetButtonName(theDlgPtr, kSelectItem, GetDesktopName, FALSE)

				else { get parent directory's name }
					begin
						retCode := FSMakeFSSpec(theUserDataRecPtr^.SFRPtr^.sfFile.vRefNum, theUserDataRecPtr^.SFRPtr^.sfFile.parID, '', tempFSSpec);
						SetButtonName(theDlgPtr, kSelectItem, tempFSSpec.name, TRUE);
					end;

	{ save the current selection as the old selection for comparison next time }

		if (item <> sfHookFirstCall) or (theUserDataRecPtr^.SFRPtr^.sfFile.name <> '') then
			theUserDataRecPtr^.oldSelectionFSSpec := theUserDataRecPtr^.SFRPtr^.sfFile

		else { on first call, empty string won't set the button correctly, so invalidate oldSelection }
			theUserDataRecPtr^.oldSelectionFSSpec.name := '_:_';

	end;


	procedure StandardGetFolder (var theSFR: StandardFileReply);
		var
			mySFTypeList: SFTypeList;
			thePoint: Point;
			myData: UserDataRec;
			tempFSSpec: FSSpec;
			retCode: OSErr;
			folderFlag, wasAliasedFlag: Boolean;
			gestaltSFResponse: LongInt;
	begin

	{ use Gestalt to check for the CustomGetFile call }

		retCode := Gestalt(gestaltStandardFileAttr, gestaltSFResponse);
		if (retCode <> noErr) or not BTST(gestaltSFResponse, gestaltStandardFile58) then begin
				theSFR.sfGood := false;
				Exit(StandardGetFolder);
			end;

		SetPt(thePoint, -1, -1); { center dialog }
		theSFR.sfFile.name := ' '; { for initial button contents }

	{ point the user data parameter at the reply record so we can get to it later }
		myData.SFRPtr := @theSFR;

	{ throw up the dialog }
		CustomGetFile(@MyCustomFileFilter, 0, mySFTypeList, theSFR, kDlgID, thePoint, @MyDlgHook, @myModalDlgFilter, nil, nil, @myData);

		if theSFR.sfGood then { cancel not pressed and no fatal error occured }
			begin
		{ if no name in the reply record file spec, use file spec of parent folder }
				if theSFR.sfFile.name = '' then begin
			{ make file spec for parent folder }
						retCode := FSMakeFSSpec(theSFR.sfFile.vRefNum, theSFR.sfFile.parID, '', tempFSSpec);
						if retCode = noErr then
			{ assign the parent folder's spec & check if it was for a volume }
							theSFR.sfFile := tempFSSpec
						else
							theSFR.sfGood := FALSE; { no name to return, forget it }
					end;

		{ if there is now a name in the file spec, check if it is a folder or a volume }
				if theSFR.sfFile.name <> '' then begin
						if theSFR.sfFile.parID = 1 then begin
								theSFR.sfIsVolume := TRUE;
								theSFR.sfIsFolder := FALSE { it would be reasonable to make this true, too }
							end;

			{ we have a valid FSSpec, now let's make sure it's not for an alias file }
						retCode := ResolveAliasFile(theSFR.sfFile, TRUE, folderFlag, wasAliasedFlag);
						if retCode <> noErr then
							theSFR.sfGood := false;

			{ did the alias file resolve to a folder? }
						if folderFlag and not theSFR.sfIsVolume then
							theSFR.sfIsFolder := TRUE;
					end;
			end;
	end;

end.