/*
** This program is free software; you can redistribute it and/or modify
** it under the terms of the GNU General Public License as published by
** the Free Software Foundation; either version 1, or (at your option)
** any later version.

** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
** GNU General Public License for more details.

** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software
** Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/

/*
 * Author : Alexandre Parenteau <aubonbeurre@hotmail.com> --- May 1998
 * Modified : David Gravereaux <davygrvy@bigfoot.com> -- May 1999
 */

/*
 * TclGlue.cpp --- glue to the TCL language
 */

#include "stdafx.h"

#ifdef macintosh
#	include "MacMisc.h"
#endif

#include <stdarg.h>
#include <string.h>
#include <stdlib.h>

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

#if !defined(USE_TCL)
#	define USE_TCL 1
#endif

#ifdef qMacCvsPP
#	include "MacCvsApp.h"
#endif /* qMacCvsPP */

#if qCarbon
#	include "TclGlue.mac.h"
#endif

// this cannot work before the stub library is linked with wrong libraries
// and it causes WinCvs to crash
//#define USE_TCL_STUBS

#if !defined(__STDC__) && (defined(macintosh) || defined(WIN32))
#	define __STDC__ 1
#	define UNDEF_STDC
#endif

#include "tcl.h"

#if TCL_MAJOR_VERSION != 8 && TCL_MINOR_VERSION < 1
#	error "You need the Tcl 8.1.x header (or above) from Scriptics for this"
#endif

#ifdef UNDEF_STDC
#	undef __STDC__
#	define __STDC__ 0
#endif

#if 0//def WIN32
//  this comes with the Scriptic release, or
//  you can compile your own from generic/tclStubLib.c
//  in the source release of Tcl and build it with any
//  combination of the C runtime to match WinCVS, so you
//  don't get those:
// LINK : warning LNK4098: defaultlib "LIBCMTD" conflicts with use of other libs; use /NODEFAULTLIB:library
#pragma comment(lib,"tclstub81.lib")
#endif

#include "TclGlue.h"
#include "AppConsole.h"
#include "AppGlue.h"
#include "CvsArgs.h"
#include "CvsEntries.h"
#include "dll_loader.h"
#include "FileTraversal.h"
#include "MacrosSetup.h"
#include "MoveToTrash.h"
#include "CvsPrefs.h"

#ifdef WIN32
#	include "wincvs.h"
#	include "wincvsdebug.h"

#	ifdef _DEBUG
#	define new DEBUG_NEW
#	undef THIS_FILE
	static char THIS_FILE[] = __FILE__;
#	endif
#endif /* WIN32 */

#ifndef NEW
#define NEW new
#endif

#if defined(_MSC_VER) || qCarbon
#	define DECLC extern "C"
#else
#	define DECLC
#endif

#if defined(WIN32) || qCarbon
#	define DEC_GLUE(f) (*f##_glue)

	Tcl_Command	DEC_GLUE(Tcl_CreateCommand)
		_ANSI_ARGS_((Tcl_Interp *interp, char *cmdName, Tcl_CmdProc *proc,
			ClientData clientData, Tcl_CmdDeleteProc *deleteProc));
	Tcl_Interp * DEC_GLUE(Tcl_CreateInterp) _ANSI_ARGS_((void));
	void DEC_GLUE(Tcl_AppendResult) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
	void DEC_GLUE(Tcl_SetResult) _ANSI_ARGS_((Tcl_Interp *interp, char *string, Tcl_FreeProc *freeProc));
	void DEC_GLUE(Tcl_DeleteInterp) _ANSI_ARGS_((Tcl_Interp *interp));
	int DEC_GLUE(Tcl_Eval) _ANSI_ARGS_((Tcl_Interp *interp, char *string));
	int DEC_GLUE(Tcl_EvalFile) _ANSI_ARGS_((Tcl_Interp *interp, char *fileName));
	char *		DEC_GLUE(Tcl_Alloc) _ANSI_ARGS_((unsigned int size));
	void		DEC_GLUE(Tcl_Free) _ANSI_ARGS_((char *ptr));
	char *		DEC_GLUE(Tcl_Realloc) _ANSI_ARGS_((char *ptr,
					unsigned int size));
	int		DEC_GLUE(Tcl_ExprLong) _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, long *ptr));
	char *		DEC_GLUE(Tcl_Concat) _ANSI_ARGS_((int argc, char **argv));
	char *		DEC_GLUE(Tcl_SetVar2) _ANSI_ARGS_((Tcl_Interp *interp,
			    char *part1, char *part2, char *newValue,
			    int flags));
	void		DEC_GLUE(Tcl_DStringStartSublist) _ANSI_ARGS_((
			    Tcl_DString *dsPtr));
	void		DEC_GLUE(Tcl_DStringEndSublist) _ANSI_ARGS_((Tcl_DString *dsPtr));
	void		DEC_GLUE(Tcl_DStringFree) _ANSI_ARGS_((Tcl_DString *dsPtr));
	void		DEC_GLUE(Tcl_DStringInit) _ANSI_ARGS_((Tcl_DString *dsPtr));
	void		DEC_GLUE(Tcl_DStringResult) _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_DString *dsPtr));
	char *		DEC_GLUE(Tcl_DStringAppendElement) _ANSI_ARGS_((
			    Tcl_DString *dsPtr, CONST char *string));
	void		DEC_GLUE(TclFreeObj) _ANSI_ARGS_((Tcl_Obj *objPtr));
	void		DEC_GLUE(Tcl_SetObjResult) _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *resultObjPtr));
	Tcl_Obj *	DEC_GLUE(Tcl_NewStringObj) _ANSI_ARGS_((CONST char *bytes,
			    int length));
	Tcl_Obj *	DEC_GLUE(Tcl_NewListObj) _ANSI_ARGS_((int objc,
			    Tcl_Obj *CONST objv[]));
	int		DEC_GLUE(Tcl_ListObjAppendElement) _ANSI_ARGS_((
			    Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *objPtr));

	void		DEC_GLUE(Tcl_SourceRCFile) _ANSI_ARGS_((Tcl_Interp * interp));
	int		DEC_GLUE(Tcl_Init) _ANSI_ARGS_((Tcl_Interp * interp));
	char *		DEC_GLUE(Tcl_SetVar) _ANSI_ARGS_((Tcl_Interp * interp, 
				char * varName, char * newValue, int flags));
	void		DEC_GLUE(Tcl_FindExecutable) _ANSI_ARGS_((CONST char * argv0));

