{ -----------------------------------------------------------------------
Tcl Scripting Language Components (Tslc)
Copyright (C) 1996-2002 William Byrne

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

This library 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
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

WilliamB@ByrneLitho.com
------------------------------------------------------------------------}
unit TclTk;

///////////////////////////////////////////////////////////////////////////////
//
//  TclDbTbl.pas
//	Copyright(c) 1996-1997 William Byrne
//		WilliamB@ByrneLitho.com
//		76262.13@CompuServe.com
//
//	All rights reserved.
//  	William Byrne makes no representations about the suitability of this
//    	software for any purpose.  It is provided "as is" without express or
//    	implied warranty.
//
//	Usage
//      I hereby grant to the legal purchasors of the source code contained
//      herein a non-exclusive license for the use of said source code in
//      developing compiled, executable software, and for the distribution of
//      said source code as part of said developed, compiled, executable software.
//
//  Purpose:
//		This file provides for Bde Table Manipulation using the
//		Tcl Scripting Language Components.
//
//	Editor:
//		Tab stops = 4
//		Page width = 132 characters
//		Font = Courier New, 8pt
//
//  Misc:
//      ??? = Note to self


interface
uses windows;

const
	cTclLibPath = 'tcl80.dll';
    cTkLibPath	= 'tk80.dll';

    TCL_DESTROYED	= integer($DEADDEAD);
	TCL_OK		   	= 0;
   	TCL_ERROR		= 1;
   	TCL_RETURN		= 2;
   	TCL_BREAK		= 3;
   	TCL_CONTINUE	= 4;
   	TCL_RESULT_SIZE = 200;
	MAX_ARGV		 =  $7FFF;
    TCL_VERSION_MAJOR :integer = 0;
    TCL_VERSION_MINOR :integer = 0;

	TCL_NO_EVAL			= $10000;
	TCL_EVAL_GLOBAL		= $20000;

// Flag values passed to variable-related procedures.
	TCL_GLOBAL_ONLY 		= 1;
	TCL_NAMESPACE_ONLY		= 2;
	TCL_APPEND_VALUE 		= 4;
	TCL_LIST_ELEMENT		= 8;
	TCL_TRACE_READS			= $10;
	TCL_TRACE_WRITES		= $20;
	TCL_TRACE_UNSETS		= $40;
	TCL_TRACE_DESTROYED		= $80;
	TCL_INTERP_DESTROYED	= $100;
	TCL_LEAVE_ERR_MSG		= $200;
    TCL_PARSE_PART1			= $400;

// Types for linked variables:
	TCL_LINK_INT		= 1;
	TCL_LINK_DOUBLE		= 2;
	TCL_LINK_BOOLEAN	= 3;
	TCL_LINK_STRING		= 4;
	TCL_LINK_READ_ONLY	= $80;
   	TCL_SMALL_HASH_TABLE = 4;

// Hash Table
	TCL_STRING_KEYS = 0;
    TCL_ONE_WORD_KEYS = 1;

// Const/enums Tcl_QueuePosition
// typedef enum {
    TCL_QUEUE_TAIL		= 0;
    TCL_QUEUE_HEAD		= 1;
    TCL_QUEUE_MARK		= 2;
//} Tcl_QueuePosition;

// Event Flags
	TCL_DONT_WAIT		= ( 1 shl 1 );
	TCL_WINDOW_EVENTS	= ( 1 shl 2 );
	TCL_FILE_EVENTS		= ( 1 shl 3 );
	TCL_TIMER_EVENTS	= ( 1 shl 4 );
	TCL_IDLE_EVENTS		= ( 1 shl 5 );	//* WAS 0x10 ???? */
	TCL_ALL_EVENTS		= ($FFFFFFFF xor TCL_DONT_WAIT); // (~TCL_DONT_WAIT)

// Result type
	TCL_VOLATILE 	= 1;
   	TCL_STATIC     	= 0;
   	TCL_DYNAMIC		= 3;

// Channel
	TCL_STDIN		= ( 1 shl 1 );
    TCL_STDOUT		= ( 1 shl 2 );
    TCL_STDERR		= ( 1 shl 3 );
    TCL_ENFORCE_MODE= ( 1 shl 4 );

    TCL_READABLE	= ( 1 shl 1 );
	TCL_WRITABLE	= ( 1 shl 2 );
	TCL_EXCEPTION	= ( 1 shl 3 );

// POSIX
	EPERM			= 1;
	ENOENT			= 2;
	ESRCH			= 3;
	EINTR			= 4;
	EIO				= 5;
	ENXIO			= 6;
	E2BIG			= 7;
	ENOEXEC			= 8;
	EBADF			= 9;
	ECHILD			= 10;
	EDEADLK			= 11;
	ENOMEM			= 12;
	EACCES			= 13;
	EFAULT			= 14;
	ENOTBLK			= 15;
	EBUSY			= 16;
	EEXIST			= 17;
	EXDEV			= 18;
	ENODEV			= 19;
	ENOTDIR			= 20;
	EISDIR			= 21;
	EINVAL			= 22;
	ENFILE			= 23;
	EMFILE			= 24;
	ENOTTY			= 25;
	ETXTBSY			= 26;
	EFBIG			= 27;
	ENOSPC			= 28;
	ESPIPE			= 29;
	EROFS			= 30;
	EMLINK			= 31;
	EPIPE			= 32;
	EDOM			= 33;
	ERANGE			= 34;
	EAGAIN			= 35;
	EWOULDBLOCK		= EAGAIN;
	EINPROGRESS		= 36;
	EALREADY		= 37;
	ENOTSOCK		= 38;
	EDESTADDRREQ	= 39;
	EMSGSIZE		= 40;
	EPROTOTYPE		= 41;
	ENOPROTOOPT		= 42;
	EPROTONOSUPPORT	= 43;
	ESOCKTNOSUPPORT	= 44;
	EOPNOTSUPP		= 45;
	EPFNOSUPPORT	= 46;
	EAFNOSUPPORT	= 47;
	EADDRINUSE		= 48;
	EADDRNOTAVAIL	= 49;
	ENETDOWN		= 50;
	ENETUNREACH		= 51;
	ENETRESET		= 52;
	ECONNABORTED	= 53;
	ECONNRESET		= 54;
	ENOBUFS			= 55;
	EISCONN			= 56;
	ENOTCONN		= 57;
	ESHUTDOWN		= 58;
	ETOOMANYREFS	= 59;
	ETIMEDOUT		= 60;
	ECONNREFUSED	= 61;
	ELOOP			= 62;
	ENAMETOOLONG	= 63;
	EHOSTDOWN		= 64;
	EHOSTUNREACH	= 65;
	ENOTEMPTY		= 66;
	EPROCLIM		= 67;
	EUSERS			= 68;
	EDQUOT			= 69;
	ESTALE			= 70;
	EREMOTE			= 71;
	EBADRPC			= 72;
	ERPCMISMATCH	= 73;
	EPROGUNAVAIL	= 74;
	EPROGMISMATCH	= 75;
	EPROCUNAVAIL	= 76;
	ENOLCK			= 77;
	ENOSYS			= 78;
	EFTYPE			= 79;


type
    ppChar = ^pChar;
	Tcl_Argv = ppChar;
	Tcl_ClientData	= pointer;
	Tcl_FreeProc	= procedure(block : pointer); cdecl;
	pTcl_Interp = ^Tcl_Interp;
	Tcl_Interp = packed record
    	result 		: pChar; { Do not access this directly. Use Tcl_GetStringResult since result may be pointing to an object }
      	freeProc 	: Tcl_FreeProc;
      	errorLine	: integer;
   	end;

{ 	Event Definitions  }
    TTcl_EventSetupProc = procedure(clientData: Tcl_ClientData; flags: integer); cdecl;
	TTcl_EventCheckProc = TTcl_EventSetupProc;
    pTcl_Event = ^Tcl_Event;
    TTcl_EventProc	= function(evPtr: pTcl_Event; flags: integer): integer; cdecl;
    Tcl_Event = packed record
    	proc	: TTcl_EventProc;
        nextPtr	: pTcl_Event;
        ClientData: TObject;
	end;

	pTcl_Time = ^Tcl_Time;
	Tcl_Time = packed record
		sec: longInt;			{ * Seconds. * }
    	usec: longInt;			{ * Microseconds. * }
	end;

    Tcl_TimerToken = pointer;
	pInteger = ^integer;

    pTcl_HashTable = pointer;
	pTcl_HashEntry = ^Tcl_HashEntry;
   	ppTcl_HashEntry = ^pTcl_HashEntry;
   	Tcl_HashEntry = packed record
   		nextPtr 		: pTcl_HashEntry;
      	tablePtr		: pTcl_HashTable;
      	bucketPtr	: ppTcl_HashEntry;
      	clientData  : Tcl_ClientData;
      	key			: array[0..3] of Char;
	end;
{      case key: integer of
      	0: (oneWordValue	: pChar);
         1: (words			: pInteger);
         2: (str				: pChar);
}
   	Tcl_HashFindProc = function(tablePtr: pTcl_HashTable; key: pChar): pTcl_HashEntry; cdecl;
   	Tcl_HashCreateProc=function(tablePtr: pTcl_HashTable; key: pChar; newPtr: pInteger): pTcl_HashEntry; cdecl;

	pHashTable = ^Tcl_HashTable;
   	Tcl_HashTable = packed record
      	buckets		: ppTcl_HashEntry;
      	staticBuckets: array[0..TCL_SMALL_HASH_TABLE - 1] of pTcl_HashEntry;
      	numBuckets	: integer;
      	numEntries	: integer;
      	rebuildSize	: integer;
      	downShift	: integer;
      	mask  		: integer;
      	keyType		: integer;
      	findProc	: Tcl_HashFindProc;
      	createProc	: Tcl_HashCreateProc;
   	end;

   	pTcl_HashSearch = ^Tcl_HashSearch;
   	Tcl_HashSearch = packed record
   		tablePtr	: pTcl_HashTable;
      	nextIndex	: integer;
      	nextEntryPtr: pTcl_HashEntry;
   	end;

	TTclAppInitProc	= function(interp: pTcl_Interp): integer; cdecl;
	TTclPackageInitProc = function(interp: pTcl_Interp): integer; cdecl;
	TTclCmdProc		= function(clientData : Tcl_ClientData; interp : pTcl_Interp; argc: integer; argv : Tcl_Argv): integer; cdecl;
	TTclVarTraceProc = function (clientData: Tcl_ClientData; interp: pTcl_Interp;
   							varName: pChar; elemName: pChar; flags: integer): pChar; cdecl;
	TTclFreeProc	= procedure(block: pointer); cdecl;
    TTclInterpDeleteProc = procedure(clientData: Tcl_ClientData; interp: pTcl_Interp); cdecl;
   	TTclCmdDeleteProc = procedure(clientData: Tcl_ClientData); cdecl;
    TTclNamespaceDeleteProc = procedure(clientData: Tcl_ClientData); cdecl;


const
	TCL_DSTRING_STATIC_SIZE = 200;

