#ifndef WYRM_PREF_H
#define WYRM_PREF_H

	//	wyrm-pref - Copyright (C) 2002 SM Ryan.  All rights reserved.

	#include "wyrmwif.h"
	
	<Declare wyrm_preference>
	<Declare wyrm_preferenceDelete>
	<Declare wyrm_preferenceCommandInit>

#endif

		

static const char COPYRIGHT[] = "wyrm-pref - Copyright (C) 2002 SM Ryan.  All rights reserved.";

#include "wyrm-pref.h"
#include "wyrm-pref.sys"

<Declare onError>
<pref command>
<pref command initialiser>

		

Obj wyrm_preference(Intr intr,chars group,chars variable,chars value);

int wyrm_preferenceDelete(Intr intr,chars group);

static bool onError(int ec,Intr intr,chars where);
		

#include <errno.h>
#include <stdlib.h>
#include <unistd.h>
#include <sys/file.h>

<Error handling (Unix)>
<Get or set a preference variable (Unix)>
<Delete a variable group (Unix)>
			
		

Obj wyrm_preference(Intr intr,chars group,chars variable,chars value) {
	Obj r = 0;

	<wyrm_preference variables (Unix)>
	<File path variables (Unix)>
	<Determine preference file path (Unix)>
	if (value) {
		<Determine temporary file path (Unix)>
	}
	<Open file paths (Unix)>
	<Scan the preference file for the variable (Unix)>
	<Continue updating preference file if modified (Unix)>
	if (value) {
		<Link the modified preferences onto the original (Unix)>
	}
	<Close preference file and exit (Unix)>
}

		

Obj	prefPath = 0;
chars home;

		

home = getenv("HOME");

prefPath = incr(Tcl_NewObj());
if (home) Tcl_AppendToObj(prefPath,home,-1);
Tcl_AppendToObj(prefPath,"/.",-1);
Tcl_AppendToObj(prefPath,group,-1);
Tcl_AppendToObj(prefPath,"rc",-1);

		

Obj	tempPath = 0;

		

tempPath = incr(Tcl_NewObj());
if (home) Tcl_AppendToObj(tempPath,home,-1);
Tcl_AppendToObj(tempPath,"/.",-1);
Tcl_AppendToObj(tempPath,group,-1);
Tcl_AppendToObj(tempPath,".tmp",-1);
tempChan = Tcl_OpenFileChannel(intr,Tcl_GetStringFromObj(tempPath,0),"w",0644);

		

Tcl_Channel prefChan = 0, tempChan = 0;

		