#	define GLUE_WRAP(f) f##_glue
#	define Tcl_CreateCommand GLUE_WRAP(Tcl_CreateCommand)
#	define Tcl_CreateInterp GLUE_WRAP(Tcl_CreateInterp)
#	define Tcl_AppendResult GLUE_WRAP(Tcl_AppendResult)
#	define Tcl_SetResult GLUE_WRAP(Tcl_SetResult)
#	define Tcl_DeleteInterp GLUE_WRAP(Tcl_DeleteInterp)
#	define Tcl_Eval GLUE_WRAP(Tcl_Eval)
#	define Tcl_EvalFile GLUE_WRAP(Tcl_EvalFile)
#	define Tcl_Alloc GLUE_WRAP(Tcl_Alloc)
#	define Tcl_Free GLUE_WRAP(Tcl_Free)
#	define Tcl_Realloc GLUE_WRAP(Tcl_Realloc)
#	define Tcl_ExprLong GLUE_WRAP(Tcl_ExprLong)
#	define Tcl_Concat GLUE_WRAP(Tcl_Concat)
#	define Tcl_SetVar2 GLUE_WRAP(Tcl_SetVar2)
#	define Tcl_DStringStartSublist GLUE_WRAP(Tcl_DStringStartSublist)
#	define Tcl_DStringEndSublist GLUE_WRAP(Tcl_DStringEndSublist)
#	define Tcl_DStringFree GLUE_WRAP(Tcl_DStringFree)
#	define Tcl_DStringInit GLUE_WRAP(Tcl_DStringInit)
#	define Tcl_DStringResult GLUE_WRAP(Tcl_DStringResult)
#	define Tcl_DStringAppendElement GLUE_WRAP(Tcl_DStringAppendElement)
#	define TclFreeObj GLUE_WRAP(TclFreeObj)
#	define Tcl_SetObjResult GLUE_WRAP(Tcl_SetObjResult)
#	define Tcl_NewStringObj GLUE_WRAP(Tcl_NewStringObj)
#	define Tcl_NewListObj GLUE_WRAP(Tcl_NewListObj)
#	define Tcl_ListObjAppendElement GLUE_WRAP(Tcl_ListObjAppendElement)
#	define Tcl_SourceRCFile GLUE_WRAP(Tcl_SourceRCFile)
#	define Tcl_Init GLUE_WRAP(Tcl_Init)
#	define Tcl_SetVar GLUE_WRAP(Tcl_SetVar)
#	define Tcl_FindExecutable GLUE_WRAP(Tcl_FindExecutable)
#endif /* WIN32 */

#if USE_TCL

// our app on OSX is CFM, while TCL is mach-o. We need to re-encode the function pointer
// we give to the mach-o code
#if qCarbon
#	define _TCL_CALLBACK(f) ((Tcl_CmdProc *)_tcl_cfm_macho(f))
#	define CompatLoadLibrary CarbonCompatLoadLibrary
#	define CompatCloseLibrary CarbonCompatCloseLibrary
#	define _CompatCallLibrary _CarbonCompatCallLibrary
#else
#	define _TCL_CALLBACK(f) f
#endif

extern "C"
{
	static int tclCvsProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]);
	static int tclHelpProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]);
	static int tclCvsOutProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]);
	static int tclCvsErrProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]);
	static int tclCvsBrowserProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]);
	static int tclCvsEntriesProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]);
	static void tclCvsEntriesDeleteProc(ClientData clientData);
#ifdef WIN32
	static int tclDirProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]);
#endif /* WIN32 */

	static int tclCvsExitOnErrorProc(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]);
	static int tclCvsLastErrorCodeProc(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]);
	static int tclSetDebugLevelProc(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]);
}

// the tcl browser class entity
class CTCLBrowserEnt
{
public:
	CTCLBrowserEnt()
	{}

	CTCLBrowserEnt(EntnodeData *data)
	: node(data)
	{}

	CTCLBrowserEnt(const CTCLBrowserEnt & ent)
	: node(ent.node)
	{}

	~CTCLBrowserEnt()
	{}

	CTCLBrowserEnt & operator=(const CTCLBrowserEnt & ent)
	{
		node = ent.node;
		return *this;
	}