type
    pTcl_DString = ^Tcl_DString;
    Tcl_DString = packed record
    	str			: pChar;
        length		: integer;
        spaceAvl    : integer;
        staticSpace	: array[0..TCL_DSTRING_STATIC_SIZE - 1] of char;
    end;

    pTcl_Channel = ^Tcl_Channel;
    Tcl_Channel = packed record
    end;

    TTclDriverBlockModeProc	= function(instanceData: Tcl_ClientData; mode: integer): integer; cdecl;
    TTclDriverCloseProc		= function(instanceData: Tcl_ClientData; interp: pTcl_Interp): integer; cdecl;
    TTclDriverInputProc 	= function(instanceData: Tcl_ClientData; buf: pChar; toRead: integer;
    							errorCodePtr: pInteger): integer; cdecl;
    TTclDriverOutputProc 	= function(instanceData: Tcl_ClientData; buf: pChar; toWrite: integer;
    							errorCodePtr: pInteger): integer; cdecl;
    TTclDriverSeekProc 		= function(instanceData: Tcl_ClientData; offset: longint; mode: integer;
    							errorCodePtr: pInteger): integer; cdecl;
    TTclDriverSetOptionProc	= function(instanceData: Tcl_ClientData; interp: pTcl_Interp; optionName: pChar;
    							value: pChar): integer; cdecl;
	TTclDriverGetOptionProc	= function(instanceData: Tcl_ClientData; interp: pTcl_Interp; optionName: pChar;
    							dsPtr: pTcl_DString): integer; cdecl;
    TTclDriverWatchProc		= procedure(instanceData: Tcl_ClientData; mask: integer); cdecl;
    TTclDriverGetHandleProc	= function(instanceData: Tcl_ClientData; direction: integer;
    							var handlePtr: Tcl_ClientData): integer; cdecl;
    pTcl_ChannelType = ^Tcl_ChannelType;
    Tcl_ChannelType = packed record
    	typeName: 		pChar;
        blockModeProc: 	TTclDriverBlockModeProc;
        closeProc:      TTclDriverCloseProc;
        inputProc:		TTclDriverInputProc;
        ouputProc:		TTclDriverOutputProc;
        seekProc:		TTclDriverSeekProc;
        setOptionProc:	TTclDriverSetOptionProc;
        getOptionProc:	TTclDriverGetOptionProc;
        watchProc:		TTclDriverWatchProc;
        getHandleProc:	TTclDriverGetHandleProc;
	end;

    TTclChannelProc = procedure(clientData: Tcl_ClientData; mask: integer); cdecl;

	pTcl_Obj = ^Tcl_Obj;
    ppTcl_Obj = ^pTcl_Obj;
    Tcl_Obj = packed record
    	refCount: integer;
        // ...
    end;

    TTclObjCmdProc	= function(clientData: Tcl_ClientData; interp: pTcl_Interp; objc: integer; ppObj: ppTcl_Obj): integer; cdecl;
	pTcl_Namespace = ^Tcl_Namespace;
	Tcl_Namespace = packed record
	    name:		pchar;
		fullName:	pChar;
    	clientData:	Tcl_ClientData;
        deleteProc:	TTclNamespaceDeleteProc;
        parentPtr:	pTcl_Namespace;
    end;

    pTcl_CallFrame = ^Tcl_CallFrame;
    Tcl_CallFrame = packed record
    	nsPtr:		pTcl_Namespace;
        dummy1:		integer;
        dummy2:		integer;
        dummy3:		pChar;
        dummy4:     pChar;
        dummy5:		pChar;
		dummy6:		integer;
        dummy7:		pChar;
        dummy8:		pChar;
        dummy9:		integer;
        dummy10:	pChar;
    end;

	pTcl_CmdInfo = ^Tcl_CmdInfo;
    Tcl_CmdInfo = packed record
    	isNativeObjectProc: integer;
        objProc:			TTclObjCmdProc;
        objClientData:		Tcl_ClientData;
    	proc:				TTclCmdProc;
        clientData:			Tcl_ClientData;
        deleteProc:			TTclCmdDeleteProc;
        deleteData:			Tcl_ClientData;
        namespacePtr:		pTcl_Namespace;
    end;

    pTcl_Command = ^Tcl_Command;
	Tcl_Command = packed record
    end;

{    	hPtr		: pTcl_HashEntry;
        nsPtr		: pTcl_Namespace;
    	refCount	: integer;
        isCmdEpoch	: integer;
        compileProc		: pointer;
        objProc		: pointer;
        objClientData	: Tcl_ClientData;
        proc		: pointer;
        clientData	: Tcl_ClientData;
        deleteProc		: TTclCmdDeleteProc;
		deleteData	: Tcl_ClientData;
        deleted		: integer;
		importRefPtr: pointer;
}

// Tk
const
	TK_MAPPED		= 1;
    TK_TOP_LEVEL	= 2;
    TK_ALREADYDEAD	= 3;
    TK_NEED_CONFIG_NOTIFY = 8;
    TK_GRAB_FLAG	= $10;
    TK_CHECKED_IC	= $20;
    TK_DONT_DESTROY_WINDOW = $40;
    TK_WM_COLORMAP_WINDOW = $80;
    TK_EMBEDDED		= $100;
    TK_CONTAINER	= $200;
    TK_BOTH_HALVES	= $400;
    TK_DEFER_MODAL	= $800;
    TK_WRAPPER		= $1000;
    TK_REPARENTED	= $2000;

	WM_USER			= $0400;
    TK_CLAIMFOCUS	= WM_USER;
    TK_GEOMETRYREQ	= WM_USER + 1;
    TK_ATTACHWINDOW	= WM_USER + 2;
    TK_DETACHWINDOW	= WM_USER + 3;


// X Windows
const
	StructureNotifyMask	= ( 1 shl 17 );
	DestroyNotify		= 17;

    WithdrawnState 		= 0;
    NormalState			= 1;
    IconicState			= 3;

    USPosition			= 1 shl 0;
    PPosition			= 1 shl 2;

type
	ulong = longint;
    uint = integer;
    bool = longbool;
    XID = ulong;
    X_Pixmap = XID; // Actually Pixmap
    X_Window = XID; // Actually Window
    X_Font = XID; // Actually Font
    X_Cursor = XID; // Actually Cursor
    X_Colormap = XID; // Actually Colormap
    X_Atom = ulong; // Actually Atom
    X_Time = ulong; // Actually Time

    XWindowChanges = packed record
    	x			: integer;
        y			: integer;
        width		: integer;
        height		: integer;
        border_width: integer;
        sibling		: X_Window;
        stack_mode	: integer;
    end;

    XSetWindowAttributes = packed record
    	background 		: X_Pixmap;
        background_pixal: ulong;
        border_X_Pixmap	: X_Pixmap;
        border_pixel	: ulong;
        bit_gravity		: integer;
        win_gravity		: integer;
        backing_store	: integer;
        backing_planes	: ulong;
        backing_pixel	: ulong;
		save_under		: bool;
        event_mask		: longint;
        do_not_propagate_mask: longint;
        override_redirect: bool;
        colormap		: X_Colormap;
        cursor			: X_Cursor;
    end;

    pXEvent = ^XEvent;
    XEvent = packed record
    	typ: integer;
    end;

	pXWMHints = ^XWMHints;
    XWMHints = packed record
    	flags			: longint;
        input			: bool;
        initial_state   : integer;
        icon_pixmap		: X_Pixmap;
        icon_window		: X_Window;
        icon_x			: integer;
        icon_y			: integer;
        icon_mask		: X_Pixmap;
        window_group	: XID;
    end;


    pXScreen = ^XScreen;
    XScreen = packed record
    	dummies1: array[0..2] of integer;
        width: integer;
        height: integer;
        dummies2: array[0..14] of integer;
    end;

    aXScreen = array[0..255] of XScreen;
    paXScreen = ^aXScreen;

    pXDisplay = ^XDisplay;
    XDisplay = packed record
    	dummies: array[0..33] of integer;
        Screens: paXScreen;
    end; // more elements...

// Done X
const

    WM_NEVER_MAPPED		= 1 shl 0;
    WM_UPDATE_PENDING	= 1 shl 1;
    WM_NEGATIVE_X		= 1 shl 2;
    WM_NEGATIVE_Y		= 1 shl 3;
    WM_UPDATE_SIZE_HINTS= 1 shl 4;
    WM_SYNC_PENDING		= 1 shl 5;
    WM_CREATE_PENDING	= 1 shl 6;
    WM_MOVE_PENDING		= 1 shl 7;
    WM_COLORMAPS_EXPLICIT = 1 shl 8;
    WM_ADDED_TOPLEVEL_COLORMAP = 1 shl 9;
    WM_WIDTH_NOT_RESIZABLE	= 1 shl 10;
    WM_HEIGHT_NOT_RESIZABLE	= 1 shl 11;

	WM_OVERRIDE_STYLE	= WS_POPUP or WS_CLIPCHILDREN or CS_DBLCLKS;
    EX_OVERRIDE_STYLE	= WS_EX_TOOLWINDOW;
	WM_TOPLEVEL_STYLE	= WS_OVERLAPPED or WS_CLIPCHILDREN or CS_DBLCLKS;
    EX_TOPLEVEL_STYLE	= 0;
    WM_TRANSIENT_STYLE	= WS_POPUP or WS_CAPTION or WS_SYSMENU or WS_CLIPSIBLINGS or CS_DBLCLKS;
    EX_TRANSIENT_STYLE	= WS_EX_TOOLWINDOW or WS_EX_DLGMODALFRAME;

    TK_WIN_TOPLEVEL_CLASS_NAME	= 'TkTopLevel';
    TK_WIN_CHILD_CLASS_NAME		= 'TkChild';