{
	chars fn = Tcl_GetStringFromObj(prefPath,0); int fd; ClientData FD;
	prefChan = Tcl_OpenFileChannel(intr,fn,"r",0);
	if (prefChan) {
		FD = &fd;
		if (onError(Tcl_GetChannelHandle(prefChan,TCL_READABLE,&FD)==TCL_ERROR,intr,fn)) goto exit;
		fd = (int)FD;
		if (onError(flock(fd,LOCK_EX)<0,intr,fn)) goto exit;
	}

	if (value) {
		fn = Tcl_GetStringFromObj(tempPath,0);
		tempChan = Tcl_OpenFileChannel(intr,fn,"w",0644);
		if (onError(!tempChan,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
		FD = &fd;
		if (onError(Tcl_GetChannelHandle(tempChan,TCL_WRITABLE,&FD)==TCL_ERROR,intr,fn)) goto exit;
		fd = (int)FD;
		if (onError(flock(fd,LOCK_EX)<0,intr,fn)) goto exit;
	}
}
		

int n = strlen(variable);
Obj line = incr(Tcl_NewObj());

		

for (;;) {
	int m; chars s,s1;
	if (!prefChan) break;
	Tcl_SetObjLength(line,0);
	if (Tcl_GetsObj(prefChan,line)<=0) {
		if (onError(!Tcl_Eof(prefChan),intr,Tcl_GetStringFromObj(prefPath,0))) goto exit;
		break;
	}
	s = Tcl_GetStringFromObj(line,&m);
	while (n>0 && isspace(*s)) {s++; n--;}
	if (*s!='#' && m>n && s[n]=='=' && memcmp(s,variable,n)==0) {
		r = incr(Tcl_NewStringObj(s+n+1,m-n-1));
		if (tempChan) {
			if (onError(Tcl_Write(tempChan,variable,-1)<=0,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
			if (onError(Tcl_Write(tempChan,"=",-1)<=0,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
			if (onError(Tcl_Write(tempChan,value,-1)<=0,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
			if (onError(Tcl_Write(tempChan,"\n",-1)<=0,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
		}
		break;
	}else {
		if (tempChan) {
			if (onError(Tcl_Write(tempChan,s,m)<=0,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
			if (onError(Tcl_Write(tempChan,"\n",-1)<=0,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
		}
	}
}
if (tempChan && !r) {
	if (onError(Tcl_Write(tempChan,variable,-1)<=0,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
	if (onError(Tcl_Write(tempChan,"=",-1)<=0,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
	if (*value) {
		if (onError(Tcl_Write(tempChan,value,-1)<=0,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
	}
	if (onError(Tcl_Write(tempChan,"\n",-1)<=0,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
}
if (!r)
	r = incr(Tcl_NewObj());

		

if (tempChan && prefChan && !Tcl_Eof(prefChan)) {
	for (;;) {
		int m; chars s;
		if (!prefChan) break;
		Tcl_SetObjLength(line,0);
		if (Tcl_GetsObj(prefChan,line)<=0) {
			if (onError(!Tcl_Eof(prefChan),intr,Tcl_GetStringFromObj(prefPath,0))) goto exit;
			break;
		}
		s = Tcl_GetStringFromObj(line,&m);
		if (onError(Tcl_Write(tempChan,s,m)<=0,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
		if (onError(Tcl_Write(tempChan,"\n",-1)<=0,intr,Tcl_GetStringFromObj(tempPath,0))) goto exit;
	}
}

		

chars prefName,tempName;

		

prefName = Tcl_GetStringFromObj(prefPath,0);
tempName = Tcl_GetStringFromObj(tempPath,0);
unlink(prefName);
if (onError(link(tempName,prefName)<0,intr,"wyrm_preference: link new prefs")) goto exit;
unlink(tempName);

		

exit:
	decr(prefPath);
	decr(tempPath);
	if (prefChan) Tcl_Close(intr,prefChan);
	if (tempChan) Tcl_Close(intr,tempChan);
	decr(line);
	return r;

		

int wyrm_preferenceDelete(Intr intr,chars group) {
	int	rc; chars prefName;

	
	<File path variables (Unix)>
	
	<Determine preference file path (Unix)>
	


	prefName = Tcl_GetStringFromObj(prefPath,0);
	rc = unlink(prefName);
	if (rc<0 && errno==ENOENT) {
		rc = TCL_OK;
	}else if (onError(rc<0,intr,"wyrm_preferenceDelete unlink")) {
		rc = TCL_ERROR;
	}else {
		rc = TCL_OK;
	}
	decr(prefPath);
	return rc;
}

		

static bool onError(int ec,Intr intr,chars where) {
	if (ec) {
		if (intr) {
			Tcl_ResetResult(intr);
			Tcl_AppendResult(intr,where,": ",strerror(errno),0);
		}
		return true;
	}else
		return false;
}

		

#include <Errors.h>
#include <Files.h>
#include <Finder.h>
#include <Folders.h>
#include <Resources.h>
#include <TextUtils.h>

//
//	CopyCStringToPascal converts the source C string to a destination
//	pascal string as it copies. The dest string will
//	be truncated to fit into an Str255 if necessary.
// If the C String pointer is NULL, the pascal string's length is set to zero
//
static void CopyCStringToPascal(const char* src, Str255 dst)
{
	short	length = 0;

	// handle case of overlapping strings
	if ( (void*)src == (void*)dst )
	{
		unsigned char*		curdst = &dst[1];
		unsigned char		thisChar;

		thisChar = *(const unsigned char*)src++;
		while ( thisChar != '\0' )
		{
			unsigned char	nextChar;

			// use nextChar so we don't overwrite what we are about to read
			nextChar = *(const unsigned char*)src++;
			*curdst++ = thisChar;
			thisChar = nextChar;

			if ( ++length >= 255 )
				break;
		}
	}
	else if ( src != NULL )
	{
		unsigned char*		curdst = &dst[1];
		short				overflow = 255;		// count down so test it loop is faster
		register char		temp;

		// Can't do the K&R C thing of while (*s++ = *t++) because it will copy trailing zero

		// which might overrun pascal buffer. Instead we use a temp variable.
		while ( (temp = *src++) != 0 )
		{
			*(char*)curdst++ = temp;

			if ( --overflow <= 0 )
				break;
		}
		length = 255 - overflow;
	}
	dst[0] = length;
}

<Error handling (Macintosh)>
<Get or set a preference variable (Macintosh)>
<Delete a variable group (Macintosh)>
			
		

Obj wyrm_preference(Intr intr,chars group,chars variable,chars value) {
	Obj r = 0;
	int	rc;

	<wyrm_preference variables (Macintosh)>
	<File path variables (Macintosh)>
	<Determine preference file path (Macintosh)>
	<Open the resource fork of the preference file (Macintosh)>
	<Get the old STR value (Macintosh)>
	if (value) {
		<Save the new STR value (Macintosh)>
	}
	<Close resource file and exit (Macintosh)>
}

		

short	vol;
long	dir;
Str255	pgroup;
FSSpec	spec;

		

if (!onError(rc=FindFolder(kOnSystemDisk,'pref',kCreateFolder,&vol,&dir),intr,"find pref folder")) {
	CopyCStringToPascal(group,pgroup);
	rc = FSMakeFSSpec(vol,dir,pgroup,&spec);
}

		

enum {invalidfref = -1};
int fn = invalidfref;

		

if (rc==fnfErr) {
	if (value) {
		FSpCreateResFile(&spec,'RSED','rsrc',smSystemScript);
		rc = ResError();
	}else {
		r = incr(Tcl_NewObj());
		goto exit;
	}
}
if (onError(rc,intr,"wyrm_preference find pref folder")) goto exit;
fn = FSpOpenResFile(&spec,value ? fsRdWrPerm : fsRdPerm);
if (fn==invalidfref && onError(ResError(),intr,group)) goto exit;

		

bytes	*h;

		

h = (bytes*)get1namedresource('STR ',variable);
if (!h) {
	rc = ResError();
	if (rc!=resNotFound) {
		if (onError(rc,intr,"wyrm_preference: reading old value")) goto exit;
	}
	r = incr(Tcl_NewObj());
}else {
	r = incr(Tcl_NewStringObj((chars)(*h + 1),**h));
}

		

if (!h) {
	h = (bytes*)NewHandle(strlen(value)+1);
	if (onError(MemError(),intr,"wyrm_preference writing new value")) goto exit;
	CopyCStringToPascal(value,*h);
	addresource((chars*)h,'STR ',UniqueID('STR '),variable);
	if (onError(ResError(),intr,"wyrm_preference: writing new value")) goto exit;
}else {
	SetHandleSize((chars*)h,strlen(value)+1);
	if (onError(MemError(),intr,"wyrm_preference: writing new value")) goto exit;
	CopyCStringToPascal(value,*h);
	ChangedResource((chars*)h);
	if (onError(ResError(),intr,"wyrm_preference: writing new value")) goto exit;
}

		

exit:
	if (fn!=invalidfref) CloseResFile(fn);
	return r;

		

int wyrm_preferenceDelete(Intr intr,chars group) {
	int	rc;
	<File path variables (Macintosh)>
	<Determine preference file path (Macintosh)>
	if (rc!=fnfErr) {
		if (onError(rc,intr,"wyrm_preferenceDelete find pref folder")) return TCL_ERROR;
		if (onError(FSpDelete(&spec),intr,"wyrm_preferenceDelete delete file")) return TCL_ERROR;
	}
	return TCL_OK;
}

		

static bool onError(int ec,Intr intr,chars where) {
	if (ec<0) {
		if (intr) {
			char b[20]; sprintf(b,"%d",ec);
			Tcl_ResetResult(intr);
			Tcl_AppendResult(intr,where,": error code ",b,0);
		}
		return true;
	}else
		return false;
}

		

static int wyrm_preferenceCommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
	chars group,variable,value;
	int rc = TCL_OK;
	if (N!=3 && N!=4) {usage:
		Tcl_SetResult(intr,"usage: pref <group> <variable>|-delete [<value>]",TCL_STATIC);
		return TCL_ERROR;
	}

	group = Tcl_GetStringFromObj(P[1],0);
	variable = Tcl_GetStringFromObj(P[2],0);
	value = N==4 ? Tcl_GetStringFromObj(P[3],0) : 0;

	if (streq(variable,"-delete")) {
		if (value) goto usage;
		rc = wyrm_preferenceDelete(intr,group);
		if (rc==TCL_OK) Tcl_ResetResult(intr);
	}else {
		Obj r = wyrm_preference(intr,group,variable,value);
		if (r) {
			Tcl_SetObjResult(intr,r);
			decr(r);
		}else {
			rc = TCL_ERROR;
		}
	}
	return rc;
}

		

int wyrm_preferenceCommandInit(Intr intr);
		

int wyrm_preferenceCommandInit(Intr intr) {
	char package[] = "namespace eval ::wyrm {namespace export pref}\n";
	Tcl_CreateObjCommand(intr,"::wyrm::pref",wyrm_preferenceCommand,0,0);
	return Tcl_Eval(intr,package);
}