	bool IsSamePath(const char * pathstr) const
	{
		CStr path = pathstr;
		CTcl_Interp::Deunixfy(path);

		CStr file;
		node.Data()->GetFullPathName(file);
		CTcl_Interp::Deunixfy(file);

		return path.compare(file) == 0;
	}

	EntnodeData* GetData() const
	{
		return node.Data();
	}

	// returns normalized path and file name (GetName() may return relative path)
	void GetNormalized(CStr& path, CStr& fname) const
	{
		CStr file;
		node.Data()->GetFullPathName(file);
		CTcl_Interp::Deunixfy(file);
		SplitPath(file, path, fname);
	}
	
private:
	ENTNODE node;
};

static std::vector<CTCLBrowserEnt> sTclBrowser;

class CTCLCvsConsole : public CCvsConsole
{
public:
	CTCLCvsConsole(Tcl_Interp *interp) : fInterp(interp)
	{
		fLen = 100;
		fAlloc = (char *)malloc((fLen + 1) * sizeof(char));
	}
	virtual ~CTCLCvsConsole()
	{
		if(fAlloc != 0L)
			free(fAlloc);
	}
	
	virtual long cvs_out(char *txt, long len)
	{
		if(fAlloc == 0L)
			return 0;
		
		if(len > fLen)
		{
			fLen = len;
			fAlloc = (char *)realloc(fAlloc, (fLen + 1) * sizeof(char));
		}
		if(fAlloc == 0L)
			return 0;

		memcpy(fAlloc, txt, len * sizeof(char));
		fAlloc[len] = '\0';
		
		Tcl_AppendResult(fInterp, fAlloc, 0L);
		return len;
	}
	
	virtual long cvs_err(char *txt, long len)
	{
		return cvs_out(txt, len);
	}
protected:
	Tcl_Interp *fInterp;
	int fLen;
	char *fAlloc;
};

DECLC static int tclCvsProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	CTcl_Interp *tcl_interp = (CTcl_Interp*) clientData;
	CvsArgs args;
	
	for(int i = 1; i < argc; i++)
	{
		args.add(argv[i]);
	}

	CTCLCvsConsole console(interp);
	int exitc = launchCVS(0L, args.Argc(), args.Argv(), &console);

	//
	// Set CvsLastErrorCode value. TCL script can query
	// this value using cvslasterrorcode command
	//
	tcl_interp->SetCvsLastErrorCode(exitc);

	//
	// If command succeeded then return always TCL_OK and 
	// proceed with script. If command failed (exitc != 0) 
	// then exit only if CvsExitOnError is TRUE.
	//
	if(exitc == 0) 
		return TCL_OK;
	else 
		return tcl_interp->GetCvsExitOnError() ? TCL_ERROR : TCL_OK;
}

DECLC static int tclHelpProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	Tcl_AppendResult(interp, "Help :\n", 0L);
	Tcl_AppendResult(interp, "   cvs  : the cvs tool.\n", 0L);
	Tcl_AppendResult(interp, "   help : this help.\n", 0L);
	Tcl_AppendResult(interp, "Others commands :\n", 0L);
	Tcl_AppendResult(interp, "   cd   : change directory\n", 0L);
	Tcl_AppendResult(interp, "   pwd  : print current directory\n", 0L);
	Tcl_AppendResult(interp, "   ls   : list the current directory\n", 0L);
	Tcl_AppendResult(interp, "   info ?  : misc. informations\n", 0L);
	Tcl_AppendResult(interp, "   info commands : all the TCL commands\n", 0L);
	return TCL_OK;
}

DECLC static int tclCvsOutProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	for(int i = 1; i < argc; i++)
	{
		cvs_outstr(argv[i], strlen(argv[i]));
	}
	return TCL_OK;
}

DECLC static int tclCvsErrProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	for(int i = 1; i < argc; i++)
	{
		cvs_errstr(argv[i], strlen(argv[i]));
	}
	return TCL_OK;
}