type

    Tk_Uid = pChar;

    pTkDisplay = ^TkDisplay;
    TkDisplay = packed record // From TkInt.h
    	display			: pointer;
        nextPtr			: pTkDisplay;
        name			: pChar;
		lastEventTime	: X_Time;
        bindInfoStale	: integer;
        modeModMask		: uint;
        metaModMask		: uint;
        altModMask		: uint;
        lockUsage		: integer; // enum { LU_IGNORE, LU_CAPS, LU_SHIFT }
        numModKeyCodes	: integer;
        modKeyCodes		: pointer;
        errorPtr		: pointer;
        deleteCount		: integer;
        commTkWin		: pointer; // pTk_Window
        commProperty	: X_Atom;
        registryProperty: X_Atom;
        appNameProperty	: X_Atom;
        selectionInfoPtr: pointer;
        multipleAtom	: X_Atom;
        incrAtom		: X_Atom;
        targetsAtom		: X_Atom;
        timestampAtom	: X_Atom;
        textAtom		: X_Atom;
        compoundTextAtom: X_Atom;
        applicationAtom	: X_Atom;
        windowAtom		: X_Atom;
        clipBoardAtom	: X_Atom;
        clipWindow		: pointer; // pTk_Window;
        clipBoardActive	: integer;
        clipBoardAppPtr	: pointer;
        clipTargetPtr	: pointer;
        atomInit		: integer;
        nameTable		: Tcl_HashTable;
        atomTable		: Tcl_HashTable;
        cursorFont		: X_Font;
        grabWinPtr		: pointer;
        eventualGrabWinPtr: pointer;
        buttonWinPtr	: pointer;
        serverWinPtr	: pointer;
        firstGrabEventPtr: pointer;
        lastGrabEventPtr: pointer;
        grabFlags		: integer;
        idStackPtr		: pointer;
        defaultAllocProc: pointer;
        windowStackPtr	: pointer;
        idCleanupSchedule: integer;
        destroyCount	: integer;
        lastDestroyRequest: ulong;
        cmapPtr			: pointer;
        implicitWinPtr	: pointer;
        stressPtr		: pointer;
        delayedMotionPtr: pointer;
        winTable		: Tcl_HashTable;
        refCount		: integer;
	end;


	TkPoint = record
    	x: integer;
        y: integer;
    end;

    pTk_Window = ^Tk_Window;
	pTkWindow = pTk_Window;
    ppTkWindow = ^pTkWindow;


    pTkWmInfo = ^TkWmInfo;
    TkWmInfo = packed record // This structure is hidden. Use with caution.
    	winPtr			: pTkWindow;
        wrapper			: HWND;
        titleUid		: Tk_Uid;
        iconName		: Tk_Uid;
        masterPtr		: pTkWindow;
        hints			: XWMHints;
        leaderName		: pChar;
        icon			: pTk_Window;
        iconFor			: pTk_Window;
        defMinWidth		: integer;
        defMinHeight	: integer;
        defMaxWidth		: integer;
        defMaxHeight	: integer;
        sizeHintsFlags	: integer;
		minWidth		: integer;
        minHeight		: integer;
        maxWidth		: integer;
        maxHeight		: integer;
        gridWin			: pTk_Window;
        widthInc		: integer;
        heightInc		: integer;
        minAspect		: TkPoint;
        maxAspect		: TkPoint;
        reqGridWidth	: integer;
        reqGridHeight	: integer;
        gravity			: integer;
        width			: integer;
        height			: integer;
        x				: integer;
        y				: integer;
        borderWidth		: integer;
        borderHeight	: integer;
        configWidth		: integer;
        configHeight	: integer;
        hMenu			: HMENU;
        style			: DWORD;
        exStyle			: DWORD;
        cmapList		: ppTkWindow;
        cmapCount		: integer;
        protPtr			: pointer;
        cmdArgc			: integer;
        cmdArgv			: Tcl_Argv; // char **
        clientMachine	: pChar;
        flags			: integer;
        nextPtr			: pTkWmInfo;
    end;

    pTk_BindingTable = ^Tk_BindingTable;
    Tk_BindingTable = packed record
    end;

    pTkBindInfo = ^TkBindInfo;
    TkBindInfo = packed record
    end;

    pTkMainInfo = ^TkMainInfo; // This structure is hidden
    TkMainInfo = packed record
    	refCount		: integer;
        winPtr			: pTkWindow;
        interp			: pTcl_Interp;
        nameTable		: Tcl_HashTable;
        bindingTable	: pTk_BindingTable;
        bindInfo		: pTkBindInfo;
        fontInfoPtr		: pointer;
        focusPtr		: pointer;
        focusWinPtr		: pTkWindow;
        focusSerial		: ulong;
        focusOnMapPtr	: pTkWindow;
        forceFocus		: integer;
        optionRootPtr	: pointer;
        imageTable		: Tcl_HashTable;
        strictMotif		: integer;
        nextPtr			: pTkMainInfo;
    end;

                              // This structures elements are normally hidden. Use with caution
    Tk_Window = packed record // Elements abstracted from Tk_FakeWin
    	display		: pointer;
        dispPtr		: pTkDisplay;  // abstracted from TkInt.h
        screenNum	: integer;
        visual		: pointer;
        depth		: integer;
        window		: X_Window;
        childList	: pTkWindow;
        lastChildPtr: pTkWindow;
        parentPtr	: pTkWindow;
        nextPtr		: pTkWindow;
        mainPtr		: pTkMainInfo;
        pathName	: pChar;
        nameUid		: Tk_Uid;
		classUid	: Tk_Uid;
        changes		: XWindowChanges;
        dirtyChanges: ulong; // abstracted from TkInt.h
        atts		: XSetWindowAttributes;
        dirtyAtts	: ulong; // abstracted from TkInt.h
        flags		: uint;
        handlerList	: pointer;
        tagPtr		: Tcl_ClientData;
        numTags		: integer;
        optionLevel	: integer;
        selHandlerList: pointer;
        geomMgrPtr	: pointer;
        geomData	: Tcl_ClientData;
        reqWidth	: integer;
        reqHeight	: integer;
        internalBorderWidth: integer;
        wmInfoPtr	: pTkWmInfo;
        classProcsPtr: pointer;
        instanceData: Tcl_ClientData;
        privatePtr	: pointer;
    end;

	pTkWinWindow = ^TkWinWindow;
    TkWinWindow = record
    	typ		: integer;
        handle	: HWND;
        winPtr	: pTkWindow;
    end;

    pTkWinBitmap = ^TkWinBitmap;
    TkWinBitmap = record
    	typ		: integer;
        handle	: HBITMAP;
        colormap: X_Colormap;
        depth	: integer;
    end;

    pTkWinDC = ^TkWinDC;
    TkWinDC = record
    	typ		: integer;
        hdc		: HDC;
    end;

    pTkWinDrawable = ^TkWinDrawable;
    TkWinDrawable = record
    	case integer of
        	0: (typ: integer);
            1: (window: TkWinWindow);
            2: (bitmap: TkWinBitmap);
            3: (winDC: TkWinDC);
    end;


type
	TTcl_Alloc			= function (size: Cardinal): pChar; cdecl;
	TTcl_CreateInterp  	= function  : pTcl_Interp; cdecl;
	TTcl_DeleteInterp 	= procedure(interp: pTcl_Interp); cdecl;
    TTcl_ResetResult	= procedure(interp: pTcl_Interp); cdecl;
	TTcl_Eval  		  	= function (interp: pTcl_Interp; script : pChar):integer; cdecl;
    TTcl_EvalFile		= function (interp: pTcl_Interp; filename: pChar):integer; cdecl;
    TTcl_AddErrorInfo	= procedure(interp: pTcl_Interp; message: pChar); cdecl;
    TTcl_BackgroundError= procedure(interp: pTcl_Interp); cdecl;
	TTcl_CreateCommand	= function (interp: pTcl_Interp; name: pChar; cmdProc: TTclCmdProc;
    			clientData: Tcl_ClientData; deleteProc: TTclCmdDeleteProc): pTcl_Command; cdecl;
	TTcl_DeleteCommand	= function (interp: pTcl_Interp; name: pChar): integer; cdecl;
    TTcl_CallWhenDeleted= procedure(interp: pTcl_Interp; proc: TTclInterpDeleteProc; clientData: Tcl_ClientData); cdecl;
    TTcl_DontCallWhenDeleted = procedure(interp: pTcl_Interp; proc: TTclInterpDeleteProc; clientData: Tcl_ClientData); cdecl;
    TTcl_CommandComplete= function (cmd: pChar): integer; cdecl;
	TTcl_LinkVar	  	= function (interp: pTcl_Interp; varName: pChar; var addr; typ: integer): integer; cdecl;
	TTcl_UnlinkVar		= procedure(interp: pTcl_Interp; varName: pChar); cdecl;

	TTcl_TraceVar		= function (interp: pTcl_Interp; varName: pChar; flags: integer; proc: TTclVarTraceProc;
				clientData: Tcl_ClientData): integer; cdecl;

	TTcl_TraceVar2		= function (interp: pTcl_Interp; varName: pChar; elemName: pChar; flags : integer; proc: TTclVarTraceProc;
				clientData: Tcl_ClientData): integer; cdecl;

	TTcl_UntraceVar		= procedure(interp: pTcl_Interp; varName: pChar; flags: integer;
				proc: TTclVarTraceProc; clientData: Tcl_ClientData); cdecl;

	TTcl_UntraceVar2	= procedure(interp: pTcl_Interp; varName: pChar; elemName: pChar; flags: integer;
				proc: TTclVarTraceProc; clientData: Tcl_ClientData); cdecl;

	TTcl_GetVar			= function (interp: pTcl_Interp; varName: pChar; flags: integer): pChar; cdecl;
	TTcl_GetVar2		= function (interp: pTcl_Interp; varName: pChar; elemName: pChar; flags: integer): pChar; cdecl;

	TTcl_SetVar			= function (interp: pTcl_Interp; varName: pChar; newValue: pChar; flags: integer): pChar; cdecl;
	TTcl_SetVar2		= function (interp: pTcl_Interp; varName: pChar; elemName: pChar; newValue: pChar; flags: integer): pChar;
    						 cdecl;

	TTcl_UnsetVar		= function (interp: pTcl_Interp; varName: pChar; flags: integer): integer; cdecl;
	TTcl_UnsetVar2		= function (interp: pTcl_Interp; varName: pChar; elemName: pChar; flags: integer): integer; cdecl;

	TTcl_SetResult		= procedure(interp: pTcl_Interp; newValue: pChar; freeProc: TTclFreeProc); cdecl;

	TTcl_FirstHashEntry	= function (hashTbl: pTcl_HashTable; var searchInfo: Tcl_HashSearch): pTcl_HashEntry; cdecl;
//	TTcl_FirstHashEntry	= function (hashTbl: pointer; var searchInfo: Tcl_HashSearch): pTcl_HashEntry; cdecl;
	TTcl_NextHashEntry	= function (var searchInfo: Tcl_HashSearch): pTcl_HashEntry; cdecl;

    TTcl_InitHashTable	= procedure(hashTbl: pTcl_HashTable; keyType: integer); cdecl;

	TTcl_StringMatch	= function (str: pChar; pattern: pChar): integer; cdecl;

	TTcl_GetHashKey		= function (hashTbl: pTcl_HashTable; hashEntry: pTcl_HashEntry): pChar; cdecl;
