{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}
{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}
{																								}
{							GENERIC PREFERENCE FILES								}
{							```````````````````````````````````````````								}
{																								}
{	Requires the Folders.p unit to be in the project.									}

{	A Generic Utilities unit, for use by any program.
	Copyright © by David Sinclair, 1990 ­ 2001.
	
	<http://www.dejal.com/pascal/>
	
	I am releasing these units to the Pascal community.  Feel free to use them in whole or part in your Pascal programs.
	You are also welcome to modify these units to suit your needs.  If you wish to re-distribute the sources with your changes,
	please clearly indicate that you have changed them.  In all cases, you must leave these comments and the copyright notice intact.
	If you use a significant portion of these units, I would appreciate acknowledgement in your About dialog and/or documentation,
	e.g. ³Dejal Generic Utilities copyright © by David Sinclair, 1990 - 2001.²
	
	I¹d appreciate it if you also e-mail me at <pascal@dejal.com> if you find these units useful.  If you have any questions about
	these units, you can e-mail me at that address and I will do my best to help, time permitting.  However, these units are provided
	³as is² and I do not guarantee their reliablity or suitability for any particular purpose.
	
	These units have been used extensively in my Dejal shareware and freeware products over the years.  Most of the code was written
	many years ago, and the code and style may not be optimal in all cases, but unless otherwise noted all routines have been used
	in released software, so should work as described.
	
	Please visit <http://www.dejal.com/> and try out Dejal QuickEncrypt and/or my other shareware products.  If you want to show
	your appreciation for these units financially, registrations for my shareware are always welcome!  Or you can make a donation to
	me via my online order form: <http://www.dejal.com/kagi/>.
	
	I hope you find these units useful, and good luck in your Pascal endeavors!
	
	- David Sinclair, Dejal
}
{											* * *												}
{	UNIT HISTORY:																		}
{																								}
{	Version:	Start - finish dates:	Comments / changes:								}
{																								}
{	1.0:		17 December 1990		Started work on the unit, for use with my Chatterbox	}
{											FKEY.  Based on MacOthello¹s File Operations unit	}
{				31 Mar ­ 1 Apr 91		Got around to finishing work on above				}
{	1.0.1:		7 April 1991			Fixed problem with icon walking on every save		}
{	1.0.2:		11 April 1991			Fixed problem of reporting file not found on open	}
{	1.1:		17 August 1991		Switched off dialog I/O for INITs						}
{	1.2:		9­10 Dec 1991			Puts Prefs file in the Preferences folder under 7.0.x	}
{											Added the prefsCopyResList function					}
{	1.3:		11 December 1991		Removed error alerts: stupid to report errs for prefs	}
{	2.0:		20 December 1991		First public release, in library form				}
{				27 October 2001		Public release as source code.						}
{											* * *												}
{	This unit was based on the File Operations unit from MacOthello, a 2nd year uni		}
{	assignment at the University of Auckland in 1990; written by Shane Henderson for		}
{	³MacCheckers², Nov - Dec 1989; revised by John Thornley, January 1990; adapted	}
{	to ³MacOthello² by Shane Henderson, January 1990; last alteration: 22 Feb 1990.		}
{											* * *												}
{	N.B:	Most of my units require the compile-time variables Œapplication¹	}
{			and Œdebug¹, both of which are booleans.									}
{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}
{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}


unit genPrefs;


interface


	uses
		Folders, genNumerics, genStrings;


	const
		resListType = 'Res#';
		maxResCount = 30;

	type
		resSpec = record
				theResType: resType;
				theResID: integer;
				newResID: integer
			end;

		resListRec = record
				count: integer;
				resToCopy: array[1..maxResCount] of resSpec
			end;
		resListPtr = ^resListRec;
		resListHandle = ^resListPtr;


	function prefsSave (prefsHandle: UNIV Handle; filename: str255; fileCreator, fileType: osType;	{}
									saveRoutine: procPtr): boolean;

{ Save the preference resources to a prefs file in the Preferences folder if under System }
{ 7.0 or greater, otherwise in the current System folder. }

{ This function calls a function in the host program to save the actual prefs resources to }
{ the prefs file, after opening or creating it successfully.  This function should be of the form: }

{		function savePrefs (prefsHandle: UNIV Handle): Boolean;		}

{ and should return true if the resources are saved correctly; use prefsCopyRes to copy any }
{ existing resources like a vers or TMPLs, and prefsSaveData for dynamic data.  PrefsHandle }
{ is a handle to your own data, as passed to prefsSave: this facility is provided for FKEYs }
{ and INITs, etc, which cannot have global data‹applications can simply use globals and }
{ pass nil for this handle. }


	function prefsRead (prefsHandle: UNIV Handle; filename: Str255; readRoutine: procPtr): boolean;

{ Read the preferences resources from the prefs file‹if present‹in the Preferences folder }
{ within the current System folder (for System 7.0 and greater) or in the root System folder }
{ (if prior to System 7.0).  If this function returns false, call your read routine yourself, to }
{ read the defaults from the program¹s resource fork. }

{ This function calls a function in the host program to read the actual prefs resources from }
{ the prefs file, after opening it successfully.  This function should be of the form: }

{		function readPrefs (prefsHandle: UNIV Handle): Boolean;		}

{ and should return true if the resources are read correctly.  The function should call }
{ GetResource for each resource it wishes to read from the prefs file, or whatever. }
{ PrefsHandle is a handle to your own data to be filled in by your readPrefs function: this }
{ facility is provided for FKEYs and INITs, etc, which cannot have global data‹ }
{ applications can simply use globals and pass nil for this handle. }


	function prefsCopyRes (theType: resType; theID, newID: integer): boolean;

{ Copies the specified resource from the application resource file to the current (or prefs) }
{ resource file.  Call this function during your savePrefs function for each resource to }
{ copy to the new prefs file (e.g. vers, TMPL, etc); note that you should use the following }
{ function if you are writing data from memory to the prefs file, rather than this one, as this }
{ one just copies existing‹unused‹resources.  You should specify the ID to use if different }
{ from its current ID.  N.B: this function does not open or close the resource file, and it does }
{ assume that the destination resource file is current (and also that the source was opened }
{ prior to the destination, and so is in the search path for getting resources), so do not call }
{ this routine anywhere except when you are in the savePrefs file without opening and }
{ closing the file manually. }


	function prefsSaveData (theData: handle; theType: resType; theID: integer; theName: str255): boolean;

{ Adds the specified data to the currently open resource file as a resource of theType, with }
{ theID and theName.  Returns true if successful.  Call this function during your savePrefs }
{ function for each item of data to be saved from memory.  Note: don¹t dispose of the data, }
{ since if you do it won¹t be available when the prefs file is saved.  See the above function }
{ for more comments regarding use of these functions. }


	function prefsCopyResList (resListID: integer): boolean;

{ Use this function to add several resources to the prefs file at the same time.  Pass the ID }
{ of a ŒRes#¹ resource (in the app file) which contains a list of resource types, current }
{ IDs, and new IDs.  (There is a template for the ŒRes#¹ resource in the genResFile.rsrc }
{ file.)  Simply calls the prefsCopyRes function, above, for each resource specified in the }
{ list.  Returns true if successful. }


{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}
{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}


implementation


	function getPrefsVolNum (var volNum: integer): osErr;

{ Returns the vRefNum (or a working directory number) of the Preferences folder if }
{ running under System 7 or greater, or of the System folder if pre-7.0. }
{ Written by David Sinclair, 9 December 1991. }

		var
			err: osErr;
			response: longint;
			hasFindFolder: boolean;
			theWorld: sysEnvRec;
			WDParamBlk: WDPBRec;
			prefsVRefNum: integer;
			prefsDirID: longint;
			unusedInt: integer;

	begin
		if gestalt(gestaltFindFolderAttr, response) = noErr then
			hasFindFolder:= bitTst(@response, 31 - gestaltFindFolderPresent)
		else
			hasFindFolder:= false;

		if hasFindFolder then
			begin
				err:= findFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, prefsVRefNum, prefsDirID);
				if err = noErr then
					begin
						with WDParamBlk do
							begin
								ioNamePtr:= nil;
								ioVRefNum:= prefsVRefNum;
								ioWDProcID:= longint('ERIK');
								ioWDDirID:= prefsDirID
							end;
						err:= PBOpenWDSync(@WDParamBlk);
						volNum:= WDParamBlk.ioVRefNum
					end
			end
		else
			begin
				err:= noErr;
				unusedInt:= sysEnvirons(curSysEnvVers, theWorld);
				volNum:= theWorld.sysVRefNum
			end;

		getPrefsVolNum:= err
	end;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION CallSaveOrReadRoutine (prefsHandle: UNIV Handle; userRoutine: ProcPtr): Boolean;
	{Calls the user¹s prefs saving or reading routine; a ProcPtr is used as this is only called once, so there¹s no need
		to store the UPP.}
	{Written by David Sinclair, 31 May 1997.}

{$IFC GENERATINGPOWERPC}
	CONST
		uppPrefsProcInfo = $000000D0; { FUNCTION (4 byte param): 1 byte result; }
	VAR
		theUPP:			UniversalProcPtr;
		result:				Boolean;
	BEGIN
		theUPP:= NewRoutineDescriptor(userRoutine,uppPrefsProcInfo,GetCurrentISA);
		
		result:= (CallUniversalProc(theUPP,uppPrefsProcInfo,prefsHandle)<>0);
		
		DisposeRoutineDescriptor(theUPP);
		
		CallSaveOrReadRoutine:= result
		END;
{$ELSEC}
	INLINE
		$205f, 	{ movea.l  (a7)+,a0		; (a0) is a ptr to string, 4(a0) is mode }
		$4e90;
{$ENDC}

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	function prefsSave (prefsHandle: UNIV Handle; filename: str255; fileCreator, fileType: osType;	{}
									saveRoutine: procPtr): boolean;

{ Save the preference resources to a prefs file in the Preferences folder if under System }
{ 7.0 or greater, otherwise in the current System folder. }

{ This function calls a function in the host program to save the actual prefs resources to }
{ the prefs file, after opening or creating it successfully.  This function should be of the form: }

{		function savePrefs (prefsHandle: UNIV Handle): Boolean;		}

{ and should return true if the resources are saved correctly; use prefsCopyRes to copy any }
{ existing resources like a vers or TMPLs, and prefsSaveData for dynamic data.  PrefsHandle }
{ is a handle to your own data, as passed to prefsSave: this facility is provided for FKEYs }
{ and INITs, etc, which cannot have global data‹applications can simply use globals and }
{ pass nil for this handle. }

{ Written by David Sinclair, 17 December 1990 & 31 March 1991; based heavily on the code }
{ from MacOthello: see unit header for copyright dates and names. }

		var
			unusedErr: OSErr;
			applResRefNum, oldVol, volumeNumber, resForkRef: integer;
			success, FileAlreadyExists, unusedBool: Boolean;
			TempName: str255;


		function FilePresent (FileName: str255; volume: integer): Boolean;
	{ Function to determine whether a file is present on the given volume. }
			var
				ReferenceNumber: integer;
				error: OSErr;
		begin
			error:= FSOpen(FileName, volume, ReferenceNumber);
			if error = NoErr then		{ File already exists so see if it, or the volume is locked }
				begin
					FilePresent:= true;
					error:= FSClose(ReferenceNumber)
				end
			else
				FilePresent:= false
		end; { of function FilePresent }

		function NoLocks (volume: integer; FileName: str255; FileIsPresent: Boolean): Boolean;
	{ Function to determine whether locks exist on the given volume. }
			var
				error: OSErr;
		begin
			if FileIsPresent then
				NoLocks:= rename(FileName, volume, FileName) = noErr
			else
				begin
					NoLocks:= create(FileName, volume, FileCreator, FileType) = noErr;
					error:= FSDelete(FileName, VolumeNumber)
				end
		end; { of of function NoLocks }

		function UniqueName (volume: integer): str255;
			var
				name: str255;
				error: OSErr;
				FileInfo: FInfo;
	{ Function that returns a name that is not used on the given volume. }
		begin
			name:= 'Klut';
			repeat
				name:= concat(name, 'z');
				error:= GetFInfo(name, volume, FileInfo);
			until error <> NoErr;
			UniqueName:= name
		end; { of function UniqueName }


		procedure copyTempToFile;

{ Copies the contents of the recently created temp file to the old prefs file. }
{ Written by David Sinclair, 7 April 1991. }

			var
				oldResForkRef: integer;
				fileSize: longint;
				buffPtr: ptr;

		begin
			success:= false;
			if openRF(filename, volumeNumber, oldResForkRef) = noErr then
				if openRF(tempName, volumeNumber, resForkRef) = noErr then

					if getEOF(resForkRef, fileSize) = noErr then
						begin
							buffPtr:= newPtr(fileSize);
							if buffPtr <> nil then
								if fsRead(resForkRef, fileSize, buffPtr) = noErr then

									if setEOF(oldResForkRef, 0) = noErr then
										if fsWrite(oldResForkRef, fileSize, buffPtr) = noErr then
											success:= true
						end;
			if success then			{ We only want to check for success here if all ok so far }
				success:= fsClose(oldResForkRef) = noErr
			else
				unusedErr:= fsClose(oldResForkRef);

			if success then			{ We only want to check for success here if all ok so far }
				success:= fsClose(resForkRef) = noErr
			else
				unusedErr:= fsClose(resForkRef)
		end;		{ Information copied! }


	begin
		SetCursor(getCursor(watchCursor)^^);

		if saveRoutine <> nil then
			begin
				applResRefNum:= curResFile;
				unusedErr:= getVol(nil, oldVol);

				success:= getPrefsVolNum(volumeNumber) = noErr;

				if success then
					success:= SetVol(nil, volumeNumber) = noErr;

				if success then
					begin
						FileAlreadyExists:= FilePresent(FileName, VolumeNumber);
						success:= NoLocks(VolumeNumber, FileName, FileAlreadyExists);
						if success then
							begin
								TempName:= UniqueName(VolumeNumber);
								success:= Create(TempName, VolumeNumber, FileCreator, FileType) = noErr;

								if success then
									begin				{ Create the resource fork of the file. }
										CreateResFile(TempName);
										success:= ResError = noErr;
									end;

								if success then	{ Open the resource fork. }
									begin
										ResForkRef:= OpenResFile(TempName);
										success:= ResError = noErr
									end;

								if success then
									success:= CallSaveOrReadRoutine(prefsHandle, saveRoutine);	{ Call the user-specified }
																		{ routine to save whatever }
																		{ resources are appropriate }

								CloseResFile(ResForkRef);			{ Here we only check the result of the }
								if success then							{ close if we have been successful so far. }
									success:= ResError = noErr;

								unusedErr:= flushVol(nil, volumeNumber);

								if success then
									if fileAlreadyExists then
										copyTempToFile			{ Copy the contents of the temp file to the prefs file }
									else
										success:= rename(TempName, VolumeNumber, FileName) = noErr;
												{ Rename the temp file as the real prefs file }

								unusedErr:= FSDelete(TempName, VolumeNumber)	{ Trash temp file }
							end { of if NoLocks }
					end; { of if success }

				unusedErr:= flushVol(nil, volumeNumber);

				useResFile(applResRefNum);
				unusedBool:= SetVol(nil, oldVol) = noErr;
				prefsSave:= success
			end
		else
			prefsSave:= false				{ Idiot didn¹t specify a save routine, so ignore data. }
	end;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	function prefsRead (prefsHandle: UNIV Handle; filename: Str255; readRoutine: procPtr): boolean;

{ Read the preferences resources from the prefs file‹if present‹in the Preferences folder }
{ within the current System folder (for System 7.0 and greater) or in the root System folder }
{ (if prior to System 7.0).  If this function returns false, call your read routine yourself, to }
{ read the defaults from the program¹s resource fork. }

{ This function calls a function in the host program to read the actual prefs resources from }
{ the prefs file, after opening it successfully.  This function should be of the form: }

{		function readPrefs (prefsHandle: UNIV Handle): Boolean;		}

{ and should return true if the resources are read correctly.  The function should call }
{ GetResource for each resource it wishes to read from the prefs file, or whatever. }
{ PrefsHandle is a handle to your own data to be filled in by your readPrefs function: this }
{ facility is provided for FKEYs and INITs, etc, which cannot have global data‹ }
{ applications can simply use globals and pass nil for this handle. }

{ Written by David Sinclair, 17 December 1990 & 31 March 1991; based heavily on the }
{ code from MacOthello: see unit header for copyright dates and names. }

		var
			oldVol, volumeNumber, applResRefNum, prefsResRefNum: integer;
			readOK, unusedBool: boolean;

	begin
		setCursor(getCursor(watchCursor)^^);

		if readRoutine <> nil then
			begin
				applResRefNum:= curResFile;
				readOk:= getVol(nil, oldVol) = noErr;

				readOk:= getPrefsVolNum(volumeNumber) = noErr;

				ReadOK:= SetVol(nil, volumeNumber) = noErr;

				if ReadOK then	{ Open the resource fork of the file. }
					begin
						prefsResRefNum:= OpenResFile(filename);
						if resError = fnfErr then		{ Don¹t report file not found errors }
							readOK:= false
						else
							ReadOK:= ResError = noErr
					end;

				if ReadOK then	{ Read in the prefs from the resource fork }

		{ We have to be extra careful here. If a resource is missing totally then GetResource	}
		{ returns nil and ResError = NoErr so we must check the handles returned as well.	}

					readOK:= CallSaveOrReadRoutine(prefsHandle, readRoutine);	{ Call the user-specified }
																	{ routine to read whatever }
																	{ resources are appropriate }
				CloseResFile(prefsResRefNum);
				if ReadOK then										{ We only want to check if all ok so far }
					ReadOK:= ResError = noErr;

				useResFile(applResRefNum);
				unusedBool:= SetVol(nil, oldVol) = noErr;
				prefsRead:= readOK
			end
		else
			prefsRead:= false			{ Idiot didn¹t specify a read routine, so ignore data. }
	end;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	function prefsCopyRes (theType: resType; theID, newID: integer): boolean;

{ Copies the specified resource from the application resource file to the current (or prefs) }
{ resource file.  Call this function during your savePrefs function for each resource to }
{ copy to the new prefs file (e.g. vers, TMPL, etc); note that you should use the following }
{ function if you are writing data from memory to the prefs file, rather than this one, as this }
{ one just copies existing‹unused‹resources.  You should specify the ID to use if different }
{ from its current ID.  N.B: this function does not open or close the resource file, and it does }
{ assume that the destination resource file is current (and also that the source was opened }
{ prior to the destination, and so is in the search path for getting resources), so do not call }
{ this routine anywhere except when you are in the savePrefs file without opening and }
{ closing the file manually. }
{ Written by David Sinclair, 31 March 1991. }

		var
			theResource: handle;
			theName: str255;

	begin
		prefsCopyRes:= false;

		theResource:= getResource(theType, theID);		{ Read the resource }
		if theResource <> nil then
			begin
				getResInfo(theResource, theID, theType, theName);

				detachResource(theResource);
				if resError = noErr then
					begin
						addResource(theResource, theType, newID, theName);	{ Add the resource }
						prefsCopyRes:= resError = noErr
					end;
			end
	end;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	function prefsSaveData (theData: handle; theType: resType; theID: integer; theName: str255): boolean;

{ Adds the specified data to the currently open resource file as a resource of theType, with }
{ theID and theName.  Returns true if successful.  Call this function during your savePrefs }
{ function for each item of data to be saved from memory.  Note: don¹t dispose of the data, }
{ since if you do it won¹t be available when the prefs file is saved.  See the above function }
{ for more comments regarding use of these functions. }
{ Written by David Sinclair, 1 April 1991. }

	begin
		AddResource(theData, theType, theID, theName);
		prefsSaveData:= ResError = NoErr
	end;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	function prefsCopyResList (resListID: integer): boolean;

{ Use this function to add several resources to the prefs file at the same time.  Pass the ID }
{ of a ŒRes#¹ resource (in the app file) which contains a list of resource types, current }
{ IDs, and new IDs.  (There is a template for the ŒRes#¹ resource in the genResFile.rsrc }
{ file.)  Simply calls the prefsCopyRes function, above, for each resource specified in the }
{ list.  Returns true if successful. }
{ Written by David Sinclair, 9 December 1991. }

		var
			resListHndl: resListHandle;
			success: boolean;
			hndlState: signedByte;
			index: integer;

	begin
		resListHndl:= resListHandle(getResource(resListType, resListID));

		if resListHndl = nil then
			prefsCopyResList:= false
		else
			begin
				success:= true;
				index:= 1;
				numLockHandle(resListHndl, hndlState);

				with resListHndl^^ do
					while (index <= count) & success do
						begin
							with resToCopy[index] do
								success:= prefsCopyRes(theResType, theResID, newResID);
							index:= index + 1
						end;

				numUnlockHandle(resListHndl, hndlState);

				prefsCopyResList:= success
			end
	end;


{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}
{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}


end.