DECLC static int tclCvsBrowserProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	if(argc < 2)
	{
		Tcl_AppendResult(interp, argv[0], " : Missing arguments\n", 0L);
		return TCL_ERROR;
	}

	std::vector<CTCLBrowserEnt> & browser = clientData != 0L ?
		*(std::vector<CTCLBrowserEnt> *)clientData : sTclBrowser;
	if(strcmp(argv[1], "get") == 0)
	{
		if(argc != 2)
		{
			char *str = Tcl_Concat(argc, argv);
			Tcl_AppendResult(interp, argv[0], " : Too many arguments : '", str, "'\n", 0L);
			Tcl_Free(str);
			return TCL_ERROR;
		}

		Tcl_Obj *list = Tcl_NewListObj(0, 0L);
		std::vector<CTCLBrowserEnt>::const_iterator i;
		for(i = browser.begin(); i != browser.end(); ++i)
		{
			const CTCLBrowserEnt* entry = i;
			CStr path;
			entry->GetData()->GetFullPathName(path);
			CTcl_Interp::Unixfy(path);
			
			Tcl_Obj * obj = Tcl_NewStringObj(path, path.length());
			Tcl_ListObjAppendElement(interp, list, obj);
			//TclFreeObj(obj);
		}
		Tcl_SetObjResult(interp, list);
		//TclFreeObj(list);
	}
	else if(strcmp(argv[1], "info") == 0)
	{
		if(argc != 4)
		{
			char *str = Tcl_Concat(argc, argv);
			Tcl_AppendResult(interp, argv[0], " : Too many arguments : '", str, "'\n", 0L);
			Tcl_Free(str);
			return TCL_ERROR;
		}

		std::vector<CTCLBrowserEnt>::const_iterator i;
		for(i = browser.begin(); i != browser.end(); ++i)
		{
			const CTCLBrowserEnt* entry = i;
			if(entry->IsSamePath(argv[2]))
			{
				EntnodeData* data = entry->GetData();
				CStr path, fname, value;
				entry->GetNormalized(path, fname);				
				char *res = Tcl_SetVar2(interp, argv[3], "name", fname, 0);
				if(res == 0L)
					goto err1;
				
				value = data->GetType() == ENT_FILE ? "file" : "folder";
				res = Tcl_SetVar2(interp, argv[3], "kind", value, 0);
				if(res == 0L)
					goto err1;

				res = Tcl_SetVar2(interp, argv[3], "path", path, 0);
				if(res == 0L)
					goto err1;

				value = (*data)[EntnodeData::kStatus];
				res = Tcl_SetVar2(interp, argv[3], "status", value, 0);
				if(res == 0L)
					goto err1;

				value = data->IsMissing() ? "1" : "0";
				res = Tcl_SetVar2(interp, argv[3], "missing", value, 0);
				if(res == 0L)
					goto err1;

				value = data->IsUnknown() ? "1" : "0";
				res = Tcl_SetVar2(interp, argv[3], "unknown", value, 0);
				if(res == 0L)
					goto err1;

				value = data->IsIgnored() ? "1" : "0";
				res = Tcl_SetVar2(interp, argv[3], "ignored", value, 0);
				if(res == 0L)
					goto err1;

				value = data->IsLocked() ? "1" : "0";
				res = Tcl_SetVar2(interp, argv[3], "locked", value, 0);
				if(res == 0L)
					goto err1;

				value = data->IsUnmodified() ? "0" : "1";
				res = Tcl_SetVar2(interp, argv[3], "modified", value, 0);
				if(res == 0L)
					goto err1;

				value = data->GetDesc();
				res = Tcl_SetVar2(interp, argv[3], "status", value, 0);
				if(res == 0L)
					goto err1;

				if(data->GetType() == ENT_FILE)
				{
					value = (*data)[EntnodeFile::kVN];
					res = Tcl_SetVar2(interp, argv[3], "revision", value, 0);
					if(res == 0L)
						goto err1;

					value = (*data)[EntnodeFile::kTS];
					res = Tcl_SetVar2(interp, argv[3], "timestamp", value, 0);
					if(res == 0L)
						goto err1;

					value = (*data)[EntnodeFile::kOption];
					res = Tcl_SetVar2(interp, argv[3], "option", value, 0);
					if(res == 0L)
						goto err1;

					value = (*data)[EntnodeFile::kTag];
					res = Tcl_SetVar2(interp, argv[3], "tag", value, 0);
					if(res == 0L)
						goto err1;

					value = (*data)[EntnodeFile::kConflict];
					res = Tcl_SetVar2(interp, argv[3], "conflict", value, 0);
					if(res == 0L)
						goto err1;
				}

				goto ok1;
err1:
				Tcl_AppendResult(interp, argv[0], " : Error while creating '", argv[3], "'\n", 0L);
				return TCL_ERROR;
ok1:			
				break;
			}
		}
	}
	else
	{
		char *str = Tcl_Concat(argc, argv);
		Tcl_AppendResult(interp, argv[0], " : Wrong arguments : '", str, "'\n", 0L);
		Tcl_Free(str);
		return TCL_ERROR;
	}
	return TCL_OK;
}

class CFillTclEntries : public TraversalReport
{
public:
	CSortList<ENTNODE> & m_entries;
	std::vector<CStr> m_ignlist;

	CFillTclEntries(CSortList<ENTNODE> & entries) :
		m_entries(entries) {}

	virtual ~CFillTclEntries() {}

	virtual kTraversal EnterDirectory(const char *fullpath, const char *dirname, const FSSpec * macspec)
	{
		Entries_Open (m_entries, fullpath);
		BuildIgnoredList(m_ignlist, fullpath);
		return kContinueTraversal;
	}

	virtual kTraversal ExitDirectory(const char *fullpath)
	{
		m_ignlist.erase(m_ignlist.begin(), m_ignlist.end());
		return kContinueTraversal;
	}

	virtual kTraversal OnError(const char *err, int errcode)
	{
		return kTraversalError;
	}

	virtual kTraversal OnIdle(const char *fullpath)
	{
		return kContinueTraversal;
	}

	virtual kTraversal OnDirectory(const char *fullpath,
		const char *fullname,
		const char *name,
		const struct stat & dir, const FSSpec * macspec)
	{
#if defined(WIN32) || defined(macintosh)
		if(stricmp(name, "CVS") == 0)
#else
		if(strcmp(name, "CVS") == 0)
#endif
			return kSkipFile;

		/*EntnodeData *data = */Entries_SetVisited(fullpath, m_entries, name, dir, true, &m_ignlist);

		return kSkipFile;
	}