//	TTcl_GetHashKey		= function (hashTbl: pointer; hashEntry: pTcl_HashEntry): pChar; cdecl;

    TTcl_GetErrno		= function :integer; cdecl;
    TTcl_SetErrno		= procedure(val: integer); cdecl;

	TTcl_PanicProc		= procedure(fmt, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8: pChar); cdecl; // 1/15/97 orig. Tcl style
    TTcl_SetPanicProc	= procedure(proc: TTcl_PanicProc); cdecl;

    TTcl_PkgProvide		= function (interp: pTcl_Interp; name: pChar; version: pChar): integer; cdecl;
  	TTcl_StaticPackage	= procedure(interp: pTcl_Interp; pkgName: pChar; initProc: TTclPackageInitProc;
    	safeInitProc: TTclPackageInitProc); cdecl;

  //  TTcl_MallocEvent	= function (size: integer): pTcl_Event; cdecl; dropped 1/15/97 - now using Tcl_Alloc

    TTcl_CreateEventSource = procedure(setupProc: TTcl_EventSetupProc;
    	checkProc: TTcl_EventCheckProc; clientData: Tcl_ClientData); cdecl;
    TTcl_DeleteEventSource = procedure(setupProc: TTcl_EventSetupProc;
    	checkProc: TTcl_EventCheckProc; clientData: Tcl_ClientData); cdecl;
	TTcl_QueueEvent		= procedure(evPtr: pTcl_Event; pos: integer); cdecl;
	TTcl_SetMaxBlockTime= procedure(timePtr: pTcl_Time); cdecl;
    TTcl_EventDeleteProc= function (evPtr: pTcl_Event; clientData: Tcl_ClientData): integer; cdecl;
    TTcl_DeleteEvents	= procedure(proc: TTcl_EventDeleteProc; clientData: Tcl_ClientData); cdecl;
	TTcl_DoOneEvent		= function (flags: integer): integer; cdecl;


	TTcl_ClientDataProc = procedure(clientData: Tcl_ClientData); cdecl;
    TTcl_IdleProc		= TTcl_ClientDataProc;
	TTcl_DoWhenIdle		= procedure(proc: TTcl_IdleProc; clientData: Tcl_ClientData); cdecl;
    TTcl_CancelIdleCall	= procedure(proc: TTcl_IdleProc; clientData: Tcl_ClientData); cdecl;
    TTcl_TimerProc		= procedure(clientData: Tcl_ClientData); cdecl;
    TTcl_CreateTimerHandler	= function(milliseconds: integer; proc: TTcl_TimerProc;
    	clientData: Tcl_ClientData): Tcl_TimerToken; cdecl;
    TTcl_DeleteTimerHandler = procedure(token: Tcl_TimerToken); cdecl;
    TTcl_CreateModalTimeout	= procedure(milliseconds: integer; proc: TTcl_TimerProc; clientData: Tcl_ClientData); cdecl;
    TTcl_DeleteModalTimeout = procedure(proc: TTcl_TimerProc; clientData: Tcl_ClientData); cdecl;

	// 3/3/97
    TTcl_SplitList 	= function (interp: pTcl_Interp; list: pChar; var argcPtr: integer; var argvPtr: Tcl_Argv): integer; cdecl;
    TTcl_Merge 		= function (argc: integer; argv: Tcl_Argv):pChar; cdecl;
    TTcl_Free 		= procedure( ptr: pChar ); cdecl;
    TTcl_Init 		=  function(interp: pTcl_Interp): integer; cdecl;

	// 3/21/97
	TTcl_InterpDeleteProc	= procedure(clientData: Tcl_ClientData; interp: pTcl_Interp); cdecl;
	TTcl_GetAssocData 		= function (interp:pTcl_Interp; key: pChar; var proc: TTcl_InterpDeleteProc): Tcl_ClientData; cdecl;
    TTcl_DeleteAssocData 	= procedure(interp: pTcl_Interp; key: pChar); cdecl;
    TTcl_SetAssocData 		= procedure(interp: pTcl_Interp; key: pChar; proc: TTcl_InterpDeleteProc;
    									clientData: Tcl_ClientData); cdecl;

    TTcl_IsSafe         = function (interp: pTcl_Interp): integer; cdecl;
    TTcl_MakeSafe		= function (interp: pTcl_Interp): integer; cdecl;
    TTcl_CreateSlave	= function (interp: pTcl_Interp; slaveName: pChar; isSafe: integer): pTcl_Interp; cdecl;
    TTcl_GetSlave		= function (interp: pTcl_Interp; slaveName: pChar): pTcl_Interp; cdecl;
    TTcl_GetMaster		= function (interp: pTcl_Interp): pTcl_Interp; cdecl;
    TTcl_GetInterpPath	= function (askingInterp: pTcl_Interp; slaveInterp: pTcl_Interp): integer; cdecl;
    TTcl_CreateAlias	= function (slaveInterp: pTcl_Interp; srcCmd: pChar; targetInterp: pTcl_Interp; targetCmd: pChar;
    								argc: integer; argv: Tcl_Argv): integer; cdecl;
    TTcl_GetAlias		= function (interp: pTcl_Interp; srcCmd: pChar; var targetInterp: pTcl_Interp; var targetCmd: pChar;
    								var argc: integer; var argv: Tcl_Argv): integer; cdecl;
    TTcl_ExposeCommand	= function (interp: pTcl_Interp; hiddenCmdName: pChar; cmdName: pChar): integer; cdecl;
    TTcl_HideCommand	= function (interp: pTcl_Interp; cmdName: pChar; hiddenCmdName: pChar): integer; cdecl;

    TTcl_FreeProc		= procedure(blockPtr: pChar); cdecl;
    TTcl_EventuallyFree	= procedure(clientData: Tcl_ClientData; freeProc: TTcl_FreeProc); cdecl;
    TTcl_Preserve		= procedure(clientData: Tcl_ClientData); cdecl;
    TTcl_Release		= procedure(clientData: Tcl_ClientData); cdecl;
    TTcl_InterpDeleted	= function (interp: pTcl_Interp): integer; cdecl;
    TTcl_GetCommandInfo	= function (interp: pTcl_Interp; cmdName: pChar; var info: Tcl_CmdInfo): integer; cdecl;
	TTcl_SetCommandInfo = function (interp: pTcl_Interp; cmdName: pChar; var info: Tcl_CmdInfo): integer; cdecl;
	TTcl_FindExecutable	= procedure(path: pChar); cdecl;
    TTcl_GetStringResult = function(interp: pTcl_Interp): pChar; cdecl; //v1.0
    TTcl_FindCommand	= function(interp: pTcl_Interp; cmdName: pChar;
    	 contextNsPtr: pTcl_Namespace; flags: integer): Tcl_Command; cdecl; //v1.0
    TTcl_DeleteCommandFromToken = function(interp: pTcl_Interp; cmd: pTcl_Command): integer; cdecl;
    TTcl_CreateNamespace = function(interp: pTcl_Interp; name: pChar; clientData: Tcl_ClientData;
    	 deleteProc: TTclNamespaceDeleteProc): pTcl_Namespace; cdecl; //v1.0
    TTcl_DeleteNamespace = procedure(namespacePtr: pTcl_Namespace); cdecl;
	TTcl_FindNamespace = function(interp: pTcl_Interp; name: pChar; contextNsPtr: pTcl_Namespace;
    	 flags: integer): pTcl_Namespace; cdecl;
    TTcl_Export = function(interp: pTcl_Interp; namespacePtr: pTcl_Namespace; pattern: pChar;
    	 resetListFirst: integer): integer; cdecl;
    TTcl_Import = function(interp: pTcl_Interp; namespacePtr: pTcl_Namespace; pattern: pChar;
    	 allowOverwrite: integer): integer; cdecl;
    TTcl_GetCurrentNamespace = function(interp: pTcl_Interp): pTcl_Namespace; cdecl;
    TTcl_GetGlobalNamespace = function(interp: pTcl_Interp): pTcl_Namespace; cdecl;
    TTcl_PushCallFrame = function(interp: pTcl_Interp; var callFramePtr: Tcl_CallFrame;
		 namespacePtr: pTcl_Namespace; isProcCallFrame: integer): integer; cdecl;
	TTcl_PopCallFrame = procedure(interp: pTcl_Interp); cdecl;

// For TkConsole.c
    TTcl_RecordAndEval = function(interp: pTcl_Interp; cmd: pChar; flags: integer): integer; cdecl;
    TTcl_GlobalEval = function(interp: pTcl_Interp; command: pChar): integer; cdecl;

    TTcl_DStringFree = procedure(dsPtr: pTcl_DString); cdecl;
    TTcl_DStringAppend = function(dsPtr: pTcl_DString; str: pChar; len: integer): pChar; cdecl;
    TTcl_DStringAppendElement = function(dsPtr: pTcl_DString; str: pChar): pChar; cdecl;
    TTcl_DStringInit = procedure(dsPtr: pTcl_DString); cdecl;
    TTcl_AppendResult = procedure(interp: pTcl_Interp {, ...}); cdecl; // Don't use - actually a "C" var array

    TTcl_SetStdChannel = procedure(channel: pTcl_Channel; typ: integer); cdecl;
	TTcl_SetChannelOption = function(interp: pTcl_Interp; chan: pTcl_Channel; optionName: pChar; newValue: pChar): integer; cdecl;
	TTcl_GetChannelOption = function(interp: pTcl_Interp; chan: pTcl_Channel; optionName: pChar; dsPtr: pTcl_DString): integer; cdecl;
    TTcl_CreateChannel = function(typePtr: pTcl_ChannelType; chanName: pChar;
    	instanceData: Tcl_ClientData; mask: integer):pTcl_Channel; cdecl;
	TTcl_RegisterChannel = procedure(interp: pTcl_Interp; channel: pTcl_Channel); cdecl;
    TTcl_UnregisterChannel = function(interp: pTcl_Interp; channel: pTcl_Channel): integer; cdecl;
    TTcl_CreateCloseHandler = procedure(channel: pTcl_Channel; proc: TTcl_ClientDataProc; clientData: Tcl_ClientData); cdecl;
    TTcl_DeleteCloseHandler = TTcl_CreateCloseHandler;
	TTcl_CreateChannelHandler = procedure(chan: pTcl_Channel; mask: integer; proc: TTclChannelProc; clientData: Tcl_ClientData); cdecl;
	TTcl_GetChannel = function(interp: pTcl_Interp; chanName: pChar; modePtr: pInteger): pTcl_Channel; cdecl;
	TTcl_GetStdChannel = function(typ: integer): pTcl_Channel; cdecl;
	TTcl_Gets = function(chan: pTcl_Channel; dsPtr: pTcl_DString): integer; cdecl;
    TTcl_Write = function(chan: pTcl_Channel; s: pChar; slen: integer): integer; cdecl;
    TTcl_Flush = function(chan: pTcl_Channel): integer; cdecl;
    TTclWinLoadLibrary = function(name: pChar): HMODULE; cdecl;
    TTcl_CreateExitHandler = procedure(proc: TTcl_ClientDataProc; clientData: Tcl_ClientData); cdecl;
    TTcl_DeleteExitHandler = procedure(proc: TTcl_ClientDataProc; clientData: Tcl_ClientData); cdecl;
    TTcl_GetStringFromObj = function(pObj: pTcl_Obj; pLen: pInteger): pChar; cdecl;
	TTcl_CreateObjCommand	= function (interp: pTcl_Interp; name: pChar; cmdProc: TTclObjCmdProc;
    			clientData: Tcl_ClientData; deleteProc: TTclCmdDeleteProc): pTcl_Command; cdecl;
	TTcl_NewStringObj = function(bytes: pChar; len: integer): pTcl_Obj; cdecl;
//    TTcl_IncrRefCount = procedure(pObj: pTcl_Obj); cdecl;
//    TTcl_DecRefCount = procedure(pObj: pTcl_Obj); cdecl;
//    TTcl_IsShared = function(pObj: pTcl_Obj): integer; cdecl;
    TTclFreeObj = procedure(pObj: pTcl_Obj); cdecl;
	TTcl_EvalObj = function(interp: pTcl_Interp; pObj: pTcl_Obj): integer; cdecl;
    TTcl_GlobalEvalObj = function(interp: pTcl_Interp; pObj: pTcl_Obj): integer; cdecl;

    TTclRegComp = function(exp: pChar): pointer; cdecl;
    TTclRegExec = function(prog: pointer; str: pChar; start: pChar): integer; cdecl;
    TTclRegError = procedure(msg: pChar); cdecl;
    TTclGetRegError = function: pChar; cdecl;
    TTcl_RegExpRange = procedure(prog: pointer; index: integer; var head: pChar; var tail: pChar); cdecl;

// Tk
    TTkEventProc = procedure(clientData: Tcl_ClientData; eventPtr: pXEvent); cdecl;

    TTk_CreateEventHandler = procedure(token: pTk_Window; mask: longint; proc: TTkEventProc; clientData: Tcl_ClientData); cdecl;
    TTk_Init = function(interp: pTcl_Interp): integer; cdecl;
	TTkCreateMainWindow = function(interp: pTcl_Interp; screenName: pChar; baseName: pChar): pTk_Window; cdecl;
    TTk_MainWindow = function(interp: pTcl_Interp): pTk_Window; cdecl;
    TTk_MakeWindowExist = procedure(tkwin: pTk_Window); cdecl;
    TTk_Main = procedure(argc: integer; argv: Tcl_Argv; appInitProc: TTclAppInitProc); cdecl;
    TTk_GetHINSTANCE = function: integer; cdecl;
    TTk_GetHWND = function(window: X_Window): HWND; cdecl;
    TTk_AttachHWND	= function(window: pTk_Window; hwnd: integer): XID; cdecl;
    TTkWinChildProc = function(hwnd, msg, wParam, lParam: integer): integer; stdcall;
    TTkWmMapWindow = procedure(window: pTk_Window); cdecl;
    TTkInstallFrameMenu = procedure(tkwin: pTk_Window); cdecl;
    TTkpWmSetState = procedure(winPtr: pTkWindow; state: integer); cdecl;
    TXMapWindow	= procedure(display: pXDisplay; w: X_Window); cdecl;
    TTk_GeometryRequest = procedure(tkwin: pTk_Window; reqWidth: integer; reqHeight: integer); cdecl;
    TTkpGetOtherWindow = function(winPtr: pTkWindow): pTkWindow; cdecl;
    TTkpMakeContainer = procedure(tkwnd: pTk_Window); cdecl;
    TTk_GetNumMainWindows = function: integer; cdecl;
    TTk_NameToWindow = function(interp: pTcl_Interp; pathName: pChar; tkwin: pTk_Window): pTk_Window; cdecl;
    TTk_HWNDToWindow = function(hwnd: HWND): pTk_Window; cdecl;