	virtual kTraversal OnAlias(const char *fullpath,
		const char *fullname,
		const char *name,
		const struct stat & dir, const FSSpec * macspec)
	{
		return OnFile(fullpath, fullname, name, dir, macspec);
	}

	virtual kTraversal OnFile(const char *fullpath,
		const char *fullname,
		const char *name,
		const struct stat & dir, const FSSpec * macspec)
	{
		/*EntnodeData *data = */Entries_SetVisited(fullpath, m_entries, name, dir, false, &m_ignlist);

		return kContinueTraversal;
	}
};


DECLC static void tclCvsEntriesDeleteProc(ClientData clientData)
{
	if(clientData != 0L)
		delete (std::vector<CTCLBrowserEnt> *)clientData;
}

DECLC static int tclCvsEntriesProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	if(argc != 3)
	{
		Tcl_AppendResult(interp, argv[0], " : Wrong # of arguments\n", 0L);
		return TCL_ERROR;
	}

	CSortList<ENTNODE> entries(200, ENTNODE::Compare);

	// refetch all items
	CFillTclEntries traverse(entries);
	CStr path(argv[1]);
	CTcl_Interp::Deunixfy(path);
	/*kTraversal res = */FileTraverse(path, traverse);

	// add the missing files
	Entries_SetMissing(entries);

	// now make the TCL entries
	std::vector<CTCLBrowserEnt> *browser = NEW std::vector<CTCLBrowserEnt>;
	
	int numEntries = entries.NumOfElements();
	for(int i = 0; i < numEntries; i++)
	{
		const ENTNODE & theNode = entries.Get(i);
		EntnodeData *data = theNode.Data();
		browser->push_back(CTCLBrowserEnt(data));
	}

	Tcl_Command cmd = Tcl_CreateCommand (interp, argv[2], _TCL_CALLBACK(tclCvsBrowserProc),
		(ClientData)browser, tclCvsEntriesDeleteProc);
	
	return cmd != 0L ? TCL_OK : TCL_ERROR;
}

#ifdef WIN32
class LSReport : public TraversalReport
{
public:
	Tcl_Interp *fInterp;
	int fState;

	LSReport(Tcl_Interp *interp) : fInterp(interp), fState(TCL_OK) {}

	virtual kTraversal EnterDirectory(const char *fullpath, const char *dirname, const FSSpec * macspec)
	{
		return kContinueTraversal;
	}

	virtual kTraversal ExitDirectory(const char *fullpath)
	{
		return kContinueTraversal;
	}

	virtual kTraversal OnError(const char *err, int errcode)
	{
		fState = TCL_ERROR;
		Tcl_AppendResult(fInterp, err, "\n", 0L);
		return kTraversalError;
	}

	virtual kTraversal OnIdle(const char *fullpath)
	{
		return kContinueTraversal;
	}

	virtual kTraversal OnAnyDevice(const char *fullpath,
		const char *fullname,
		const char *name,
		const struct stat & dir, const FSSpec * macspec)
	{
		Tcl_AppendResult(fInterp, name, "\n", 0L);
		return kSkipFile;
	}
};

DECLC static int tclDirProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	LSReport report(interp);
	char path[256];
	getcwd(path, 256);
	kTraversal res = FileTraverse(path, report);
	return report.fState;
}
#endif /* WIN32 */

DECLC static int tclSafeRemove (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
    if(argc < 2)
	{
		Tcl_AppendResult(interp, argv[0], " : Missing list of files\n", 0L);
		return TCL_ERROR;
	}

	for(int i = 1; i < argc; i++)
	{
        CStr fn(argv[i]);
	    CTcl_Interp::Deunixfy(fn);
        if(!CompatMoveToTrash(fn, 0))  // dir is not needed, TCL profides fully qualified file name
        {
            cvs_err("Unable to trash '%s'\n", (char *)fn);
        }
	}

	return TCL_OK;
}

DECLC static int tclCvsExitOnErrorProc(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	CTcl_Interp *tcl_interp = (CTcl_Interp*) clientData;

	//
	// CvsExitOnError command can be used to define whether TCL macro
	// is automatically terminated if CVS command returned error (non zero).
	//
	// CvsExitOnError has following modes:
	//   false	= Do not exit automaticaly. CvsLastErrorCode constains the last error code.
	//	 true	= Exit TCL script in error (default).
	//
	if(argc < 2)
	{
		Tcl_AppendResult(interp, argv[0], " : Missing argument (true|false)\n", 0L);
		return TCL_ERROR;
	}

	if(strcmp(argv[1], "true") == 0)		
		tcl_interp->SetCvsExitOnError(true);
	else if(strcmp(argv[1], "false") == 0)	
		tcl_interp->SetCvsExitOnError(false);
	else
	{
		char *str = Tcl_Concat(argc, argv);
		Tcl_AppendResult(interp, argv[0], " : Wrong argument : '", str, "'\n", 0L);
		Tcl_Free(str);

		return TCL_ERROR;
	}

	return TCL_OK;
}

DECLC static int tclCvsLastErrorCodeProc(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	CTcl_Interp *tcl_interp = (CTcl_Interp*) clientData;

	if(argc < 2)
	{
		char value[35];
		
		// CvsLastErrorCode called without arguments, so return current value
		sprintf(value, "%d", tcl_interp->GetCvsLastErrorCode());
		Tcl_AppendResult(interp, value, 0L);
	}
	else
	{
		// Set the value of LastErrorCode variable
		tcl_interp->SetCvsLastErrorCode(atoi(argv[1]));
	}
	
	return TCL_OK;
}

#if defined(WIN32)
DECLC static int tclGetFileModTimeProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
    struct wnt_stat sb;
    struct tm * p_utc = NULL;

	if (argc < 2)
	{
		Tcl_AppendResult(interp, argv[0], " : Missing argument (int)\n", 0L);
		return TCL_ERROR;
	}

	if (argc > 2)
	{
		char * str = Tcl_Concat(argc, argv);
		Tcl_AppendResult(interp, argv[0], " : Too many arguments : '", str, "'\n", 0L);
		Tcl_Free(str);
		return TCL_ERROR;
	}

    if (wnt_stat(argv[1], &sb) != 0)
    {
		Tcl_AppendResult(interp, argv[0], " : Could not find file : '", argv[1], "'\n", 0L);
		return TCL_ERROR;
    }

    p_utc = gmtime(& sb.st_mtime);
    Tcl_AppendResult(interp, asctime(p_utc), 0L);
    return TCL_OK;
}

DECLC static int tclSetDebugMaskProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	if (argc < 2)
	{
		Tcl_AppendResult(interp, argv[0], " : Missing argument (int)\n", 0L);
		return TCL_ERROR;
	}

	if (argc > 3)
	{
		char * str = Tcl_Concat(argc, argv);
		Tcl_AppendResult(interp, argv[0], " : Too many arguments : '", str, "'\n", 0L);
		Tcl_Free(str);
		return TCL_ERROR;
	}

	char * endc = NULL;
	unsigned long n;
	bool b;
	
	n = strtoul(argv[1], & endc, 0);
	if (*endc) 
	{
		Tcl_AppendResult(interp, argv[0], " : Could not understand argument '", argv[1], "'\n", 0L);
		return TCL_ERROR;
	}

	if (argc == 2)
	{
		SetWinCvsDebugMask(n);
		return TCL_OK;
	}


	if (!stricmp(argv[2], "true"))
	{
		b = true;
	}
	else if (!stricmp(argv[2], "false"))
	{
		b = false;
	}
	else
	{
		b = strtoul(argv[2], & endc, 0) != 0;
		if (*endc) 
		{
			Tcl_AppendResult(interp, argv[0], " : Could not understand argument '", argv[2], "'\n", 0L);
			return TCL_ERROR;
		}
	}

	SetWinCvsDebugMaskBit(n,b);
	return TCL_OK;
}

DECLC static int tclGetDebugMaskProc (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
	char retstr[32];
	if (argc < 2)
	{
		_snprintf(retstr,32,"%u",GetWinCvsDebugMask());
		Tcl_AppendResult(interp, retstr, 0L);
		return TCL_OK;
	}
	
	if (argc > 3)
	{
		char * str = Tcl_Concat(argc, argv);
		Tcl_AppendResult(interp, argv[0], " : Too many arguments : '", str, "'\n", 0L);
		Tcl_Free(str);
		return TCL_ERROR;
	}

	char * endc = NULL;
	unsigned long n;
	
	n = strtoul(argv[1], & endc, 0);
	if (*endc) 
	{
		Tcl_AppendResult(interp, argv[0], " : Could not understand argument '", argv[1], "'\n", 0L);
		return TCL_ERROR;
	}

	_snprintf(retstr, 32, "%u", GetWinCvsDebugMaskBit(n));
	Tcl_AppendResult(interp, retstr, 0L);

	return TCL_OK;
}
#endif	// WIN32

#endif // USE_TCL

void TclBrowserReset(void)
{
#if USE_TCL
	sTclBrowser.erase(sTclBrowser.begin(), sTclBrowser.end());
#endif
}

// note that although 'path' is not used here any longer, it makes sense to retain 
// that attribute since it gives you an option to figure out relative filename, 
// relative to 'path' that designates the folder in which the operation takes place
void TclBrowserAppend(const char * /*path*/, EntnodeData *data)
{
#if USE_TCL
	sTclBrowser.push_back(CTCLBrowserEnt(data));
#endif
}

static Tcl_Interp *myTcl_CreateInterp(void)
{
#	ifdef WIN32
	CWincvsApp* app = (CWincvsApp *)AfxGetApp();
	CStr path;
	app->GetAppModule(path);
	Tcl_FindExecutable(path);
#	endif

#	ifdef qMacCvsPP
	CStr appPath = CMacCvsApp::GetAppPath();
	Tcl_FindExecutable(appPath);
#	endif

	Tcl_Interp *res = Tcl_CreateInterp();
	return res;
}