// End TkConsole.c

const
	Tcl_Alloc				:	TTcl_Alloc			= nil;
	Tcl_CreateInterp		: 	TTcl_CreateInterp	= nil;
	Tcl_DeleteInterp		:	TTcl_DeleteInterp	= nil;
    Tcl_ResetResult			:	TTcl_ResetResult	= nil;
	Tcl_Eval  				:	TTcl_Eval  		 	= nil;
    Tcl_EvalFile			:	TTcl_EvalFile		= nil;
    Tcl_AddErrorInfo		:	TTcl_AddErrorInfo	= nil;
	Tcl_BackgroundError		:	TTcl_BackgroundError= nil;
	Tcl_CreateCommand		:	TTcl_CreateCommand	= nil;
	Tcl_DeleteCommand		:	TTcl_DeleteCommand	= nil;
    Tcl_CallWhenDeleted		:	TTcl_CallWhenDeleted = nil;
    Tcl_DontCallWhenDeleted	:	TTcl_DontCallWhenDeleted = nil;
    Tcl_CommandComplete		:	TTcl_CommandComplete= nil;
	Tcl_LinkVar	 			:	TTcl_LinkVar	 	= nil;
	Tcl_UnlinkVar			:	TTcl_UnlinkVar	 	= nil;
	Tcl_TraceVar			:	TTcl_TraceVar	  	= nil;
	Tcl_TraceVar2			:	TTcl_TraceVar2	  	= nil;
	Tcl_UntraceVar			:	TTcl_UntraceVar	 	= nil;
	Tcl_UntraceVar2 		:	TTcl_UntraceVar2	= nil;
	Tcl_GetVar				:	TTcl_GetVar			= nil;
	Tcl_GetVar2	 			:	TTcl_GetVar2		= nil;
	Tcl_SetVar		 		:	TTcl_SetVar			= nil;
	Tcl_SetVar2	 			:	TTcl_SetVar2		= nil;
	Tcl_UnsetVar			:	TTcl_UnsetVar		= nil;
	Tcl_UnsetVar2			:	TTcl_UnsetVar2		= nil;
	Tcl_SetResult			:	TTcl_SetResult		= nil;
	Tcl_FirstHashEntry		:	TTcl_FirstHashEntry	= nil;
	Tcl_NextHashEntry		:	TTcl_NextHashEntry	= nil;
	Tcl_InitHashTable		:	TTcl_InitHashTable	= nil;
	Tcl_StringMatch 		:	TTcl_StringMatch	= nil;
	Tcl_GetHashKey			:	TTcl_GetHashKey		= nil;
    Tcl_GetErrno			:	TTcl_GetErrno		= nil;
    Tcl_SetErrno			:	TTcl_SetErrno		= nil;
    Tcl_SetPanicProc		:	TTcl_SetPanicProc	= nil;
    Tcl_PkgProvide			:	TTcl_PkgProvide		= nil;
    Tcl_StaticPackage		:	TTcl_StaticPackage	= nil;
//    Tcl_MallocEvent			:	TTcl_MallocEvent	= nil;
    Tcl_CreateEventSource	:	TTcl_CreateEventSource = nil;
    Tcl_DeleteEventSource	:	TTcl_DeleteEventSource = nil;
    Tcl_QueueEvent			:	TTcl_QueueEvent 	= nil;
	Tcl_SetMaxBlockTime		:	TTcl_SetMaxBlockTime= nil;
    Tcl_DeleteEvents		:	TTcl_DeleteEvents	= nil;
    Tcl_DoOneEvent			:	TTcl_DoOneEvent		= nil;
    Tcl_DoWhenIdle			:	TTcl_DoWhenIdle		= nil;
    Tcl_CancelIdleCall		:	TTcl_CancelIdleCall	= nil;
    Tcl_CreateTimerHandler	:	TTcl_CreateTimerHandler = nil;
    Tcl_DeleteTimerHandler	:	TTcl_DeleteTimerHandler = nil;
    Tcl_CreateModalTimeout	:	TTcl_CreateModalTimeout = nil;
    Tcl_DeleteModalTimeout	:	TTcl_DeleteModalTimeout = nil;
    Tcl_SplitList           :   TTcl_SplitList      = nil; // 3/3/97
    Tcl_Merge               :   TTcl_Merge          = nil; // 3/3/97
    Tcl_Free                :   TTcl_Free           = nil; // 3/3/97
    Tcl_Init                :   TTcl_Init           = nil; // 3/3/97
	Tcl_DeleteAssocData		:	TTcl_DeleteAssocData= nil;
    Tcl_GetAssocData		:	TTcl_GetAssocData	= nil;
    Tcl_SetAssocData		:	TTcl_SetAssocData	= nil;
    Tcl_IsSafe				: 	TTcl_IsSafe			= nil;
    Tcl_MakeSafe			:	TTcl_MakeSafe		= nil;
    Tcl_CreateSlave			: 	TTcl_CreateSlave	= nil;
    Tcl_GetSlave			:	TTcl_GetSlave		= nil;
    Tcl_GetMaster			:	TTcl_GetMaster		= nil;
    Tcl_GetInterpPath		: 	TTcl_GetInterpPath	= nil;
    Tcl_CreateAlias			:	TTcl_CreateAlias	= nil;
    Tcl_GetAlias			:	TTcl_GetAlias		= nil;
    Tcl_ExposeCommand		:	TTcl_ExposeCommand	= nil;
    Tcl_HideCommand			:	TTcl_HideCommand	= nil;
    Tcl_EventuallyFree		:	TTcl_EventuallyFree	= nil;
    Tcl_Preserve			:	TTcl_Preserve		= nil;
    Tcl_Release				:	TTcl_Release		= nil;
    Tcl_InterpDeleted		:	TTcl_InterpDeleted	= nil;
	Tcl_GetCommandInfo		:	TTcl_GetCommandInfo	= nil;
    Tcl_SetCommandInfo		: 	TTcl_SetCommandInfo = nil;
    Tcl_FindExecutable		:	TTcl_FindExecutable	= nil;
    Tcl_GetStringResult		:	TTcl_GetStringResult = nil;
	Tcl_FindCommand			:	TTcl_FindCommand = nil;
    Tcl_DeleteCommandFromToken:	TTcl_DeleteCommandFromToken = nil;
    Tcl_CreateNamespace		:	TTcl_CreateNamespace = nil;
    Tcl_DeleteNamespace		:	TTcl_DeleteNamespace = nil;
    Tcl_FindNamespace		:	TTcl_FindNamespace = nil;
	Tcl_Export				:	TTcl_Export = nil;
    Tcl_Import				:	TTcl_Import = nil;
    Tcl_GetCurrentNamespace	:	TTcl_GetCurrentNamespace = nil;
    Tcl_GetGlobalNamespace	:	TTcl_GetGlobalNamespace = nil;
    Tcl_PushCallFrame		:	TTcl_PushCallFrame = nil;
    Tcl_PopCallFrame		:	TTcl_PopCallFrame = nil;

    Tcl_RecordAndEval		:	TTcl_RecordAndEval = nil;
    Tcl_GlobalEval			:	TTcl_GlobalEval = nil;
    Tcl_DStringFree			:	TTcl_DStringFree = nil;
    Tcl_DStringAppendElement:	TTcl_DStringAppendElement = nil;
    Tcl_DStringAppend		:	TTcl_DStringAppend = nil;
    Tcl_DStringInit			:	TTcl_DStringInit = nil;
    Tcl_AppendResult		:	TTcl_AppendResult = nil;
	Tcl_SetStdChannel		:   TTcl_SetStdChannel = nil;
	Tcl_SetChannelOption	:   TTcl_SetChannelOption = nil;
    Tcl_GetChannelOption	:	TTcl_GetChannelOption = nil;
	Tcl_CreateChannel		:   TTcl_CreateChannel = nil;
    Tcl_RegisterChannel		:	TTcl_RegisterChannel = nil;
    Tcl_UnregisterChannel	:	TTcl_UnregisterChannel = nil;
	Tcl_CreateChannelHandler:	TTcl_CreateChannelHandler = nil;
    Tcl_CreateCloseHandler	:	TTcl_CreateCloseHandler = nil;
    Tcl_DeleteCloseHandler	:	TTcl_DeleteCloseHandler = nil;
    Tcl_GetChannel			:	TTcl_GetChannel = nil;
    Tcl_GetStdChannel		:	TTcl_GetStdChannel = nil;
    Tcl_Gets				:	TTcl_Gets = nil;
    Tcl_Write				:	TTcl_Write = nil;
    Tcl_Flush				:	TTcl_Flush = nil;
    TclWinLoadLibrary		:	TTclWinLoadLibrary = nil;
    Tcl_CreateExitHandler	:	TTcl_CreateExitHandler = nil;
    Tcl_DeleteExitHandler	:	TTcl_DeleteExitHandler = nil;

    Tcl_GetStringFromObj	:	TTcl_GetStringFromObj = nil;
    Tcl_CreateObjCommand	:	TTcl_CreateObjCommand = nil;
	Tcl_NewStringObj		:	TTcl_NewStringObj = nil;
//	Tcl_IncrRefCount		:   TTcl_IncrRefCount = nil;
//  Tcl_DecRefCount			:	TTcl_DecRefCount = nil;
//	Tcl_IsShared			:   TTcl_IsShared = nil;
    TclFreeObj				:	TTclFreeObj = nil;
    Tcl_EvalObj				:	TTcl_EvalObj = nil;
    Tcl_GlobalEvalObj		:	TTcl_GlobalEvalObj = nil;

	TclRegComp				:	TTclRegComp = nil;
	TclRegExec				:   TTclRegExec = nil;
    TclRegError				:	TTclRegError = nil;
    TclGetRegError			:	TTclGetRegError = nil;
    Tcl_RegExpRange			:	TTcl_RegExpRange = nil;



    Tk_CreateEventHandler	:	TTk_CreateEventHandler = nil;
    Tk_Init					:	TTk_Init = nil;
    Tk_SafeInit				:	TTk_Init = nil;
	TkCreateMainWindow		:	TTkCreateMainWindow = nil;
    Tk_MainWindow			:	TTk_MainWindow = nil;
    Tk_MakeWindowExist		:	TTk_MakeWindowExist = nil;
    Tk_Main					:	TTk_Main = nil;
    Tk_GetHINSTANCE			:	TTk_GetHINSTANCE = nil;
    Tk_GetHWND				:	TTk_GetHWND = nil;
    Tk_AttachHWND			:	TTk_AttachHWND = nil;
    TkWinChildProc			:	TTkWinChildProc = nil;
    TkWmMapWindow			:	TTkWmMapWindow = nil;
    TkInstallFrameMenu		: 	TTkInstallFrameMenu = nil;
    TkpWmSetState			:	TTkpWmSetState = nil;
    XMapWindow				:	TXMapWindow = nil;
    Tk_GeometryRequest		:	TTk_GeometryRequest = nil;
    TkpGetOtherWindow		:	TTkpGetOtherWindow = nil;
    TkpMakeContainer		:	TTkpMakeContainer = nil;
    Tk_GetNumMainWindows	:	TTk_GetNumMainWindows = nil;
    Tk_NameToWindow			:	TTk_NameToWindow = nil;
	Tk_HWNDToWindow			:	TTk_HWNDToWindow = nil;