CTcl_Interp::CTcl_Interp()
{
	fInterp = 0L;

	fExitOnError = true;
	fLastErrorCode = 0;
	
#if USE_TCL
	if(!CTcl_Interp::IsAvail())
	{
		cvs_err("TCL is not avalaible !\n");
		return;
	}
	
	fInterp = myTcl_CreateInterp();
	if(fInterp == 0L)
	{
		cvs_err("Unable to create a new TCL interpreter !\n");
		return;
	}

	Tcl_Command cmd;
	
	// this parameter is used to get access to CTcl_Interp::SetCvsLastErrorCode
	// in tclCvsProc method
	cmd = Tcl_CreateCommand (fInterp, "cvs", _TCL_CALLBACK(tclCvsProc),
		(ClientData)this, (Tcl_CmdDeleteProc *)0L);

	cmd = Tcl_CreateCommand (fInterp, "help", _TCL_CALLBACK(tclHelpProc),
		(ClientData)0L, (Tcl_CmdDeleteProc *)0L);
	cmd = Tcl_CreateCommand (fInterp, "cvsout", _TCL_CALLBACK(tclCvsOutProc),
		(ClientData)0L, (Tcl_CmdDeleteProc *)0L);
	cmd = Tcl_CreateCommand (fInterp, "cvserr", _TCL_CALLBACK(tclCvsErrProc),
		(ClientData)0L, (Tcl_CmdDeleteProc *)0L);
	cmd = Tcl_CreateCommand (fInterp, "cvsbrowser", _TCL_CALLBACK(tclCvsBrowserProc),
		(ClientData)0L, (Tcl_CmdDeleteProc *)0L);
	cmd = Tcl_CreateCommand (fInterp, "cvsentries", _TCL_CALLBACK(tclCvsEntriesProc),
		(ClientData)0L, (Tcl_CmdDeleteProc *)0L);
#ifdef WIN32
	cmd = Tcl_CreateCommand (fInterp, "ls", _TCL_CALLBACK(tclDirProc),
		(ClientData)0L, (Tcl_CmdDeleteProc *)0L);
	cmd = Tcl_CreateCommand (fInterp, "dir", _TCL_CALLBACK(tclDirProc),
		(ClientData)0L, (Tcl_CmdDeleteProc *)0L);
#endif /* WIN32 */
    cmd = Tcl_CreateCommand (fInterp, "trash", _TCL_CALLBACK(tclSafeRemove),
		(ClientData)0L, (Tcl_CmdDeleteProc *)0L);    

	cmd = Tcl_CreateCommand (fInterp, "cvsexitonerror", _TCL_CALLBACK(tclCvsExitOnErrorProc),
		(ClientData)this, (Tcl_CmdDeleteProc *)0L);

	cmd = Tcl_CreateCommand (fInterp, "cvslasterrorcode", _TCL_CALLBACK(tclCvsLastErrorCodeProc),
		(ClientData)this, (Tcl_CmdDeleteProc *)0L);
#if defined(WIN32)
	cmd = Tcl_CreateCommand (fInterp, "cvssetdebugmask", _TCL_CALLBACK(tclSetDebugMaskProc),
		(ClientData)this, (Tcl_CmdDeleteProc *)0L);
	cmd = Tcl_CreateCommand (fInterp, "cvsgetdebugmask", _TCL_CALLBACK(tclGetDebugMaskProc),
		(ClientData)this, (Tcl_CmdDeleteProc *)0L);
    cmd = Tcl_CreateCommand (fInterp, "cvsfilemodtime", _TCL_CALLBACK(tclGetFileModTimeProc),
		(ClientData)this, (Tcl_CmdDeleteProc *)0L);
#endif	// defined(WIN32)

	CStr rcfile;
	MacrosGetLoc(rcfile);
	if(!rcfile.endsWith(kPathDelimiter))
		rcfile << kPathDelimiter;
	rcfile << "startup.tcl";
	Tcl_SetVar(fInterp, "tcl_rcFileName", rcfile, TCL_GLOBAL_ONLY);
	Tcl_SetVar(fInterp, "tcl_interactive", "1", TCL_GLOBAL_ONLY);
	Tcl_Init(fInterp);
	Tcl_SourceRCFile(fInterp);
#endif
}

CTcl_Interp::~CTcl_Interp()
{
#if USE_TCL
	if(fInterp != 0L)
		Tcl_DeleteInterp(fInterp);
#endif
}