// Thread Safe
procedure InitTcl( ALibPath: string ); // if '' then defaults to const cTclLibPath
procedure InitTk( ALibPath: string ); // if '' then defaults to const cTkLibPath
procedure UnloadTcl;
procedure UnloadTk;
function InitializedTcl: boolean;
function InitializedTk: boolean;
function TkLoaded(ALibPath: string): boolean; // something else may have loaded tk into this process. Let's find out. Path can be ''
function LibraryPath: string;
function LibraryModule: integer;

// C Macro Emulation
function Tcl_GetCommandTable(interp: pTcl_Interp): pHashTable;
function Tcl_CreateHashEntry(tablePtr: pTcl_HashTable; key: pChar; newPtr: pInteger): pTcl_HashEntry;
function Tcl_FindHashEntry(tablePtr: pTcl_HashTable; key: pChar): pTcl_HashEntry;
procedure Tcl_SetHashValue(h: pTcl_HashEntry; clientData: Tcl_ClientData);
function Tcl_GetHashValue(h: pTcl_HashEntry): Tcl_ClientData;
procedure Tcl_IncrRefCount(pObj: pTcl_Obj); cdecl;
procedure Tcl_DecrRefCount(pObj: pTcl_Obj); cdecl;
function  Tcl_IsShared(pObj: pTcl_Obj): integer; cdecl;

// Tk
function TkWinGetHWND(winDrawable: pTkWinDrawable): integer;
function TkWinGetWinPtr(winDrawable: pTkWinDrawable): pTkWindow;
function TkWinGetHBITMAP(winDrawable: pTkWinDrawable): integer;
function TkWinGetColormap(winDrawable: pTkWinDrawable): X_Colormap;
function TkWinGetHDC(winDrawable: pTkWinDrawable): integer;

function XDisplayWidth(disp: pXDisplay; idx: integer): integer;
function XDisplayHeight(disp: pXDisplay; idx: integer): integer;


//procedure TkConsoleCreate;
//function TkConsoleInit(interp: pTcl_Interp): integer;
//function strncmp(s1: pChar; s2: pChar; len: integer): integer; cdecl;

type
	TTslcLibHookKind = (thBeforeTclLoad, thAfterTclLoad, thBeforeTkLoad, thAfterTkLoad,
    					thBeforeTclUnload, thAfterTclUnload, thBeforeTkUnload, thAfterTkUnload);
    TTslcLibHookProc = procedure(clientData: pointer);

// Thread Safe
procedure AddTslcLibHook(proc: TTslcLibHookProc; clientData: pointer; kind: TTslcLibHookKind);
procedure RemoveTslcLibHook(proc: TTslcLibHookProc; clientData: pointer; kind: TTslcLibHookKind); // both proc & clientData must match existing to remove


implementation
uses SysUtils, Classes, TslcPlat; // only for TList
//{$D-,L-,Y-}
{$Z+}
{$D-,L-,Y-,R-,H+}
{$O+}


var
    TclModule		: HModule = 0;
    TclLibPath		: string = cTclLibPath;
    TkModule		: HModule = 0;
    TkLibPath		: string = cTkLibPath;

// Macro emulation
function Tcl_CreateHashEntry(tablePtr: pTcl_HashTable; key: pChar; newPtr: pInteger): pTcl_HashEntry;
begin
	result := pHashTable(tablePtr)^.createProc(tablePtr, key, newPtr);
end;

function Tcl_FindHashEntry(tablePtr: pTcl_HashTable; key: pChar): pTcl_HashEntry;
begin
	result := pHashTable(tablePtr)^.findProc(tablePtr, key);
end;

procedure Tcl_SetHashValue(h: pTcl_HashEntry; clientData: Tcl_ClientData);
begin
	h^.clientData := clientData;
end;

function Tcl_GetHashValue(h: pTcl_HashEntry): Tcl_ClientData;
begin
	result := h^.clientData;
end;


function _Tcl_GetHashKey(hashTbl: pTcl_HashTable; hashEntry: pTcl_HashEntry): pChar; cdecl;
begin
	if (hashTbl = nil) or (hashEntry = nil) then
    	result := nil
	else if pHashTable(hashTbl)^.keyType = 1 then
    	result :=  pChar(pLongInt(@(hashEntry^.key[0]))^)
    else
    	result := hashEntry^.key;
end;

procedure Tcl_IncrRefCount(pObj: pTcl_Obj); cdecl;
begin
	inc(pObj^.refCount);
end;

procedure Tcl_DecrRefCount(pObj: pTcl_Obj); cdecl;
begin
	dec(pObj^.refCount);
    if pObj^.refCount <= 0 then
    	TclFreeObj(pObj);
end;

function Tcl_IsShared(pObj: pTcl_Obj): integer; cdecl;
begin
	if pObj^.refCount > 0 then
    	result := 1
    else
    	result := 0;
end;

// Tk Macro Emulation
function TkWinGetHWND(winDrawable: pTkWinDrawable): integer;
begin
	result := winDrawable^.window.handle;
end;

function TkWinGetWinPtr(winDrawable: pTkWinDrawable): pTkWindow;
begin
	result := winDrawable^.window.winPtr;
end;

function TkWinGetHBITMAP(winDrawable: pTkWinDrawable): integer;
begin
	result := winDrawable^.bitmap.handle;
end;

function TkWinGetColormap(winDrawable: pTkWinDrawable): X_Colormap;
begin
	result := winDrawable^.bitmap.colormap;
end;

function TkWinGetHDC(winDrawable: pTkWinDrawable): integer;
begin
	result := winDrawable^.winDC.hdc;
end;

function XDisplayWidth(disp: pXDisplay; idx: integer): integer;
begin
	result := disp^.screens^[idx].width;
end;

function XDisplayHeight(disp: pXDisplay; idx: integer): integer;
begin
	result := disp^.screens^[idx].height;
end;

function Tcl_GetCommandTable(interp: pTcl_Interp): pHashTable;
begin
    if interp = nil then
    	result := nil
    else if TCL_VERSION_MAJOR >= 8 then // pretty sure it happened in this version
		result := pHashTable(longint(interp) + sizeof(Tcl_Interp) + sizeof(pointer))
	else
		result := pHashTable(longint(interp) + sizeof(Tcl_Interp));
end;

//Tcl_UpdateLinkedVar(interp, varName)
function InitializedTcl: boolean;
begin
	TslcEnterCritical;
    try
		result := TclModule <> 0;
    finally
    	TslcLeaveCritical;
    end;
end;

function InitializedTk: boolean;
begin
	TslcEnterCritical;
    try
		result := TkModule <> 0;
    finally
    	TslcLeaveCritical;
    end;
end;

function LibraryPath: string;
begin
	TslcEnterCritical;
    try
		result := TclLibPath;
    finally
    	TslcLeaveCritical;
    end;
end;

function LibraryModule: integer;
begin
	TslcEnterCritical;
    try
		result := TclModule;
    finally
    	TslcLeaveCritical;
    end;
end;

function Get( module: integer; name: string ): FARPROC;
begin
	result := GetProcAddress( module, pChar( name ) );
    if result = nil then
    	result := GetProcAddress( module, pChar( '_' + name ) );
end;

procedure CallTslcLibHook(kind: TTslcLibHookKind); forward;

procedure InitTcl( ALibPath: string );
	function GetCheck(name: string ):FARPROC;
	begin
		result := Get(TclModule, name );
	    if result = nil then
    		raise Exception.CreateFmt('Unable to load Tcl procedures from %s %s',[TclLibPath, name]);
	end;
var
	str: string;
    p: integer;
    interp: pTcl_Interp;
begin
	if InitializedTcl then
    	exit;
    TslcEnterCritical;
    try
	    CallTslcLibHook(thBeforeTclLoad);
		if ALibPath <> '' then TclLibPath := ALibPath;
	    TclModule := LoadLibrary(  pChar( TclLibPath ) );
	    if TclModule = 0 then
		   	raise Exception.CreateFmt('Unable to load Tcl Library %s (%d)',[TclLibPath, GetLastError] );

		Tcl_CreateInterp 	:= GetCheck( 'Tcl_CreateInterp' );
		Tcl_DeleteInterp	:= GetCheck( 'Tcl_DeleteInterp' );
	    Tcl_ResetResult		:= GetCheck( 'Tcl_ResetResult' );
		Tcl_Eval  		 	:= GetCheck( 'Tcl_Eval' );
	    Tcl_EvalFile		:= GetCheck( 'Tcl_EvalFile' );
	    Tcl_AddErrorInfo	:= GetCheck( 'Tcl_AddErrorInfo' );
        Tcl_BackgroundError	:= GetCheck( 'Tcl_BackgroundError' );
		Tcl_CreateCommand	:= GetCheck( 'Tcl_CreateCommand' );
		Tcl_DeleteCommand	:= GetCheck( 'Tcl_DeleteCommand' );
	    Tcl_CallWhenDeleted	:= GetCheck( 'Tcl_CallWhenDeleted' );
	    Tcl_DontCallWhenDeleted := GetCheck( 'Tcl_DontCallWhenDeleted' );
	    Tcl_CommandComplete	:= GetCheck( 'Tcl_CommandComplete' );
		Tcl_LinkVar	 		:= GetCheck( 'Tcl_LinkVar' );
		Tcl_UnlinkVar	 	:= GetCheck( 'Tcl_UnlinkVar' );
		Tcl_TraceVar	 	:= GetCheck( 'Tcl_TraceVar' );
		Tcl_TraceVar2	 	:= GetCheck( 'Tcl_TraceVar2' );
		Tcl_UntraceVar	 	:= GetCheck( 'Tcl_UntraceVar' );
		Tcl_UntraceVar2 	:= GetCheck( 'Tcl_UntraceVar2' );
		Tcl_GetVar		 	:= GetCheck( 'Tcl_GetVar' );
		Tcl_GetVar2	 		:= GetCheck( 'Tcl_GetVar2' );
		Tcl_SetVar		 	:= GetCheck( 'Tcl_SetVar' );
		Tcl_SetVar2	 		:= GetCheck( 'Tcl_SetVar2' );
		Tcl_UnsetVar	 	:= GetCheck( 'Tcl_UnsetVar' );
		Tcl_UnsetVar2	 	:= GetCheck( 'Tcl_UnsetVar2' );
		Tcl_SetResult	 	:= GetCheck( 'Tcl_SetResult' );
		Tcl_FirstHashEntry	:= GetCheck( 'Tcl_FirstHashEntry' );
		Tcl_NextHashEntry	:= GetCheck( 'Tcl_NextHashEntry' );
        Tcl_InitHashTable	:= GetCheck( 'Tcl_InitHashTable' );
		Tcl_StringMatch 	:= GetCheck( 'Tcl_StringMatch' );
		Tcl_GetHashKey	 	:= Get( TclModule, 'Tcl_GetHashKey' ); 	// Petitioning for function instead of macro  1/15/97
	    if @Tcl_GetHashKey = nil then
	    	Tcl_GetHashKey := _Tcl_GetHashKey;
	    Tcl_GetErrno		:= GetCheck( 'Tcl_GetErrno' );
	    Tcl_SetErrno		:= GetCheck( 'Tcl_SetErrno' );
	    Tcl_SetPanicProc	:= GetCheck( 'Tcl_SetPanicProc' );
	    Tcl_PkgProvide		:= GetCheck( 'Tcl_PkgProvide' );
	    Tcl_StaticPackage	:= GetCheck( 'Tcl_StaticPackage' );
		Tcl_CreateEventSource	:= GetCheck( 'Tcl_CreateEventSource' );
	    Tcl_DeleteEventSource	:= GetCheck( 'Tcl_DeleteEventSource' );
		Tcl_QueueEvent		:= GetCheck( 'Tcl_QueueEvent' );
		Tcl_SetMaxBlockTime	:= GetCheck( 'Tcl_SetMaxBlockTime' );
		Tcl_DeleteEvents	:= GetCheck( 'Tcl_DeleteEvents' );
		Tcl_DoOneEvent		:= GetCheck( 'Tcl_DoOneEvent' );
	    Tcl_DoWhenIdle		:= GetCheck( 'Tcl_DoWhenIdle' );
	    Tcl_CancelIdleCall	:= GetCheck( 'Tcl_CancelIdleCall' );
	    Tcl_CreateTimerHandler	:= GetCheck( 'Tcl_CreateTimerHandler' );
	    Tcl_DeleteTimerHandler	:= GetCheck( 'Tcl_DeleteTimerHandler' );
	//    Tcl_CreateModalTimeout	:= GetCheck( 'Tcl_CreateModalTimeout' ); v1.0 7/16/97 changes.txt
	//    Tcl_DeleteModalTimeout	:= GetCheck( 'Tcl_DeleteModalTimeout' ); v1.0 7/16/97
	    Tcl_SplitList       := GetCheck( 'Tcl_SplitList' ); // 3/3/97
	    Tcl_Merge           := GetCheck( 'Tcl_Merge' ); // 3/3/97
	    Tcl_Init            := GetCheck( 'Tcl_Init' ); // 3/3/97
	    Tcl_Free          := GetCheck( 'Tcl_Free' ); // 3/3/97
	//    Tcl_MallocEvent		:= GetCheck( 'Tcl_MallocEvent' ); dropped 1/15/97
	// provide for Tcl_Alloc alternative.
	//
	    Tcl_Alloc			:= Get( TclModule, 'Tcl_Alloc' );  // try newer lib v8.0, possibly v7.7
		if @Tcl_Alloc = nil then
	    begin
			SetLastError( 1 shl 28 );
	    	Tcl_Alloc := GetCheck( 'Tcl_MallocEvent' ); // might be using older tcl75w32.dll
	    end;

	    Tcl_DeleteAssocData		:= GetCheck( 'Tcl_DeleteAssocData' );
	    Tcl_GetAssocData		:= GetCheck( 'Tcl_GetAssocData' );
	    Tcl_SetAssocData		:= GetCheck( 'Tcl_SetAssocData' );
		Tcl_IsSafe				:= GetCheck( 'Tcl_IsSafe' );
		Tcl_MakeSafe			:= GetCheck( 'Tcl_MakeSafe' );
	    Tcl_CreateSlave			:= GetCheck( 'Tcl_CreateSlave' );
	    Tcl_GetSlave			:= GetCheck( 'Tcl_GetSlave' );
	    Tcl_GetMaster			:= GetCheck( 'Tcl_GetMaster' );
	    Tcl_GetInterpPath		:= GetCheck( 'Tcl_GetInterpPath' );
	    Tcl_CreateAlias			:= GetCheck( 'Tcl_CreateAlias' );
	    Tcl_GetAlias			:= GetCheck( 'Tcl_GetAlias' );
	    Tcl_ExposeCommand		:= GetCheck( 'Tcl_ExposeCommand' );
	    Tcl_HideCommand			:= GetCheck( 'Tcl_HideCommand' );
	    Tcl_EventuallyFree		:= GetCheck( 'Tcl_EventuallyFree' );
	    Tcl_Preserve			:= GetCheck( 'Tcl_Preserve' );
	    Tcl_Release				:= GetCheck( 'Tcl_Release' );
	    Tcl_InterpDeleted		:= GetCheck( 'Tcl_InterpDeleted' );
	    Tcl_GetCommandInfo		:= GetCheck( 'Tcl_GetCommandInfo' );
		Tcl_SetCommandInfo		:= GetCheck( 'Tcl_SetCommandInfo' );
		Tcl_FindExecutable		:= GetCheck( 'Tcl_FindExecutable' );
	    Tcl_GetStringResult		:= GetCheck( 'Tcl_GetStringResult' );
	    Tcl_FindCommand			:= GetCheck( 'Tcl_FindCommand' );
	    Tcl_DeleteCommandFromToken 	:= GetCheck( 'Tcl_DeleteCommandFromToken' );
	    Tcl_CreateNamespace		:= GetCheck( 'Tcl_CreateNamespace' );
	    Tcl_DeleteNamespace		:= GetCheck( 'Tcl_DeleteNamespace' );
	    Tcl_FindNamespace		:= GetCheck( 'Tcl_FindNamespace' );
	    Tcl_Export				:= GetCheck( 'Tcl_Export' );
	    Tcl_Import				:= GetCheck( 'Tcl_Import' );
	    Tcl_GetCurrentNamespace	:= GetCheck( 'Tcl_GetCurrentNamespace' );
	    Tcl_GetGlobalNamespace 	:= GetCheck( 'Tcl_GetGlobalNamespace' );
	    Tcl_PushCallFrame		:= GetCheck( 'Tcl_PushCallFrame' );
	    Tcl_PopCallFrame		:= GetCheck( 'Tcl_PopCallFrame' );

	    Tcl_RecordAndEval		:= GetCheck( 'Tcl_RecordAndEval' );
	    Tcl_GlobalEval			:= GetCheck( 'Tcl_GlobalEval' );
	    Tcl_DStringFree			:= GetCheck( 'Tcl_DStringFree' );
	    Tcl_DStringAppendElement:= GetCheck( 'Tcl_DStringAppendElement' );
	    Tcl_DStringAppend		:= GetCheck( 'Tcl_DStringAppend' );
	    Tcl_DStringInit			:= GetCheck( 'Tcl_DStringInit' );
	    Tcl_AppendResult		:= GetCheck( 'Tcl_AppendResult' );
		Tcl_SetStdChannel		:= GetCheck( 'Tcl_SetStdChannel' );
		Tcl_SetChannelOption	:= GetCheck( 'Tcl_SetChannelOption' );
	    Tcl_GetChannelOption	:= GetCheck( 'Tcl_GetChannelOption' );
		Tcl_CreateChannel		:= GetCheck( 'Tcl_CreateChannel' );
	    Tcl_RegisterChannel		:= GetCheck( 'Tcl_RegisterChannel' );
	    Tcl_UnregisterChannel	:= GetCheck( 'Tcl_UnregisterChannel' );
		Tcl_CreateChannelHandler:= GetCheck( 'Tcl_CreateChannelHandler' );
	    Tcl_CreateCloseHandler	:= GetCheck( 'Tcl_CreateCloseHandler' );
	    Tcl_DeleteCloseHandler	:= GetCheck( 'Tcl_DeleteCloseHandler' );
	    Tcl_GetChannel			:= GetCheck( 'Tcl_GetChannel' );
	    Tcl_GetStdChannel		:= GetCheck( 'Tcl_GetStdChannel' );
	    Tcl_Gets				:= GetCheck( 'Tcl_Gets' );
	    Tcl_Write				:= GetCheck( 'Tcl_Write' );
	    Tcl_Flush				:= GetCheck( 'Tcl_Flush' );
	    TclWinLoadLibrary		:= GetCheck( 'TclWinLoadLibrary' );
	    Tcl_CreateExitHandler	:= GetCheck( 'Tcl_CreateExitHandler');
	    Tcl_DeleteExitHandler	:= GetCheck( 'Tcl_DeleteExitHandler');
		Tcl_GetStringFromObj	:= GetCheck( 'Tcl_GetStringFromObj' );
		Tcl_CreateObjCommand	:= GetCheck( 'Tcl_CreateObjCommand' );
		Tcl_NewStringObj		:= GetCheck( 'Tcl_NewStringObj' );
        TclFreeObj				:= GetCheck( 'TclFreeObj' );
        Tcl_EvalObj				:= GetCheck( 'Tcl_EvalObj' );
        Tcl_GlobalEvalObj		:= GetCheck( 'Tcl_GlobalEvalObj' );
		TclRegComp				:= GetCheck( 'TclRegComp' );
		TclRegExec				:= GetCheck( 'TclRegExec' );
    	TclRegError				:= GetCheck( 'TclRegError' );
    	TclGetRegError			:= GetCheck( 'TclGetRegError' );
        Tcl_RegExpRange			:= GetCheck( 'Tcl_RegExpRange' );


		interp := Tcl_CreateInterp;
	    try
			str := strpas(Tcl_GetVar(interp, 'tcl_version', TCL_GLOBAL_ONLY or TCL_LEAVE_ERR_MSG));
		finally
	    	Tcl_DeleteInterp(interp);
	    end;

		p := pos('.',str);
	    TCL_VERSION_MAJOR := strtoint(copy(str,1,p-1));
	    str := copy(str,p+1,15);
	    p := pos('.',str);
	    if p > 0 then
		    TCL_VERSION_MINOR := strtointdef(copy(str,1,p-1),0)
	    else
	    	TCL_VERSION_MINOR := strtoint(str);
		CallTslcLibHook(thAfterTclLoad);
    finally
    	TslcLeaveCritical;
    end;
end;


procedure UnloadTcl;
var
	h: THandle;