bool CTcl_Interp::IsAvail(void)
{
#if USE_TCL
#if defined(macintosh) && !qCarbon
	return Tcl_CreateInterp != 0L;
#else /* !macintosh */
	static bool firstTime = true;
	static bool tclAvail = false;
	if(firstTime)
	{
#	if defined(WIN32) || qCarbon
		CompatConnectID connID;
#	endif

#	ifdef WIN32
		extern char *findTcl (char *_minVer, int _exact, int _dbgOnly);
		char *tclver = 0L;
		try
		{
			tclver = findTcl("8.1", 0, 0);
		}
		catch(...)
		{
		}

		if(tclver != 0L)
			tclAvail = CompatLoadLibrary(&connID, tclver) != 0;

		if(!tclAvail)
			tclAvail = CompatLoadLibrary(&connID, "tcl87.dll") != 0 ||
			CompatLoadLibrary(&connID, "tcl86.dll") != 0 ||
			CompatLoadLibrary(&connID, "tcl85.dll") != 0 ||
			CompatLoadLibrary(&connID, "tcl84.dll") != 0 ||
			CompatLoadLibrary(&connID, "tcl83.dll") != 0 ||
			CompatLoadLibrary(&connID, "tcl82.dll") != 0 ||
			CompatLoadLibrary(&connID, "tcl81.dll") != 0;
#	endif
	
#	if qCarbon
		if (UEnvironment::GetOSVersion() >= 0x1000)
			tclAvail = CompatLoadLibrary(&connID, "/System/Library/Frameworks/Tcl.framework");
		else
			tclAvail = CompatLoadLibrary(&connID, "tcl8.3");
#	endif

#	if defined(WIN32) || qCarbon
#	define LOAD_CODEFRAG(name) \
		if(tclAvail) \
			tclAvail = (*(void **)&name##_glue = \
				_CompatCallLibrary(connID, #name)) != 0L
#	endif
#	if defined(WIN32) || TARGET_API_MAC_CARBON
		LOAD_CODEFRAG(Tcl_CreateCommand);
		LOAD_CODEFRAG(Tcl_CreateInterp);
		LOAD_CODEFRAG(Tcl_AppendResult);
		LOAD_CODEFRAG(Tcl_SetResult);
		LOAD_CODEFRAG(Tcl_DeleteInterp);
		LOAD_CODEFRAG(Tcl_Eval);
		LOAD_CODEFRAG(Tcl_EvalFile);
		LOAD_CODEFRAG(Tcl_Alloc);
		LOAD_CODEFRAG(Tcl_Free);
		LOAD_CODEFRAG(Tcl_Realloc);
		LOAD_CODEFRAG(Tcl_ExprLong);
		LOAD_CODEFRAG(Tcl_Concat);
		LOAD_CODEFRAG(Tcl_SetVar2);
		LOAD_CODEFRAG(Tcl_DStringStartSublist);
		LOAD_CODEFRAG(Tcl_DStringEndSublist);
		LOAD_CODEFRAG(Tcl_DStringFree);
		LOAD_CODEFRAG(Tcl_DStringInit);
		LOAD_CODEFRAG(Tcl_DStringResult);
		LOAD_CODEFRAG(Tcl_DStringAppendElement);
		LOAD_CODEFRAG(TclFreeObj);
		LOAD_CODEFRAG(Tcl_SetObjResult);
		LOAD_CODEFRAG(Tcl_NewStringObj);
		LOAD_CODEFRAG(Tcl_NewListObj);
		LOAD_CODEFRAG(Tcl_ListObjAppendElement);
		LOAD_CODEFRAG(Tcl_SourceRCFile);
		LOAD_CODEFRAG(Tcl_Init);
		LOAD_CODEFRAG(Tcl_SetVar);
		LOAD_CODEFRAG(Tcl_FindExecutable);

		if(!tclAvail)
			return false;
#	endif /* WIN32 */

		Tcl_Interp *interp = myTcl_CreateInterp();
		tclAvail = interp != 0L;
		if (!tclAvail)
			return false;

		Tcl_Init(interp);

		/* Destroy the interp we needed just for this */
		Tcl_DeleteInterp(interp);

		firstTime = false;
	}

	return tclAvail;
#endif /* !macintosh */
#else
	return false;
#endif
}

kTclRes CTcl_Interp::DoScript(const char *script)
{
#if USE_TCL
	bool bTclFileStarted;

	if(fInterp == 0L)
		return false;
	
	// If script cmd begins with "source " then this
	// must be TCL file execution. 
	bTclFileStarted = (strncmp(script, "source ", 7) == 0);
	if(bTclFileStarted)
		gCvsPrefs.SetTclFileRunning(true);

	int exitc = Tcl_Eval(fInterp, (char *)script);

	if(bTclFileStarted)
		gCvsPrefs.SetTclFileRunning(false);

	size_t len = strlen(fInterp->result);
	if(exitc == TCL_ERROR)
	{
		cvs_errstr(fInterp->result, len);
		if(len != 0 && fInterp->result[len - 1] != '\n')
			cvs_errstr("\n", 1);
	}
	else
	{
		cvs_outstr(fInterp->result, len);
		if(len != 0 && fInterp->result[len - 1] != '\n')
			cvs_outstr("\n", 1);
	}
	
	return exitc;
#else
	return false;
#endif
}

kTclRes CTcl_Interp::DoScriptVar(const char *format, ...)
{
#if USE_TCL
	if(fInterp == 0L)
		return false;
	
	va_list args;
	char script[1024] = {'\0'};

	va_start (args, format);
	vsprintf (script, format, args);
	va_end (args);
	
	return DoScript(script);
#else
	return false;
#endif
}

kTclRes CTcl_Interp::DoFile(const char *file)
{
#if USE_TCL
	if(fInterp == 0L)
		return false;
	
	int exitc = Tcl_EvalFile(fInterp, (char *)file);
	size_t len = strlen(fInterp->result);
	if(exitc == TCL_ERROR)
	{
		cvs_errstr(fInterp->result, len);
		if(len != 0 && fInterp->result[len - 1] != '\n')
			cvs_errstr("\n", 1);
	}
	else
	{
		cvs_outstr(fInterp->result, len);
		if(len != 0 && fInterp->result[len - 1] != '\n')
			cvs_outstr("\n", 1);
	}
	
	return exitc;
#else
	return false;
#endif
}

void CTcl_Interp::Unixfy(CStr & path)
{
	char *ptr = path;
	while((ptr = strchr(ptr, kPathDelimiter)) != 0L)
	{
		*ptr++ = kTCLPathDelimiter;
	}
	ptr = (char *)path + path.length() - 1;
	if(*ptr == kTCLPathDelimiter)
	{
		*ptr = '\0';
	}
}

void CTcl_Interp::Deunixfy(CStr & path)
{
	char *ptr = path;
	while((ptr = strchr(ptr, kTCLPathDelimiter)) != 0L)
	{
		*ptr++ = kPathDelimiter;
	}
}