begin
	TslcEnterCritical;
    try
	    CallTslcLibHook(thBeforeTclUnload);
		h := TclModule;
	    TclModule := 0;
		if h <> 0 then
	    	FreeLibrary( h );
		Tcl_Alloc				:= nil;
		Tcl_CreateInterp		:= nil;
		Tcl_DeleteInterp		:= nil;
	    Tcl_ResetResult			:= nil;
		Tcl_Eval  				:= nil;
	    Tcl_EvalFile			:= nil;
	    Tcl_AddErrorInfo		:= nil;
        Tcl_BackgroundError		:= nil;
		Tcl_CreateCommand		:= nil;
		Tcl_DeleteCommand		:= nil;
	    Tcl_CallWhenDeleted		:= nil;
	    Tcl_DontCallWhenDeleted	:= nil;
	    Tcl_CommandComplete		:= nil;
		Tcl_LinkVar	 			:= nil;
		Tcl_UnlinkVar			:= nil;
		Tcl_TraceVar			:= nil;
		Tcl_TraceVar2			:= nil;
		Tcl_UntraceVar			:= nil;
		Tcl_UntraceVar2 		:= nil;
		Tcl_GetVar				:= nil;
		Tcl_GetVar2	 			:= nil;
		Tcl_SetVar		 		:= nil;
		Tcl_SetVar2	 			:= nil;
		Tcl_UnsetVar			:= nil;
		Tcl_UnsetVar2			:= nil;
		Tcl_SetResult			:= nil;
		Tcl_FirstHashEntry		:= nil;
		Tcl_NextHashEntry		:= nil;
        Tcl_InitHashTable		:= nil;
		Tcl_StringMatch 		:= nil;
		Tcl_GetHashKey			:= nil;
	    Tcl_GetErrno			:= nil;
	    Tcl_SetErrno			:= nil;
	    Tcl_SetPanicProc		:= nil;
	    Tcl_PkgProvide			:= nil;
	    Tcl_StaticPackage		:= nil;
	//    Tcl_MallocEvent			:= nil;
	    Tcl_CreateEventSource	:= nil;
	    Tcl_DeleteEventSource	:= nil;
	    Tcl_QueueEvent			:= nil;
		Tcl_SetMaxBlockTime		:= nil;
	    Tcl_DeleteEvents		:= nil;
	    Tcl_DoOneEvent			:= nil;
	    Tcl_DoWhenIdle			:= nil;
	    Tcl_CancelIdleCall		:= nil;
	    Tcl_CreateTimerHandler	:= nil;
	    Tcl_DeleteTimerHandler	:= nil;
	    Tcl_CreateModalTimeout	:= nil;
	    Tcl_DeleteModalTimeout	:= nil;
	    Tcl_SplitList           := nil; // 3/3/97
	    Tcl_Merge               := nil; // 3/3/97
	    Tcl_Free                := nil; // 3/3/97
	    Tcl_Init                := nil; // 3/3/97
		Tcl_DeleteAssocData		:= nil;
	    Tcl_GetAssocData		:= nil;
	    Tcl_SetAssocData		:= nil;
	    Tcl_IsSafe				:= nil;
	    Tcl_MakeSafe			:= nil;
	    Tcl_CreateSlave			:= nil;
	    Tcl_GetSlave			:= nil;
	    Tcl_GetMaster			:= nil;
	    Tcl_GetInterpPath		:= nil;
	    Tcl_CreateAlias			:= nil;
	    Tcl_GetAlias			:= nil;
	    Tcl_ExposeCommand		:= nil;
	    Tcl_HideCommand			:= nil;
	    Tcl_EventuallyFree		:= nil;
	    Tcl_Preserve			:= nil;
	    Tcl_Release				:= nil;
	    Tcl_InterpDeleted		:= nil;
		Tcl_GetCommandInfo		:= nil;
	    Tcl_SetCommandInfo		:= nil;
	    Tcl_FindExecutable		:= nil;
	    Tcl_GetStringResult		:= nil;
	    Tcl_FindCommand			:= nil;
	    Tcl_DeleteCommandFromToken := nil;
	    Tcl_CreateNamespace		:= nil;
	    Tcl_DeleteNamespace		:= nil;
	    Tcl_FindNamespace		:= nil;
	    Tcl_Export				:= nil;
	    Tcl_Import				:= nil;
	    Tcl_GetCurrentNamespace	:= nil;
	    Tcl_GetGlobalNamespace	:= nil;
	    Tcl_PushCallFrame		:= nil;
	    Tcl_PopCallFrame		:= nil;
	    Tcl_RecordAndEval		:= nil;
	    Tcl_GlobalEval			:= nil;
	    Tcl_DStringFree			:= nil;
	    Tcl_DStringAppendElement:= nil;
	    Tcl_DStringAppend		:= nil;
	    Tcl_DStringInit			:= nil;
	    Tcl_AppendResult		:= nil;
		Tcl_SetStdChannel		:= nil;
		Tcl_SetChannelOption	:= nil;
	    Tcl_GetChannelOption	:= nil;
	    Tcl_CreateChannel		:= nil;
	    Tcl_RegisterChannel		:= nil;
	    Tcl_UnregisterChannel	:= nil;
		Tcl_CreateChannelHandler:= nil;
	    Tcl_CreateCloseHandler	:= nil;
	    Tcl_DeleteCloseHandler	:= nil;
	    Tcl_GetChannel			:= nil;
	    Tcl_GetStdChannel		:= nil;
	    Tcl_Gets				:= nil;
	    Tcl_Write				:= nil;
	    Tcl_Flush				:= nil;
	    TclWinLoadLibrary		:= nil;
	    Tcl_CreateExitHandler	:= nil;
	    Tcl_DeleteExitHandler	:= nil;
	    Tcl_GetStringFromObj	:= nil;
	    Tcl_CreateObjCommand 	:= nil;
        Tcl_NewStringObj		:= nil;
        TclFreeObj				:= nil;
        Tcl_EvalObj				:= nil;
        Tcl_GlobalEvalObj		:= nil;
		TclRegComp				:= nil;
		TclRegExec				:= nil;
    	TclRegError				:= nil;
    	TclGetRegError			:= nil;
        Tcl_RegExpRange			:= nil;
	    CallTslcLibHook(thAfterTclUnload);
    finally
    	TslcLeaveCritical;
    end;
end;

function TkLoaded(ALibPath: string): boolean;
begin
	if ALibPath = '' then
    	ALibPath := TkLibPath;
	result := InitializedTk or (GetModuleHandle(pChar(ALibPath)) <> 0);
end;


var
	DoUnloadTk: boolean;

procedure InitTk( ALibPath: string);
	function GetCheck(name: string ):FARPROC;
	begin
		result := Get(TkModule, name );
	    if result = nil then
    		raise Exception.CreateFmt('Unable to load Tk procedures from %s %s',[TkLibPath, name]);
	end;
begin
	if InitializedTk then
    	exit;
    TslcEnterCritical;
	try
    	CallTslcLibHook(thBeforeTkLoad);
		if ALibPath <> '' then TkLibPath := ALibPath;
{
	    TkModule := GetModuleHandle(pChar(TkLibPath));
	    DoUnloadTk := TkModule <> 0;
	    if TkModule = 0 then
	        if @TclWinLoadLibrary <> nil then
	        	TkModule := TclWinLoadLibrary(pChar(TkLibPath))
	        else
		    	TkModule := LoadLibrary(pChar(TkLibPath));
}

    	TkModule := LoadLibrary(pChar(TkLibPath));

	    if TkModule = 0 then
		   	raise Exception.CreateFmt('Unable to load Tk Library %s (%d)',[TkLibPath, GetLastError] );

		DoUnloadTk := True;

	    Tk_CreateEventHandler	:= GetCheck( 'Tk_CreateEventHandler' );
	    Tk_Init					:= GetCheck( 'Tk_Init' );
	    Tk_SafeInit				:= GetCheck( 'Tk_SafeInit' );
	    TkCreateMainWindow		:= GetCheck( 'TkCreateMainWindow' );
	    Tk_MainWindow			:= GetCheck( 'Tk_MainWindow' );
	    Tk_MakeWindowExist		:= GetCheck( 'Tk_MakeWindowExist' );
	    Tk_Main					:= GetCheck( 'Tk_Main' );
	    Tk_GetHINSTANCE			:= GetCheck( 'Tk_GetHINSTANCE' );
	    Tk_GetHWND				:= GetCheck( 'Tk_GetHWND' );
	    Tk_AttachHWND			:= GetCheck( 'Tk_AttachHWND' );
	    TkWinChildProc			:= GetCheck( 'TkWinChildProc' );
	    TkWmMapWindow			:= GetCheck( 'TkWmMapWindow' );
	    TkInstallFrameMenu		:= GetCheck( 'TkInstallFrameMenu' );
	    TkpWmSetState			:= GetCheck( 'TkpWmSetState' );
	    XMapWindow				:= GetCheck( 'XMapWindow' );
	    Tk_GeometryRequest		:= GetCheck( 'Tk_GeometryRequest' );
	    TkpGetOtherWindow		:= GetCheck( 'TkpGetOtherWindow' );
	    TkpMakeContainer		:= GetCheck( 'TkpMakeContainer' );
        Tk_GetNumMainWindows	:= GetCheck( 'Tk_GetNumMainWindows' );
        Tk_NameToWindow			:= GetCheck( 'Tk_NameToWindow' );
        Tk_HWNDToWindow			:= GetCheck( 'Tk_HWNDToWindow' );
		CallTslcLibHook(thAfterTkLoad);
    finally
    	TslcLeaveCritical;
    end;
end;

procedure UnloadTk;
begin
	TslcEnterCritical;
    try
		CallTslcLibHook(thBeforeTkUnload);
		if DoUnloadTk then
		begin
			if TkModule <> 0 then
		    	FreeLibrary(TkModule);
		    TkModule := 0;
		    Tk_CreateEventHandler	:= nil;
		    Tk_Init					:= nil;
		    Tk_SafeInit				:= nil;
		    TkCreateMainWindow		:= nil;
		    Tk_MainWindow			:= nil;
		    Tk_MakeWindowExist		:= nil;
		    Tk_Main					:= nil;
		    Tk_GetHINSTANCE			:= nil;
		    Tk_AttachHWND			:= nil;
		    Tk_GetHWND				:= nil;
		    TkWinChildProc			:= nil;
			TkWmMapWindow			:= nil;
		    TkInstallFrameMenu		:= nil;
		    TkpWmSetState			:= nil;
		    XMapWindow				:= nil;
		    Tk_GeometryRequest		:= nil;
		    TkpGetOtherWindow		:= nil;
		    TkpMakeContainer		:= nil;
            Tk_GetNumMainWindows	:= nil;
            Tk_HWNDToWindow			:= nil;
		    CallTslcLibHook(thAfterTkUnload);
		end;
	finally
    	TslcLeaveCritical;
    end;
end;

type
	pTslcLibHookInfo = ^TTslcLibHookInfo;
	TTslcLibHookInfo = record
    	proc: TTslcLibHookProc;
        clientData: pointer;
        kind: TTslcLibHookKind;
        next: pTslcLibHookInfo;
    end;

var
	TslcLibHookList: pTslcLibHookInfo = nil;
    NextHookInfo: pTslcLibHookInfo = nil;

procedure AddTslcLibHook(proc: TTslcLibHookProc; clientData: pointer; kind: TTslcLibHookKind);
var
	pHookInfo: pTslcLibHookInfo;
begin
	if @proc = nil then // you never know...
    	exit;
    TslcEnterCritical;
    try
	    new(pHookInfo);
    	pHookInfo^.next := TslcLibHookList;
	    pHookInfo^.proc := proc;
	    pHookInfo^.clientData := clientData;
	    pHookInfo^.kind := kind;
	    TslcLibHookList := pHookInfo;
    finally
    	TslcLeaveCritical;
    end;
end;

procedure RemoveTslcLibHook(proc: TTslcLibHookProc; clientData: pointer; kind: TTslcLibHookKind);
var
	pHookInfo, prev, next: pTslcLibHookInfo;
begin
	TslcEnterCritical;
    try
    	pHookInfo := TslcLibHookList;
	    prev := nil;
		while pHookInfo <> nil do
    	begin
	    	if (@pHookInfo^.proc = @proc) and (pHookInfo^.clientData = clientData) and (pHookInfo^.kind = kind) then
	        begin
	            if prev <> nil then
	            	prev^.next := next
	            else
	            	TslcLibHookList := next;
	            if NextHookInfo = pHookInfo then
	            	NextHookInfo := next;
				dispose(pHookInfo);
	            pHookInfo := next;
	        end else
	        begin
	        	prev := pHookInfo;
		        pHookInfo := pHookInfo^.next;
	        end;
		end;
    finally
    	TslcLeaveCritical;
    end;
end;

procedure CallTslcLibHook(kind: TTslcLibHookKind);
var
	pHookInfo: pTslcLibHookInfo;
begin
	TslcEnterCritical;
    try
	    pHookInfo := TslcLibHookList;
	    while pHookInfo <> nil do
	    begin
			NextHookInfo := pHookInfo^.next;
	       	if pHookInfo^.kind = kind then
	       		pHookInfo^.proc(pHookInfo^.clientData);
	        pHookInfo := NextHookInfo;
	    end;
    finally
    	TslcLeaveCritical;
    end;
end;

procedure FreeTslcLibHookList;
var
	pHookInfo, next: pTslcLibHookInfo;
begin
	pHookInfo := TslcLibHookList;
    TslcLibHookList := nil;
    while pHookInfo <> nil do
    begin
		next := pHookInfo^.next;
        dispose(pHookInfo);
        pHookInfo := next;
    end;
end;

procedure UnloadTclTk;
begin
	UnloadTk;
    UnloadTcl;
end;

initialization
	AddExitProc(UnloadTclTk);

finalization
	FreeTslcLibHookList;

end.

