Itcl - the [incr Tcl] extension

	* generic/itclMethod.c: again a fix for SF bug #244 to make it work
	correctly.
2014-02-18  Arnulf P. Wiedemann  <[email protected]>
	* tests/sfbugs.test: added a test file for bugs reported on SF incrtcl
	tracker.
2014-02-18  Arnulf P. Wiedemann  <[email protected]>
	* generic/itclResolve.c:
	* generic/itclObject.c: fix for upvar problem (SF bug #187) in 
	splitting up the trace handlers for this, win, type, self and selfns.
	Also doing traces for linked variables to one of these.
2014-02-16  Arnulf P. Wiedemann  <[email protected]>
	* generic/itclMethod.c:
	* generic/itclMigrate2TclCore.h:
	* generic/itclMigrate2TclCore.c: 2nd fix for uplevel problem (SF bug #250).
2014-02-13  Arnulf P. Wiedemann  <[email protected]>

	* generic/itcl.h:
	* configure, configure.in, Makefile.in: Bump version to 4.0b6

2010-09-26  Miguel Sofer  <[email protected]>

	* itcl/generic/itcl2TclOO.c (Itcl_NRRunCallbacks):
	Tcl's [Patch 3072080] (a saner NRE): TclNRRunCallbacks lost one
	argument. 

2010-08-22  Arnulf P.Wiedemann  <[email protected]>
        * itclInt.h, itclObject.c, itclInfo.c: fix for BiInfoHeritageCmd
	and BiInfoInheritCmd function, if we have no object context

2010-08-17  Jeff Hobbs  <[email protected]>

        * itclClass.c:          allow variable namespace to exist
2010-05-02  Arnulf P.Wiedemann  <[email protected]>
        * itclClass.c:		fix for SF bug #2993540
	* itcl2Tcloo.c:         fix for SF bug #2993648
	* itcl2Tcloo.h:         fix for SF bug #2993648
	* itclBuiltin.c:        added an empty line for beautifying
	* itclCmd.c:            in Itcl_IsObjectCmd if in constructor use the correct ioPtr
	* itclObject.c:         in Itcl_ObjectIsa check for contextIoPtr == NULL 
	                        to avoid segmentation violation
2010-04-21  Arnulf P.Wiedemann  <[email protected]>
	* itclCmd.c:		Add missing Tcl_DStringFree for [itcl Bug 2983809]
	* itclEnsemble.c:
	* itclObject.c:
	* itclParse.c:
	* itclResolve.c:

	* itclParse.c:          better error message when using: public mthod ... 
	                        instead of public method ...
2010-04-08  Don Porter  <[email protected]>
	* itclInt.h:		Add #ifdef guards to attempt inclusion of
				a unistd.h header file only where one exists.
2010-04-05  Don Porter  <[email protected]>
	* itclTclIntStubsFcn.c:	Remove attempt to return value from
				Itcl_ResetRewriteEnsemle() which is declared

	* itclClass.c:           fixed bug which prevented correct error
	                         reporting when there was a problem when
				 creating an object, also fixed to use correct
				 NRE calling

2009-10-23  Arnulf P. Wiedemann <[email protected]>
	* itclMigrate2TclCore.c: added Itcl_GetUplevelCallFrame and 
	                         Itcl_ActivateCallFrame functions
	                         same as in Itcl3.4. They are needed to call
				 the itk_component command with the suitable
				 call frame as this is needed for access to the
	                         proc local vars. This was the fix for SF 
				 bug #2840994
	* itclStubInit.c:
	* itcl.decls:
	* itclDecls.h:
	* itclIntDecls.h:

	* itclResolve.c:         added special_resolve_vars. Also needed

2009-03-19  Jeff Hobbs  <[email protected]>

	* generic/itclBase.c: reduce size of initScript to satisfy MSVC6.

2008-02-21 Arnulf P. Wiedemann <[email protected]>
        * fix for SF bug 2595708 itclParse.c and itclBuiltin.c
	* fix for problem with scope command path reported by 
	* Harald Krummeck on c.l.t ItclCmd.c
2008-02-02 Arnulf P. Wiedemann <[email protected]>
        * generic/itcl.h configure.in:
	             bumped version to 4.0b3
2008-02-01 Arnulf P. Wiedemann <[email protected]>
        * tests/widgetadaptor.test and tests/widgetclass.test:
	             removed package require Tk to avoid running the tests

	* generic/itclHelpers.c:here one can find all the *Dict*Info functions

	* library/ictlHullCmds.tcl:
				here are similar funtions to itclWidget.tcl for
				use by ::itcl::extendedclass

	* generic/itclUtil.c:	malloc.h include now bracketed with 
				#ifdef ITCL_PRESERVE_DEBUG as it is only used
				for debugging. I have to look for a solution
				using memory.h as a portable version, but
				for that I have to understand that first.
				With #ifdef ITCL_PRESERVE_DEBUG, the malloc
				and free calls can be used again, these are
				necessary, as im am checking stuff done by
				ckalloc and ckfree, so these cannot be used.
2009-01-15 David Gravereaux <[email protected]>
	* generic/itcl2TclOO.h:  More cleanups changing the last of the 
	* generic/itclClass.c:   'EXTERN' macros to just be 'extern' as we 
	* win/.cvsignore:        aren't importing the declaration, just  
	* win/itcl.rc:           sharing it internally.  This caused warnings 
	* win/makefile.vc:       on windows during the link stage as it was 
	* win/nmakehlp.c:        getting confused about 'why are you 
	* win/rules.vc:          importing an internal function?'
2009-01-15 David Gravereaux <[email protected]>
	* generic/itclMigrate2TclCore.h:    All build errors squashed
	* generic/itclStubLib.c:
	* generic/itclTclIntStubFcn.h:
	* win/makefile.vc:  
2009-01-14 David Gravereaux <[email protected]>
	* generic/itclBase.c:
	* generic/itclBuiltin.c:
	* generic/itclClass.c:
	* generic/itclCmd.c:
	* generic/itclEnsemble.c:
	* generic/itclHelpers.c:
	* generic/itclInfo.c:
	* generic/itclMethod.c:
	* generic/itclMigrate2TclCore.c:
	* generic/itclObject.c:
	* generic/itclParse.c:
	* generic/itclResolve.c
	* generic/itclStubs.c
	* generic/itclTclIntStubsFcn.c:
	* win/makefile.vc:
		Changes to allow compiling on windows with
		MSVC++.  Double declaration of internal 
		functions not yet repaired.  DOESN'T
		BUILD YET with makefile.vc.
2009-01-14 Daniel A. Steffen <[email protected]>
    * Makefile.in: fix itclConfig.sh install location to match TEA convention
    * aclocal.m4: match minimum autoconf requirement with TEA
    * configure: autoconf-2.59
    * generic/itclUtil.c: fix Mac OS X build failure (dkf) [Bug 2505545]
2008-12-11 Arnulf P. Wiedemann <[email protected]>
    * itcl-ng first beta release 4.0b1
2008-12-06 Arnulf P. Wiedemann <[email protected]>
    * built enhanced functions for chasing memory leaks in adding 
    * functionality to the functions available in Tcl core 
    * and fixed a lot of leaks of that class
2008-11-30 Arnulf P. Wiedemann <[email protected]>
    * built functions for chasing memory leaks and fixed a lot of those
2008-11-16 Arnulf P. Wiedemann <[email protected]>
    * second alpha release 4.0a1
2008-11-14 Arnulf P. Wiedemann <[email protected]>
    * 207 tests for snit like functionality running

		  PATH="$(EXTRA_PATH):$(PATH)" \
		  ITCL_LIBRARY=`@CYGPATH@ $(srcdir)/library` \
		  TCLLIBPATH="$(TCLLIBPATH)"

TCLSH_PROG	= @TCLSH_PROG@
TCLSH		= $(TCLSH_ENV) $(PKG_ENV) $(TCLSH_PROG)

TESTLOADARG = if {[catch {package present ${PACKAGE_NAME}}]} {package forget ${PACKAGE_NAME}; \
		    package ifneeded ${PACKAGE_NAME} ${PACKAGE_VERSION} \
			[list load `@CYGPATH@ $(top_builddir)/$(PKG_LIB_FILE)` $(PACKAGE_NAME)]}

#WISH_ENV	= TK_LIBRARY=`@CYGPATH@ $(TK_SRC_DIR)/library`
#WISH_PROG	= @WISH_PROG@
#WISH		= $(PKG_ENV) $(TCLSH_ENV) $(WISH_ENV) $(WISH_PROG)

SHARED_BUILD	= @SHARED_BUILD@
STUBS_BUILD	= @STUBS_BUILD@

shell: binaries libraries
	@$(TCLSH) $(SCRIPT)

gdb:
	$(TCLSH_ENV) $(PKG_ENV) $(GDB) $(TCLSH_PROG) $(SCRIPT)

gdb-test: binaries libraries 
	$(TCLSH_ENV) $(PKG_ENV) $(GDB) \
	    --args $(TCLSH_PROG) `@CYGPATH@ $(srcdir)/tests/all.tcl` \
	    $(TESTFLAGS) -singleproc 1 -load "$(TESTLOADARG)"

valgrind: binaries libraries
	$(TCLSH_ENV) $(PKG_ENV) $(VALGRIND) $(VALGRINDARGS) $(TCLSH_PROG) \
	    `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS)

README: Itcl

This is the 4.1.2 source distribution of Itcl, an object oriented
extension for Tcl. Itcl releases are available from Sourceforge at:

https://sourceforge.net/projects/incrtcl/files/%5Bincr%20Tcl_Tk%5D-4-source/

1. Introduction

This directory contains the source code, documentation, and test scripts
for the itcl extension. This version is the next major release to follow
Itcl 3.4.  This version claims to be script level compatible with Itcl 3.4.

Itcl is a freely-available open source package as in the past. 
You can do virtually anything you like with it, such as modifying it,
redistributing it, and selling it either in whole or in part.  See the file
"license.terms" for complete information.

2. Compiling and Installing.

Itcl is built in much the same way that Tcl itself is. Once you have

    # If the user did not set CFLAGS, set it now to keep macros
    # like AC_PROG_CC and AC_TRY_COMPILE from adding "-g -O2".
    if test "${CFLAGS+set}" != "set" ; then
	CFLAGS=""
    fi

    case "`uname -s`" in
	*win32*|*WIN32*|*MINGW32_*|*MINGW64_*)
	    # Extract the first word of "cygpath", so it can be a program name with args.
set dummy cygpath; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CYGPATH+:} false; then :
  $as_echo_n "(cached) " >&6
else

    # standard manufacturer compiler.

    if test "$GCC" = yes; then :

	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*|MINGW32_*|MINGW64_*) ;;
	    IRIX*) ;;
	    NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    windows) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac

AC_CHECK_TYPE([intptr_t], [
    AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
    for tcl_cv_intptr_t in "int" "long" "long long" none; do
	if test "$tcl_cv_intptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])], 
		[tcl_ok=yes], [tcl_ok=no])
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_intptr_t" != none; then
	AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer
	   type wide enough to hold a pointer.])
    fi

.CS
itcl::class Toaster {
    variable crumbs 0
    method toast {nslices} {
        if {$crumbs > 50} {
            error "== FIRE! FIRE! =="
        }
        set crumbs [expr $crumbs+4*$nslices]
    }
    method clean {} {
        set crumbs 0
    }
}
.CE
.PP

'\"
'\" Copyright (c) 1993-1998  Lucent Technologies, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
.TH ensemble n 3.0 itcl "[incr\ Tcl]"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
itcl::ensemble \- create or modify a composite command
.SH SYNOPSIS

\fBis class \fIcommand\fR
.
Returns 1 if command is a class, and returns 0 otherwise.
.RS
.PP
The fully qualified name of the class needs to be given as the \fIcommand\fR
argument. So, if a class resides in a namespace, then the namespace needs to
be specified as well. So, if a class \fBC\fR resides in a namespace \fBN\fR, then 
the command should be called like:
.PP
.CS
\fBis N::C\fR
    or
\fBis ::N::C\fR
.CE

The optional \fBas\fR clause allows you to specify the delegated method
name and possibly add some arguments:
.PP
.CS
delegate method wagtail to tail as "wag briskly"
.CE
.PP
A method cannot be both locally defined and delegated. 
.RE
.TP
\fBdelegate method \fImethodName\fR ?\fBto \fIcomponentName\fR? \fBusing \fIpattern\fR
.
In this form of the delegate statement, the \fBusing\fR clause is used to
specify the precise form of the command to which method name name is delegated.
The \fBto\fR clause is optional, since the chosen command might not involve
any particular component.
.RS
.PP
The value of the using clause is a list that may contain any or all of the
following substitution codes; these codes are substituted with the described
value to build the delegated command prefix. Note that the following two
statements are equivalent:
.PP
.CS
delegate method wag to tail
delegate method wag to tail using "%c %m"
.CE
.PP
Each element of the list becomes a single element of the delegated command 
--it is never reparsed as a string.
.PP
Substitutions:
.TP
\fB%%\fR
.
This is replaced with a single "%". Thus, to pass the string "%c" to the
command as an argument, you'd write "%%c".
.TP
\fB%c\fR
.
This is replaced with the named component's command. 
.TP
\fB%j\fR
.
This is replaced by the method name; if the name consists of multiple tokens,
they are joined by underscores ("_").
.TP
\fB%m\fR

.TP
\fB%n\fR
.
This is replaced with the name of the instance's private namespace.
.TP
\fB%s\fR
.
This is replaced with the name of the instance command. 
.TP
\fB%t\fR
.
This is replaced with the fully qualified type name. 
.TP
\fB%w\fR
.
This is replaced with the original name of the instance command; for Itcl
widgets and widget adaptors, it will be the Tk window name. It remains
constant, even if the instance command is renamed.
.RE

is "*", as in the following example:
.PP
.CS
delegate method {tail *} to tail
.CE
.PP
This implicitly defines the method tail whose subcommands will be
delegated to the tail component. 
.PP
The definitions for \fBdelegate proc\fR ... are the same as for method,
the only difference being, that this is for procs.
.RE
.TP
\fBdelegate option \fInamespec\fB to \fIcomp\fR
.TP

.CS
itcl::extendedclass Toaster {
    variable crumbs 0
    method toast {nslices} {
        if {$crumbs > 50} {
            error "== FIRE! FIRE! =="
        }
        set crumbs [expr $crumbs+4*$nslices]
    }
    method clean {} {
        set crumbs 0
    }
}
.CE
.PP

subtle errors.
.PP
The option statement may include the following options:
.TP
\fB-default\fI defvalue\fR
.
Defines the option's default value; the option's default value will be ""
otherwise. 
.TP
\fB-readonly\fR
.
The option is handled read-only -- it can only be set using configure at
creation time, i.e., in the type's constructor. 
.TP
\fB-cgetmethod\fI methodName\fR
.
Every locally-defined option may define a -cgetmethod; it is called when the
option's value is retrieved using the cget method. Whatever the method's body
returns will be the return value of the call to cget.
.RS
.PP
The named method must take one argument, the option name. For example, this
code is equivalent to (though slower than) Itcl's default handling of cget:
.PP
.CS
        option -font -cgetmethod GetOption
        method GetOption {option} {
            return $itcl_options($option)
        }
.CE
.PP
Note that it's possible for any number of options to share a -cgetmethod. 
.RE
.TP
\fB-cgetmethodvar\fI varName\fR
.
That is very similar to -cgetmethod, the only difference is, one can define
a variable, where to find the cgetmethod during runtime.
.TP

.CS
        option -font -configuremethod SetOption
        method SetOption {option value} {
            set itcl_options($option) $value
        }
.CE
.PP
Note that it's possible for any number of options to share a single -configuremethod. 
.RE
.TP
\fB-configuremethodvar\fI varName\fR
.
That is very similar to -configuremethod, the only difference is, one can define
a variable, where to find the configuremethod during runtime.
.TP

        method CheckBoolean {option value} {
            if {![string is boolean -strict $value]} {
                error "option $option must have a boolean value."
            }
        }
.CE
.PP
Note that it's possible for any number of options to share a single -validatemethod. 
.RE
.TP
\fB-validatemethodvar\fI varName\fR
.
That is very similar to -validatemethod, the only difference is, one can define
a variable, where to find the validatemethod during runtime.

.SH KEYWORDS
option, widget, widgetadaptor, extendedclass

.CS
itcl::widget Toaster {
    variable crumbs 0
    method toast {nslices} {
        if {$crumbs > 50} {
            error "== FIRE! FIRE! =="
        }
        set crumbs [expr $crumbs+4*$nslices]
    }
    method clean {} {
        set crumbs 0
    }
}
.CE
.PP

.BE

.SH DESCRIPTION
.PP
Creates a scoped value for the specified \fIname\fR, which must
be a variable name.  If the \fIname\fR is an instance variable,
then the scope command returns a name which will resolve in any
context as an instance variable belonging to \fIobject\fR.  
The precise format of this name is an internal detail to Itcl.
Use of such a scoped value makes it possible to use
instance variables in conjunction with widgets.  For example, if you
have an object with a private variable \fCx\fR, and you can use
\fCx\fR in conjunction with the \fC-textvariable\fR option of an
entry widget.  Before itcl3.0, only common variables could be used
in this manner.

	ItclMemberFunc **mfuncPtr)
}
declare 55 {
    int Itcl_ChangeMemberFunc(Tcl_Interp *interp, ItclMemberFunc *mfunc,
        const char *arglist, const char *body)
}
declare 56 {
    void Itcl_DeleteMemberFunc(char *cdata)
}
declare 57 {
    int Itcl_CreateMemberCode(Tcl_Interp *interp, ItclClass *iclsPtr, \
        const char *arglist, const char *body, ItclMemberCode **mcodePtr)
}
declare 58 {
    void Itcl_DeleteMemberCode(char *cdata)
}
declare 59 {
    int Itcl_GetMemberCode(Tcl_Interp *interp, ItclMemberFunc *mfunc)
}
declare 61 {
    int Itcl_EvalMemberCode(Tcl_Interp *interp, ItclMemberFunc *mfunc,
        ItclObject *contextObj, int objc, Tcl_Obj *const objv[])


/*
 * Include all the public API, generated from itcl.decls.
 */

#include "itclDecls.h"

#ifdef ITCL_PRESERVE_DEBUG
#undef Itcl_PreserveData
#undef Itcl_ReleaseData
void ItclDbgPreserveData(ClientData cdata, int line, const char *file);
void ItclDbgReleaseData(ClientData cdata, int line, const char *file);
#define Itcl_PreserveData(addr) ItclDbgPreserveData(addr, __LINE__, __FILE__)
#define Itcl_ReleaseData(addr) ItclDbgReleaseData(addr, __LINE__, __FILE__)
#endif

#endif /* RC_INVOKED */

/*
 * end block for C++
 */

#ifdef __cplusplus

/*
 * itcl2TclOO.c --
 *
 *	This file contains code to create and manage methods.
 *
 * Copyright (c) 2007 by Arnulf P. Wiedemann
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <tclInt.h>
#include <tclOOInt.h>



#include "itclInt.h"

void *
Itcl_GetCurrentCallbackPtr(
    Tcl_Interp *interp)
{
    return TOP_CB(interp);
}

int
Itcl_NRRunCallbacks(
    Tcl_Interp *interp,
    void *rootPtr)
{
    return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}

static int
CallFinalizePMCall(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Namespace *nsPtr = data[0];
    TclOO_PostCallProc *postCallProc = (TclOO_PostCallProc *)data[1];
    ClientData clientData = data[2];

    /*
     * Give the post-call callback a chance to do some cleanup. Note that at
     * this point the call frame itself is invalid; it's already been popped.
     */

    return postCallProc(clientData, interp, NULL, nsPtr, result);
}

static int
FreeCommand(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Command *cmdPtr = data[0];
    Proc *procPtr = data[1];

    ckfree(cmdPtr);
    procPtr->cmdPtr = NULL;

    return result;
}

    Proc *procPtr = pmPtr->procPtr;
    CallFrame *framePtr = NULL;
    CallFrame **framePtrPtr1 = &framePtr;
    Tcl_CallFrame **framePtrPtr = (Tcl_CallFrame **)framePtrPtr1;
    int result;

    if (procPtr->cmdPtr == NULL) {
	Command *cmdPtr = ckalloc(sizeof(Command));

	memset(cmdPtr, 0, sizeof(Command));
	cmdPtr->nsPtr = (Namespace *) nsPtr;
	cmdPtr->clientData = NULL;
	procPtr->cmdPtr = cmdPtr;
	Tcl_NRAddCallback(interp, FreeCommand, cmdPtr, procPtr, NULL, NULL);
    }

     * Now invoke the body of the method. Note that we need to take special
     * action when doing unknown processing to ensure that the missing method
     * name is passed as an argument.
     */

    if (pmPtr->postCallProc) {
	Tcl_NRAddCallback(interp, CallFinalizePMCall, nsPtr,
		(Tcl_NRPostProc *)pmPtr->postCallProc, pmPtr->clientData, NULL);
    }
    return TclNRInterpProcCore(interp, namePtr, 1, pmPtr->errProc);

done:
    return result;
}

int
Itcl_InvokeProcedureMethod(
    ClientData clientData,	/* Pointer to some per-method context. */
    Tcl_Interp *interp,
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
{
    Tcl_Namespace *nsPtr;
    Method *mPtr;

    mPtr = clientData;
    if (mPtr->declaringClassPtr == NULL) {
	/* that is the case for typemethods */
        nsPtr = mPtr->declaringObjectPtr->namespacePtr;
    } else {
        nsPtr = mPtr->declaringClassPtr->thisPtr->namespacePtr;
    }

    return Tcl_InvokeClassProcedureMethod(interp, mPtr->namePtr, nsPtr,
            mPtr->clientData, objc, objv);
}

static int
FreeProcedureMethod(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ProcedureMethod *pmPtr = data[0];
    ckfree(pmPtr);
    return result;
}

static void
EnsembleErrorProc(
    Tcl_Interp *interp,

    Tcl_Interp *interp,
    Tcl_Namespace *nsPtr,       /* namespace to call the method in */
    Tcl_Obj *namePtr,           /* name of the method */
    Tcl_Proc *procPtr,
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
{
    ProcedureMethod *pmPtr = ckalloc(sizeof(ProcedureMethod));

    memset(pmPtr, 0, sizeof(ProcedureMethod));
    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
    pmPtr->procPtr = (Proc *)procPtr;
    pmPtr->flags = USE_DECLARER_NS;
    pmPtr->errProc = EnsembleErrorProc;

 *	function that does call chain creation, management and invokation.
 *
 * ----------------------------------------------------------------------
 */

int
Itcl_PublicObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_Class clsPtr,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Object oPtr = (Tcl_Object)clientData;
    int result;

Tcl_Method
Itcl_NewProcClassMethod(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Tcl_Class clsPtr,		/* The class to modify. */
    TclOO_PreCallProc *preCallPtr,
    TclOO_PostCallProc *postCallPtr,
    ProcErrorProc *errProc,
    ClientData clientData,
    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
				 * if so, up to caller to manage storage
				 * (e.g., because it is a constructor or
				 * destructor). */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which may be NULL; if so, it is equivalent
				 * to an empty list. */
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    ClientData *clientData2)
{
    Tcl_Method result;

    result = TclOONewProcMethodEx(interp, clsPtr, preCallPtr, postCallPtr,
           errProc, clientData, nameObj, argsObj, bodyObj,
           PUBLIC_METHOD | USE_DECLARER_NS, clientData2);
    return result;

Tcl_Method
Itcl_NewProcMethod(
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    Tcl_Object oPtr,		/* The object to modify. */
    TclOO_PreCallProc *preCallPtr,
    TclOO_PostCallProc *postCallPtr,
    ProcErrorProc *errProc,
    ClientData clientData,
    Tcl_Obj *nameObj,		/* The name of the method, which must not be
				 * NULL. */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which must not be NULL. */
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    ClientData *clientData2)
{
    return TclOONewProcInstanceMethodEx(interp, oPtr, preCallPtr, postCallPtr,
           errProc, clientData, nameObj, argsObj, bodyObj,
           PUBLIC_METHOD | USE_DECLARER_NS, clientData2);
}

/*

    Tcl_IncrRefCount(namePtr);
    oPtr->cachedNameObj = namePtr;
    return namePtr;
}

int
Itcl_SelfCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    CallContext *contextPtr;

    if (!Itcl_IsMethodCallFrame(interp)) {
        Tcl_AppendResult(interp, TclGetString(objv[0]),
                " may only be called from inside a method", NULL);
        return TCL_ERROR;
    }

    contextPtr = framePtr->clientData;

    if (objc == 1) {
        Tcl_SetObjResult(interp, Itcl_TclOOObjectName(interp, contextPtr->oPtr));
        return TCL_OK;
    }
    return TCL_ERROR;
}

 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <stdlib.h>
#include "itclInt.h"

static Tcl_ObjCmdProc ItclFinishCmd;
static Tcl_ObjCmdProc ItclSetHullWindowName;
static Tcl_ObjCmdProc ItclCheckSetItclHull;

#ifdef ITCL_PRESERVE_DEBUG
static Tcl_ObjCmdProc ItclDumpPreserveInfo;
#endif

MODULE_SCOPE const ItclStubs itclStubs;

static int Initialize(Tcl_Interp *interp);

static const char initScript[] =
"namespace eval ::itcl {\n"
"    proc _find_init {} {\n"

"    ::tailcall ::itcl::parser::handleClass [::lindex [::info level 0] 0] [self] {*}$args\n"
"  }\n"
"  unexport create new unknown\n"
"}";

#define ITCL_IS_ENSEMBLE 0x1

typedef struct ItclCmdsInfo {
    const char *name;
    int flags;
} ItclCmdsInfo;
static ItclCmdsInfo itclCmds [] = {
    { "::itcl::class", 0},
    { "::itcl::find", ITCL_IS_ENSEMBLE},
    { "::itcl::delete", ITCL_IS_ENSEMBLE},
    { "::itcl::is", ITCL_IS_ENSEMBLE},
    { "::itcl::filter", ITCL_IS_ENSEMBLE},
    { "::itcl::forward", ITCL_IS_ENSEMBLE},
    { "::itcl::import::stub", ITCL_IS_ENSEMBLE},
    { "::itcl::mixin", ITCL_IS_ENSEMBLE},
    { "::itcl::parser::delegate", ITCL_IS_ENSEMBLE},
    { "::itcl::type", 0},
    { "::itcl::widget", 0},
    { "::itcl::widgetadaptor", 0},
    { "::itcl::nwidget", 0},
    { "::itcl::addoption", 0},
    { "::itcl::addobjectoption", 0},
    { "::itcl::adddelegatedoption", 0},
    { "::itcl::adddelegatedmethod", 0},
    { "::itcl::addcomponent", 0},
    { "::itcl::setcomponent", 0},
    { "::itcl::extendedclass", 0},
    { "::itcl::parser::delegate", ITCL_IS_ENSEMBLE},
    { NULL, 0},
};
#ifdef ITCL_DEBUG_C_INTERFACE
extern void RegisterDebugCFunctions( Tcl_Interp * interp);
#endif

static Tcl_ObjectMetadataDeleteProc Demolition;

static const Tcl_ObjectMetadataType canary = {
    TCL_OO_METADATA_VERSION_CURRENT,
    "Itcl Foundations",
    Demolition,
    NULL
};

void
Demolition(
    ClientData clientData)
{
    ItclObjectInfo *infoPtr = (ItclObjectInfo *)clientData;

    infoPtr->clazzObjectPtr = NULL;
    infoPtr->clazzClassPtr = NULL;
}

    RootCallProc,
    NULL,
    NULL
};

static int
RootCallProc(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Object oPtr = Tcl_ObjectContextObject(context);
    ItclObject *ioPtr = Tcl_ObjectGetMetadata(oPtr, &objMDT);
    ItclRootMethodProc *proc = (ItclRootMethodProc *)clientData;

    return (*proc)(ioPtr, interp, objc, objv);
}

/*
 * ------------------------------------------------------------------------
 *  FreeItclObjectInfo()
 *
 *  called when an interp is deleted to free up memory
 *
 * ------------------------------------------------------------------------
 */
static void
FreeItclObjectInfo(
    ClientData clientData)
{
    ItclObjectInfo *infoPtr;

    infoPtr = (ItclObjectInfo *)clientData;
    ItclFinishCmd(infoPtr, infoPtr->interp, 0, NULL);
}

/*
 * ------------------------------------------------------------------------
 *  Initialize()
 *
 *      that is the starting point when loading the library
 *      it initializes all internal stuff

    clazzObjectPtr = Tcl_GetObjectFromObj(interp, objPtr);
    if (!clazzObjectPtr || !(tclCls = Tcl_GetObjectAsClass(clazzObjectPtr))) {
	Tcl_DecrRefCount(objPtr);
        return TCL_ERROR;
    }
    Tcl_DecrRefCount(objPtr);

    infoPtr = (ItclObjectInfo*)ItclCkalloc(sizeof(ItclObjectInfo), NULL);

    nsPtr = Tcl_CreateNamespace(interp, ITCL_NAMESPACE, infoPtr, FreeItclObjectInfo);
    if (nsPtr == NULL) {
	ckfree(infoPtr);
        Tcl_Panic("Itcl: cannot create namespace: \"%s\" \n", ITCL_NAMESPACE);
    }

    nsPtr = Tcl_CreateNamespace(interp, ITCL_INTDICTS_NAMESPACE,
            NULL, NULL);
    if (nsPtr == NULL) {
	ckfree(infoPtr);
        Tcl_Panic("Itcl: cannot create namespace: \"%s::internal::dicts\" \n",
	        ITCL_NAMESPACE);
    }

    Tcl_CreateObjCommand(interp, ITCL_NAMESPACE"::finish", ItclFinishCmd,
            NULL, NULL);

    /* for debugging only !!! */
#ifdef ITCL_PRESERVE_DEBUG
    Tcl_CreateObjCommand(interp,
            ITCL_NAMESPACE"::dumppreserveinfo",
            ItclDumpPreserveInfo, NULL, NULL);
#endif
    /* END for debugging only !!! */

    /*
     *  Create the top-level data structure for tracking objects.
     *  Store this as "associated data" for easy access, but link
     *  it to the itcl namespace for ownership.
     */
    memset(infoPtr, 0, sizeof(ItclObjectInfo));
    infoPtr->interp = interp;
    infoPtr->class_meta_type = (Tcl_ObjectMetadataType *)ckalloc(
            sizeof(Tcl_ObjectMetadataType));
    infoPtr->class_meta_type->version = TCL_OO_METADATA_VERSION_CURRENT;
    infoPtr->class_meta_type->name = "ItclClass";
    infoPtr->class_meta_type->deleteProc = ItclDeleteClassMetadata;
    infoPtr->class_meta_type->cloneProc = NULL;

    infoPtr->object_meta_type = &objMDT;

    Tcl_InitHashTable(&infoPtr->objects, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&infoPtr->objectCmds, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&infoPtr->classes, TCL_ONE_WORD_KEYS);
    Tcl_InitObjHashTable(&infoPtr->nameClasses);
    Tcl_InitHashTable(&infoPtr->namespaceClasses, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&infoPtr->procMethods, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&infoPtr->instances, TCL_STRING_KEYS);
    Tcl_InitHashTable(&infoPtr->frameContext, TCL_ONE_WORD_KEYS);
    Tcl_InitObjHashTable(&infoPtr->classTypes);
    infoPtr->activeHash = 1;

    infoPtr->ensembleInfo = (EnsembleInfo *)ckalloc(sizeof(EnsembleInfo));
    memset(infoPtr->ensembleInfo, 0, sizeof(EnsembleInfo));
    Tcl_InitHashTable(&infoPtr->ensembleInfo->ensembles, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&infoPtr->ensembleInfo->subEnsembles, TCL_ONE_WORD_KEYS);
    infoPtr->ensembleInfo->numEnsembles = 0;
    infoPtr->protection = ITCL_DEFAULT_PROTECT;

	opt = 1;
    } else {
	opt = atoi(res_option);
    }
    infoPtr->useOldResolvers = opt;
    Itcl_InitStack(&infoPtr->clsStack);

    Tcl_SetAssocData(interp, ITCL_INTERP_DATA, NULL, (ClientData)infoPtr);

    Itcl_PreserveData((ClientData)infoPtr);

    root = Tcl_NewObjectInstance(interp, tclCls, "::itcl::Root",
	    NULL, 0, NULL, 0);

    Tcl_NewMethod(interp, Tcl_GetObjectAsClass(root),
	    Tcl_NewStringObj("unknown", -1), 0, &itclRootMethodType,
	    ItclUnknownGuts);
    Tcl_NewMethod(interp, Tcl_GetObjectAsClass(root),
	    Tcl_NewStringObj("ItclConstructBase", -1), 0,
	    &itclRootMethodType, ItclConstructGuts);
    Tcl_NewMethod(interp, Tcl_GetObjectAsClass(root),
	    Tcl_NewStringObj("info", -1), 1,
	    &itclRootMethodType, ItclInfoGuts);

    /* first create the Itcl base class as root of itcl classes */
    if (Tcl_EvalEx(interp, clazzClassScript, -1, 0) != TCL_OK) {
        Tcl_Panic("cannot create Itcl root class ::itcl::clazz");
    }
    resPtr = Tcl_GetObjResult(interp);
    /*

        return TCL_ERROR;
    }

    /*
     *  Export all commands in the "itcl" namespace so that they
     *  can be imported with something like "namespace import itcl::*"
     */
    itclNs = Tcl_FindNamespace(interp, "::itcl", (Tcl_Namespace*)NULL,
        TCL_LEAVE_ERR_MSG);

    /*
     *  This was changed from a glob export (itcl::*) to explicit
     *  command exports, so that the itcl::is command can *not* be
     *  exported. This is done for concern that the itcl::is command
     *  imported might be confusing ("is").

    Tcl_SetVar2(interp, "::itcl::version", NULL, ITCL_VERSION, TCL_NAMESPACE_ONLY);
    Tcl_SetVar2(interp, "::itcl::patchLevel", NULL, ITCL_PATCH_LEVEL,
            TCL_NAMESPACE_ONLY);


#ifdef ITCL_DEBUG_C_INTERFACE
    RegisterDebugCFunctions(interp);
#endif    
    /*
     *  Package is now loaded.
     */

    Tcl_PkgProvideEx(interp, "Itcl", ITCL_PATCH_LEVEL, &itclStubs);
    return Tcl_PkgProvideEx(interp, "itcl", ITCL_PATCH_LEVEL, &itclStubs);
}

 *  ItclSetHullWindowName()
 *
 *
 * ------------------------------------------------------------------------
 */
static int
ItclSetHullWindowName(
    ClientData clientData,   /* infoPtr */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclObjectInfo *infoPtr;

    infoPtr = (ItclObjectInfo *)clientData;

 *  ItclCheckSetItclHull()
 *
 *
 * ------------------------------------------------------------------------
 */
static int
ItclCheckSetItclHull(
    ClientData clientData,   /* infoPtr */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_HashEntry *hPtr;
    Tcl_Obj *objPtr;
    ItclObject *ioPtr;
    ItclVariable *ivPtr;
    ItclObjectInfo *infoPtr;
    const char *valueStr;

    if (objc < 3) {
        Tcl_AppendResult(interp, "ItclCheckSetItclHull wrong # args should be ",
	        "<objectName> <value>", NULL);
	return TCL_ERROR;
    }

    /* 
     * This is an internal command, and is never called with an
     * objectName value other than the empty list. Check that with
     * an assertion so alternative handling can be removed.
     */
    assert( strlen(Tcl_GetString(objv[1])) == 0);
    infoPtr = (ItclObjectInfo *)clientData;
    {

    hPtr = Tcl_FindHashEntry(&ioPtr->iclsPtr->variables, (char *)objPtr);
    Tcl_DecrRefCount(objPtr);
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "ItclCheckSetItclHull cannot find itcl_hull",
	        " variable for object \"", Tcl_GetString(objv[1]), "\"", NULL);
	return TCL_ERROR;
    }
    ivPtr = Tcl_GetHashValue(hPtr);
    valueStr = Tcl_GetString(objv[2]);
    if (strcmp(valueStr, "2") == 0) {
        ivPtr->initted = 2;
    } else {
        if (strcmp(valueStr, "0") == 0) {
            ivPtr->initted = 0;
	} else {
            Tcl_AppendResult(interp, "ItclCheckSetItclHull bad value \"",
	            valueStr, "\"", NULL);
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclFinishCmd()
 *
 *  called when an interp is deleted to free up memory or called explicitly
 *  to check memory leaks
 *
 * ------------------------------------------------------------------------
 */
static int
ItclFinishCmd(
    ClientData clientData,   /* unused */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch place;
    Tcl_Namespace *nsPtr;
    Tcl_Obj **newObjv;
    Tcl_Obj *objPtr;
    Tcl_Obj *ensObjPtr;
    Tcl_Command cmdPtr;
    ItclObjectInfo *infoPtr;
    ItclCmdsInfo *iciPtr;
    int i;

    Itcl_InterpState state = Itcl_SaveInterpState(interp, TCL_OK);

    ItclShowArgs(1, "ItclFinishCmd", objc, objv);
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    if (infoPtr == NULL) {
        infoPtr = (ItclObjectInfo *)clientData;
    }
    newObjv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * 2);
    newObjv[0] = Tcl_NewStringObj("my", -1);;
    for (i = 0; ;i++) {
        iciPtr = &itclCmds[i];
        if (iciPtr->name == NULL) {
	    break;
	}
	if ((iciPtr->flags & ITCL_IS_ENSEMBLE) == 0) {
            Itcl_RenameCommand(interp, iciPtr->name, "");
	} else {
	    objPtr = Tcl_NewStringObj(iciPtr->name, -1);
            newObjv[1] = objPtr;
	    Itcl_EnsembleDeleteCmd(infoPtr, infoPtr->interp, 2, newObjv);
	    Tcl_DecrRefCount(objPtr);
	}
        iciPtr++;
    }
    Tcl_DecrRefCount(newObjv[0]);
    ckfree((char *)newObjv);

    /* remove the unknown handler, to free the reference to the
     * Tcl_Obj with the name of it */
    ensObjPtr = Tcl_NewStringObj("::itcl::builtin::Info::delegated", -1);
    cmdPtr = Tcl_FindEnsemble(interp, ensObjPtr, 0);
    if (cmdPtr != NULL) {
        Tcl_SetEnsembleUnknownHandler(NULL, cmdPtr, NULL);
    }
    Tcl_DecrRefCount(ensObjPtr);

if (infoPtr->activeHash) {
    while (1) {
        hPtr = Tcl_FirstHashEntry(&infoPtr->instances, &place);
	if (hPtr == NULL) {
	    break;
	}
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&infoPtr->instances);

    while (1) {
        hPtr = Tcl_FirstHashEntry(&infoPtr->classTypes, &place);
	if (hPtr == NULL) {
	    break;
	}
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&infoPtr->classTypes);

    Tcl_DeleteHashTable(&infoPtr->procMethods);

    Tcl_DeleteHashTable(&infoPtr->objectCmds);
    Tcl_DeleteHashTable(&infoPtr->classes);
    Tcl_DeleteHashTable(&infoPtr->nameClasses);
    Tcl_DeleteHashTable(&infoPtr->namespaceClasses);
    infoPtr->activeHash = 0;
}

    nsPtr = Tcl_FindNamespace(interp, "::itcl::parser", NULL, 0);
    if (nsPtr != NULL) {
        Tcl_DeleteNamespace(nsPtr);
    }

    ensObjPtr = Tcl_NewStringObj("::itcl::builtin::Info", -1);
    if (Tcl_FindNamespace(interp, Tcl_GetString(ensObjPtr), NULL, 0) != NULL) {
        Tcl_SetEnsembleUnknownHandler(NULL,
                Tcl_FindEnsemble(interp, ensObjPtr, TCL_LEAVE_ERR_MSG),
	        NULL);
    }
    Tcl_DecrRefCount(ensObjPtr);

    /* remove the vars entry from the info dict */
    /* and replace it by the original one */
if (infoPtr->infoVarsPtr) {
    cmdPtr = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
    if (cmdPtr != NULL && Tcl_IsEnsemble(cmdPtr)) {
	Tcl_Obj *mapDict = NULL;
        Tcl_GetEnsembleMappingDict(NULL, cmdPtr, &mapDict);
        if (mapDict != NULL) {
	    Tcl_DictObjRemove(interp, mapDict, infoPtr->infoVars4Ptr);
	    Tcl_DictObjPut(interp, mapDict, infoPtr->infoVars4Ptr,
		    infoPtr->infoVarsPtr);
	    Tcl_SetEnsembleMappingDict(interp, cmdPtr, mapDict);
        }
    }
}
    if (infoPtr->infoVarsPtr) {
	Tcl_DecrRefCount(infoPtr->infoVarsPtr);
	infoPtr->infoVarsPtr = NULL;
    }
    if (infoPtr->infoVars3Ptr) {
	Tcl_DecrRefCount(infoPtr->infoVars3Ptr);
	infoPtr->infoVars3Ptr = NULL;
    }
    if (infoPtr->infoVars4Ptr) {
	Tcl_DecrRefCount(infoPtr->infoVars4Ptr);
	infoPtr->infoVars4Ptr = NULL;
    }

    if (infoPtr->typeDestructorArgumentPtr) {
	Tcl_DecrRefCount(infoPtr->typeDestructorArgumentPtr);
	infoPtr->typeDestructorArgumentPtr = NULL;
    }

    Tcl_EvalEx(infoPtr->interp,
            "::oo::define ::itcl::clazz deletemethod unknown", -1, 0);

    /* first have to look for the remaining memory leaks, then remove the next ifdef */
    Itcl_RenameCommand(infoPtr->interp, "::itcl::clazz", "");

    /* tear down ::itcl namespace (this includes ::itcl::parser namespace) */
    nsPtr = Tcl_FindNamespace(infoPtr->interp, "::itcl::parser", NULL, 0);
    if (nsPtr != NULL) {
        Tcl_DeleteNamespace(nsPtr);
    }
    nsPtr = Tcl_FindNamespace(infoPtr->interp, "::itcl::import", NULL, 0);
    if (nsPtr != NULL) {
        Tcl_DeleteNamespace(nsPtr);
    }
    nsPtr = Tcl_FindNamespace(infoPtr->interp, "::itcl::internal", NULL, 0);
    if (nsPtr != NULL) {
        Tcl_DeleteNamespace(nsPtr);
    }
    nsPtr = Tcl_FindNamespace(infoPtr->interp, "::itcl::builtin", NULL, 0);
    if (nsPtr != NULL) {
        Tcl_DeleteNamespace(nsPtr);
    }
    nsPtr = Tcl_FindNamespace(infoPtr->interp, "::itcl", NULL, 0);
    if (nsPtr != NULL) {
        Tcl_DeleteNamespace(nsPtr);
    } else {

    /* cleanup ensemble info */
    if (infoPtr->ensembleInfo) {
	Tcl_DeleteHashTable(&infoPtr->ensembleInfo->ensembles);
	Tcl_DeleteHashTable(&infoPtr->ensembleInfo->subEnsembles);
	ItclFinishEnsemble(infoPtr);
	ckfree((char *)infoPtr->ensembleInfo);
	infoPtr->ensembleInfo = NULL;
    }

    if (infoPtr->class_meta_type) {
	ckfree((char *)infoPtr->class_meta_type);
	infoPtr->class_meta_type = NULL;
    }

    Itcl_DeleteStack(&infoPtr->clsStack);
    /* clean up list pool */
    Itcl_FinishList();

    Itcl_ReleaseData((ClientData)infoPtr);
    }
    Itcl_RestoreInterpState(interp, state);
    return TCL_OK;
}

#ifdef ITCL_PRESERVE_DEBUG
void Itcl_DbDumpPreserveInfo(const char *fileName);


/*
 * ------------------------------------------------------------------------
 *  ItclDumpPreserveInfo()
 *
 *  debugging routine to check for memory leaks in use of Itcl_PreserveData
 *  and Itcl_ReleaseData
 *
 * ------------------------------------------------------------------------
 */
static int
ItclDumpPreserveInfo(
    ClientData clientData,   /* unused */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclShowArgs(0, "ItclDumpPreserveInfo", objc, objv);
    Itcl_DbDumpPreserveInfo(NULL);
    return TCL_OK;
}
#endif

        "@itcl-builtin-setupcomponent",
        Itcl_BiSetupComponentCmd,
	ITCL_ECLASS
    },
};
static int BiMethodListLen = sizeof(BiMethodList)/sizeof(BiMethod);















































/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInit()
 *
 *  Creates a namespace full of built-in methods/procs for [incr Tcl]
 *  classes.  This includes things like the "isa" method and "info"
 *  for querying class info.  Usually invoked by Itcl_Init() when
 *  [incr Tcl] is first installed into an interpreter.
 *
 *  Returns TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

int
Itcl_BiInit(
    Tcl_Interp *interp,      /* current interpreter */
    ItclObjectInfo *infoPtr)
{
    Tcl_Namespace *itclBiNs;
    Tcl_DString buffer;

     */
    Tcl_DStringInit(&buffer);
    for (i=0; i < BiMethodListLen; i++) {
	Tcl_DStringSetLength(&buffer, 0);
	Tcl_DStringAppend(&buffer, "::itcl::builtin::", -1);
	Tcl_DStringAppend(&buffer, BiMethodList[i].name, -1);
        Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
	        BiMethodList[i].proc, (ClientData)infoPtr,
		(Tcl_CmdDeleteProc*)NULL);
    }
    Tcl_DStringFree(&buffer);

    Tcl_CreateObjCommand(interp, "::itcl::builtin::chain", Itcl_BiChainCmd,
            NULL, (Tcl_CmdDeleteProc*)NULL);

    Tcl_CreateObjCommand(interp, "::itcl::builtin::classunknown",
            ItclBiClassUnknownCmd, infoPtr, (Tcl_CmdDeleteProc*)NULL);

    ItclInfoInit(interp, infoPtr);
    /*
     *  Export all commands in the built-in namespace so we can
     *  import them later on.
     */
    itclBiNs = Tcl_FindNamespace(interp, "::itcl::builtin",
        (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);

    if ((itclBiNs == NULL) ||
        Tcl_Export(interp, itclBiNs, "[a-z]*", /* resetListFirst */ 1) != TCL_OK) {
        return TCL_ERROR;
    }
    /*
     * Install into the master [info] ensemble.
     */

    infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
    if (infoCmd != NULL && Tcl_IsEnsemble(infoCmd)) {
        Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
        if (mapDict != NULL) {
            infoPtr->infoVars4Ptr =
	            Tcl_NewStringObj("vars", -1);
	    Tcl_IncrRefCount(infoPtr->infoVars4Ptr);
            result = Tcl_DictObjGet(interp, mapDict, infoPtr->infoVars4Ptr,
	            &infoPtr->infoVarsPtr);
	    if(result != TCL_OK) {
              /* FIXME need code here!! */
	    }
	    Tcl_IncrRefCount(infoPtr->infoVarsPtr);

	    infoPtr->infoVars3Ptr =
	            Tcl_NewStringObj("::itcl::builtin::Info::vars", -1);




	    /* FIXME see comment in itclBase.c ItclFinishCmd */

	    Tcl_IncrRefCount(infoPtr->infoVars3Ptr);
            Tcl_DictObjPut(NULL, mapDict, infoPtr->infoVars4Ptr,
	            infoPtr->infoVars3Ptr);
            Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);

        }
    }

    return TCL_OK;
}



 *  Checks to see if the object has the given <className> anywhere
 *  in its heritage.  Returns 1 if so, and 0 otherwise.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiIsaCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclClass *iclsPtr;
    const char *token;

    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        return TCL_ERROR;
    }

    if (contextIoPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be \"object isa className\"",
            (char*)NULL);
        return TCL_ERROR;
    }
    if (objc != 2) {
        token = Tcl_GetString(objv[0]);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"object ", token, " className\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Look for the requested class.  If it is not found, then
     *  try to autoload it.  If it absolutely cannot be found,
     *  signal an error.

 *  option changes, a big of "config" code associated with the option
 *  is executed, to bring the object up to date.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiConfigureCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

        return TCL_ERROR;
    }

    if (contextIoPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be ",
            "\"object configure ?-option? ?value -option value...?\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  BE CAREFUL:  work in the virtual scope!
     */
    if (contextIoPtr != NULL) {

	    unparsedObjc = objc;
	}
    }
    /*
     *  HANDLE:  configure
     */
    if (unparsedObjc == 1) {
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);

        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->variables, &place);
            while (hPtr) {
                ivPtr = (ItclVariable*)Tcl_GetHashValue(hPtr);
                if (ivPtr->protection == ITCL_PUBLIC) {
                    objPtr = ItclReportPublicOpt(interp, ivPtr, contextIoPtr);

                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
                        objPtr);
                }
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
        return TCL_OK;
    } else {

        /*
         *  HANDLE:  configure -option
         */
        if (unparsedObjc == 2) {
            token = Tcl_GetStringFromObj(unparsedObjv[1], (int*)NULL);
            if (*token != '-') {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "improper usage: should be ",
                    "\"object configure ?-option? ?value -option value...?\"",
                    (char*)NULL);
                return TCL_ERROR;
            }

            vlookup = NULL;
            hPtr = ItclResolveVarEntry(contextIclsPtr, token+1);
            if (hPtr) {
                vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);

                if (vlookup->ivPtr->protection != ITCL_PUBLIC) {
                    vlookup = NULL;
                }
            }
            if (!vlookup) {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "unknown option \"", token, "\"",
                    (char*)NULL);
                return TCL_ERROR;
            }
            resultPtr = ItclReportPublicOpt(interp,
	            vlookup->ivPtr, contextIoPtr);
            Tcl_SetObjResult(interp, resultPtr);
            return TCL_OK;
        }

            if (hPtr) {
                vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
            }
        }

        if (!vlookup || (vlookup->ivPtr->protection != ITCL_PUBLIC)) {
            Tcl_AppendResult(interp, "unknown option \"", token, "\"",
                (char*)NULL);
            result = TCL_ERROR;
            goto configureDone;
        }
        if (i == unparsedObjc-1) {
            Tcl_AppendResult(interp, "value for \"", token, "\" missing",
                (char*)NULL);
            result = TCL_ERROR;
            goto configureDone;
        }

        ivPtr = vlookup->ivPtr;
        Tcl_DStringSetLength(&buffer2, 0);
	if (!(ivPtr->flags & ITCL_COMMON)) {
            Tcl_DStringAppend(&buffer2,
	            Tcl_GetString(contextIoPtr->varNsNamePtr), -1);
	}
        Tcl_DStringAppend(&buffer2,
	        Tcl_GetString(ivPtr->iclsPtr->fullNamePtr), -1);
        Tcl_DStringAppend(&buffer2, "::", 2);
        Tcl_DStringAppend(&buffer2,
	        Tcl_GetString(ivPtr->namePtr), -1);
	varName = Tcl_DStringValue(&buffer2);
        lastval = Tcl_GetVar2(interp, varName, (char*)NULL, 0);
        Tcl_DStringSetLength(&buffer, 0);
        Tcl_DStringAppend(&buffer, (lastval) ? lastval : "", -1);

        token = Tcl_GetString(unparsedObjv[i+1]);
        if (Tcl_SetVar2(interp, varName, (char*)NULL, token,
                TCL_LEAVE_ERR_MSG) == NULL) {
    	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
    		    "\n    (error in configuration of public variable \"%s\")",
    		    Tcl_GetString(ivPtr->fullNamePtr)));
            result = TCL_ERROR;
            goto configureDone;
        }

	    Itcl_SetCallFrameNamespace(interp, saveNsPtr);
            if (result == TCL_OK) {
                Tcl_ResetResult(interp);
            } else {
        	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
        		    "\n    (error in configuration of public variable \"%s\")",
        		    Tcl_GetString(ivPtr->fullNamePtr)));
                Tcl_SetVar2(interp, varName,(char*)NULL,
                    Tcl_DStringValue(&buffer), 0);

                goto configureDone;
            }
        }
    }

 *  Tk widgets.  Returns the current value of the public variable
 *  with name <option>.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiCgetCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if ((contextIoPtr == NULL) || objc != 2) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be \"object cget -option\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  BE CAREFUL:  work in the virtual scope!
     */
    if (contextIoPtr != NULL) {

    if (hPtr) {
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
    }

    if ((vlookup == NULL) || (vlookup->ivPtr->protection != ITCL_PUBLIC)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "unknown option \"", name, "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    val = Itcl_GetInstanceVar(interp,
            Tcl_GetString(vlookup->ivPtr->namePtr),
            contextIoPtr, vlookup->ivPtr->iclsPtr);

    ItclClass *iclsPtr;
    Tcl_HashEntry *hPtr;
    ItclVarLookup *vlookup;
    Tcl_DString optName;
    Tcl_Obj *listPtr;
    Tcl_Obj *objPtr;

    listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);

    /*
     *  Determine how the option name should be reported.
     *  If the simple name can be used to find it in the virtual
     *  data table, then use the simple name.  Otherwise, this
     *  is a shadowed variable; use the full name.
     */
    Tcl_DStringInit(&optName);
    Tcl_DStringAppend(&optName, "-", -1);

    iclsPtr = (ItclClass*)contextIoPtr->iclsPtr;
    hPtr = ItclResolveVarEntry(iclsPtr,
            Tcl_GetString(ivPtr->fullNamePtr));
    assert(hPtr != NULL);
    vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
    Tcl_DStringAppend(&optName, vlookup->leastQualName, -1);

    objPtr = Tcl_NewStringObj(Tcl_DStringValue(&optName), -1);
    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
    Tcl_DStringFree(&optName);


    if (ivPtr->init) {
        objPtr = ivPtr->init;
    } else {
        objPtr = Tcl_NewStringObj("<undefined>", -1);
    }
    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);

    val = Itcl_GetInstanceVar(interp, Tcl_GetString(ivPtr->namePtr),
            contextIoPtr, ivPtr->iclsPtr);

    if (val) {
        objPtr = Tcl_NewStringObj((const char *)val, -1);
    } else {
        objPtr = Tcl_NewStringObj("<undefined>", -1);
    }
    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);

    return listPtr;
}

/*
 * ------------------------------------------------------------------------
 *  ItclReportOption()

    ItclObject *contextIoPtr) /* object containing this variable */
{
    Tcl_Obj *listPtr;
    Tcl_Obj *objPtr;
    ItclDelegatedOption *idoPtr;
    const char *val;

    listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
    idoPtr = ioptPtr->iclsPtr->infoPtr->currIdoPtr;
    if (idoPtr != NULL) {
        Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, idoPtr->namePtr);
	if (idoPtr->resourceNamePtr == NULL) {
            Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
                    Tcl_NewStringObj("", -1));
	    /* FIXME possible memory leak */
	} else {
            Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
                    idoPtr->resourceNamePtr);
	}
	if (idoPtr->classNamePtr == NULL) {
            Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
                    Tcl_NewStringObj("", -1));
	    /* FIXME possible memory leak */
	} else {
            Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
	            idoPtr->classNamePtr);
        }
    } else {
        Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, ioptPtr->namePtr);
        Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
                ioptPtr->resourceNamePtr);
        Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
	        ioptPtr->classNamePtr);
    }
    if (ioptPtr->defaultValuePtr) {
        objPtr = ioptPtr->defaultValuePtr;
    } else {
        objPtr = Tcl_NewStringObj("<undefined>", -1);
    }
    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
    val = ItclGetInstanceVar(interp, "itcl_options",
            Tcl_GetString(ioptPtr->namePtr),
            contextIoPtr, ioptPtr->iclsPtr);
    if (val) {
        objPtr = Tcl_NewStringObj((const char *)val, -1);
    } else {
        objPtr = Tcl_NewStringObj("<undefined>", -1);
    }
    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
    return listPtr;
}



/*
 * ------------------------------------------------------------------------

 *  This allows a base class method to be called out in a generic way,
 *  so the code will not have to change if the base class changes.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
NRBiChainCmd(
    ClientData dummy,        /* not used */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    int result = TCL_OK;

    ItclClass *contextIclsPtr;

     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        Tcl_ResetResult(interp);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "cannot chain functions outside of a class context",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Try to get the command name from the current call frame.
     *  If it cannot be determined, do nothing.  Otherwise, trim
     *  off any leading path names.

             *         methods by passing the full name as
             *         the command argument.
             */

            cmdlinePtr = Itcl_CreateArgs(interp,
	            Tcl_GetString(imPtr->fullNamePtr), objc-1, objv+1);

            (void) Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
                &my_objc, &newobjv);

	    if (imPtr->flags & ITCL_CONSTRUCTOR) {
		contextIoPtr = imPtr->iclsPtr->infoPtr->currIoPtr;
            }
            ItclShowArgs(1, "___chain", objc-1, newobjv+1);
            result = Itcl_EvalMemberCode(interp, imPtr, contextIoPtr,

    Tcl_DStringFree(&buffer);
    Itcl_DeleteHierIter(&hier);
    return result;
}
/* ARGSUSED */
int
Itcl_BiChainCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, NRBiChainCmd, clientData, objc, objv);
}

static int
CallCreateObject(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_CallFrame frame;
    Tcl_Namespace *nsPtr;
    ItclClass *iclsPtr = data[0];
    int objc = PTR2INT(data[1]);
    Tcl_Obj *const *objv = data[2];

    if (result != TCL_OK) {
        return result;
    }
    nsPtr = Itcl_GetUplevelNamespace(interp, 1);
    if (Itcl_PushCallFrame(interp, &frame, nsPtr,
            /*isProcCallFrame*/0) != TCL_OK) {

    Tcl_IncrRefCount(newObjv[1]);
    newObjv[2] = Tcl_NewStringObj(iclsPtr->nsPtr->fullName, -1);
    Tcl_IncrRefCount(newObjv[2]);
    memcpy(newObjv+3, objv+offset, (objc-offset) * sizeof(Tcl_Obj *));
    callbackPtr = Itcl_GetCurrentCallbackPtr(interp);
    ItclShowArgs(1, "CREATE", objc+3-offset, newObjv);
    Tcl_NRAddCallback(interp, CallCreateObject, iclsPtr,
            INT2PTR(objc+3-offset), (ClientData)newObjv, NULL);
    result = Itcl_NRRunCallbacks(interp, callbackPtr);
    if (result != TCL_OK) {
        if (iclsPtr->infoPtr->currIoPtr != NULL) {
            /* we are in a constructor call */
            if (iclsPtr->infoPtr->currIoPtr->hadConstructorError == 0) {
	        iclsPtr->infoPtr->currIoPtr->hadConstructorError = 1;
	    }

 *    classunknown <object> <methodname> ?<arg> <arg>...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
ItclBiClassUnknownCmd(
    ClientData clientData,   /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_HashEntry *hPtr2;
    Tcl_Obj **newObjv;

    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses,
            (char *)Tcl_GetCurrentNamespace(interp));
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "INTERNAL ERROR: ItclBiClassUnknownCmd ",
	        "cannot find class\n", NULL);
        return TCL_ERROR;
    }
    iclsPtr = Tcl_GetHashValue(hPtr);
    funcName = Tcl_GetString(objv[1]);
    if (strcmp(funcName, "create") == 0) {
        /* check if we have a user method create. If not, it is the builtin
	 * create method and we don't need to check for delegation
	 * and components with ITCL_COMPONENT_INHERIT
	 */
        hPtr = Tcl_FindHashEntry(&iclsPtr->resolveCmds, (char *)objv[1]);

	if (hPtr == NULL) {
	    objPtr = Tcl_NewStringObj("*", -1);
	    Tcl_IncrRefCount(objPtr);
	    hPtr = Tcl_FindHashEntry(&iclsPtr->delegatedFunctions,
	            (char *)objPtr);
	    Tcl_DecrRefCount(objPtr);
	    if (hPtr != NULL) {
	        idmPtr = Tcl_GetHashValue(hPtr);
	        isStar = 1;
	    }
	}
	if (isStar) {
            /* check if the function is in the exceptions */
	    hPtr2 = Tcl_FindHashEntry(&starIdmPtr->exceptions, (char *)objv[1]);
	    if (hPtr2 != NULL) {

		    }
		}
	        Tcl_SetObjResult(interp, objPtr);
		return TCL_ERROR;
	    }
	}
	if (hPtr != NULL) {
	    idmPtr = Tcl_GetHashValue(hPtr);
	    val = NULL;
	    if (idmPtr->icPtr != NULL) {
                if (idmPtr->icPtr->ivPtr->flags & ITCL_COMMON) {
	            val = Tcl_GetVar2(interp,
	                    Tcl_GetString(idmPtr->icPtr->namePtr), NULL, 0);
		} else {
                    ItclClass *contextIclsPtr;

    int isStar;
    int isTypeMethod;
    int isNew;
    int idx;

    if (objc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be one of...",
		(char*)NULL);
        ItclReportObjectUsage(interp, ioPtr, NULL, NULL);
        return TCL_ERROR;
    }
    iclsPtr = ioPtr->iclsPtr;
    lObjc = 0;
    offset = 1;
    isStar = 0;

    if (hPtr == NULL) {
        objPtr = Tcl_NewStringObj("*", -1);
        Tcl_IncrRefCount(objPtr);
        hPtr = Tcl_FindHashEntry(&iclsPtr->delegatedFunctions,
                (char *)objPtr);
        Tcl_DecrRefCount(objPtr);
	if (hPtr != NULL) {
	    idmPtr = Tcl_GetHashValue(hPtr);
            isStar = 1;
	}
    } else {
        found = 1;
	idmPtr = Tcl_GetHashValue(hPtr);
    }
    if (isStar) {
       /* check if the function is in the exceptions */
        hPtr2 = Tcl_FindHashEntry(&idmPtr->exceptions, (char *)objv[1]);
        if (hPtr2 != NULL) {
	    const char *sep = "";
	    objPtr = Tcl_NewStringObj("unknown subcommand \"", -1);

		    sep = " or ";
	        }
	    }
	}
    }
    if (idmPtr == NULL) {
        Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
                "\": should be one of...", (char*)NULL);
        ItclReportObjectUsage(interp, ioPtr, NULL, NULL);
        return TCL_ERROR;
    }
    lObjc = 0;
    if ((idmPtr != NULL) && ((idmPtr->asPtr != NULL) ||
            (idmPtr->usingPtr != NULL))) {
	offset++;

 *  option changes, a big of "config" code associated with the option
 *  is executed, to bring the object up to date.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
ItclExtendedConfigure(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_HashTable unique;
    Tcl_HashEntry *hPtr2;

        return TCL_ERROR;
    }

    if (contextIoPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be ",
            "\"object configure ?-option? ?value -option value...?\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  BE CAREFUL:  work in the virtual scope!
     */
    if (contextIoPtr != NULL) {

 *  Tk widgets.  Returns the current value of the public variable
 *  with name <option>.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
ItclExtendedCget(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashEntry *hPtr2;
    Tcl_HashEntry *hPtr3;

    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if ((contextIoPtr == NULL) || objc != 2) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be \"object cget -option\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  BE CAREFUL:  work in the virtual scope!
     */
    if (contextIoPtr != NULL) {

 *  this sets the variable to the value calling a callback if exists:
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
ItclExtendedSetGet(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        return TCL_ERROR;
    }

    usageStr = "improper usage: should be \"object setget varName ?value?\"";
    if (contextIoPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                usageStr, (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  BE CAREFUL:  work in the virtual scope!
     */
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }
    infoPtr = contextIclsPtr->infoPtr;
    if (infoPtr->currContextIclsPtr != NULL) {
        contextIclsPtr = infoPtr->currContextIclsPtr;
    }

    hPtr = NULL;
    if (objc < 2) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                usageStr, (char*)NULL);
        return TCL_ERROR;
    }
    /* look if it is an methodvariable at all */
    hPtr = Tcl_FindHashEntry(&contextIoPtr->objectMethodVariables,
            (char *) objv[1]);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "no such methodvariable \"",

 *      ?-option value -option value ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiInstallComponentCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj ** newObjv;
    ItclClass *contextIclsPtr;

    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        return TCL_ERROR;
    }

    if (contextIoPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be \"object installcomponent \"",
            (char*)NULL);
        return TCL_ERROR;
    }
    if (objc < 5) {
	/* FIXME strip off the :: parts here properly*/
        token = Tcl_GetString(objv[0])+2;
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"", token, " <componentName> using",
	    " <widgetClassName> <widgetPathName>",
	    " ?-option value -option value ...?\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /* get component name and check, if it exists */
    token = Tcl_GetString(objv[1]);
    if (contextIclsPtr == NULL) {
        Tcl_AppendResult(interp, "cannot find context class for object \"",

 *    destroy
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
Itcl_BiDestroyCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj **newObjv;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

	Tcl_DecrRefCount(newObjv[2]);
	Tcl_DecrRefCount(newObjv[1]);
	Tcl_DecrRefCount(newObjv[0]);
	return result;
    }
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"", Tcl_GetString(objv[0]), (char*)NULL);
        return TCL_ERROR;
    }

    if (contextIoPtr != NULL) {
        Tcl_Obj *objPtr = Tcl_NewObj();
        Tcl_GetCommandFullName(interp, contextIoPtr->accessCmd, objPtr);
        Itcl_RenameCommand(interp, Tcl_GetString(objPtr), "");

 *    callinstance <instanceName> ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiCallInstanceCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_HashEntry *hPtr;
    Tcl_Obj *objPtr;
    Tcl_Obj **newObjv;

        return TCL_ERROR;
    }

    if (objc < 2) {
        token = Tcl_GetString(objv[0]);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"", token, " <instanceName>",
            (char*)NULL);
        return TCL_ERROR;
    }

    hPtr = Tcl_FindHashEntry(&contextIclsPtr->infoPtr->instances,
            Tcl_GetString(objv[1]));
    if (hPtr == NULL) {
	Tcl_AppendResult(interp,
	        "no such instanceName \"",
		Tcl_GetString(objv[1]), "\"", NULL);
        return TCL_ERROR;
    }
    ioPtr = Tcl_GetHashValue(hPtr);
    objPtr =Tcl_NewObj();
    Tcl_GetCommandFullName(interp, ioPtr->accessCmd, objPtr);
    newObjv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * (objc - 1));
    newObjv[0] = objPtr;
    Tcl_IncrRefCount(newObjv[0]);
    memcpy(newObjv + 1, objv + 2, sizeof(Tcl_Obj *) * (objc - 2));
    result = Tcl_EvalObjv(interp, objc - 1, newObjv, 0);

 *    getinstancevar <instanceName> ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiGetInstanceVarCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_HashEntry *hPtr;
    Tcl_Obj *objPtr;
    Tcl_Obj **newObjv;

        return TCL_ERROR;
    }

    if (objc < 2) {
        token = Tcl_GetString(objv[0]);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"", token, " <instanceName>",
            (char*)NULL);
        return TCL_ERROR;
    }

    hPtr = Tcl_FindHashEntry(&contextIclsPtr->infoPtr->instances,
            Tcl_GetString(objv[1]));
    if (hPtr == NULL) {
	Tcl_AppendResult(interp,
	        "no such instanceName \"",
		Tcl_GetString(objv[1]), "\"", NULL);
        return TCL_ERROR;
    }
    ioPtr = Tcl_GetHashValue(hPtr);
    objPtr =Tcl_NewObj();
    Tcl_GetCommandFullName(interp, ioPtr->accessCmd, objPtr);
    newObjv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * (objc - 1));
    newObjv[0] = objPtr;
    Tcl_IncrRefCount(newObjv[0]);
    memcpy(newObjv + 1, objv + 2, sizeof(Tcl_Obj *) * (objc - 2));
    result = Tcl_EvalObjv(interp, objc - 1, newObjv, 0);
    Tcl_DecrRefCount(newObjv[0]);

 *    mytypemethod ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiMyTypeMethodCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj *objPtr;
    Tcl_Obj *resultPtr;
    ItclClass *contextIclsPtr;

 *    mymethod ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiMyMethodCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj *resultPtr;
    int i;
    ItclClass *contextIclsPtr;

 *    myproc ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiMyProcCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj *objPtr;
    Tcl_Obj *resultPtr;
    ItclClass *contextIclsPtr;

 *    mytypevar ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiMyTypeVarCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj *objPtr;
    Tcl_Obj *resultPtr;
    ItclClass *contextIclsPtr;

 *    myvar ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiMyVarCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj *resultPtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

 *    itcl_hull ?arg arg ...?
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
int
Itcl_BiItclHullCmd(
    ClientData clientData,   /* class definition */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    const char *val;

 *      createhull <widget_type> <widget_path> ?-class <widgetClassName>?
 *          ?<optionName> <optionValue> <optionName> <optionValue> ...?
 *
 * ------------------------------------------------------------------------
 */
static int
Itcl_BiCreateHullCmd(
    ClientData clientData,   /* info for all known objects */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    int result;
    ItclObjectInfo *infoPtr = (ItclObjectInfo*)clientData;

 *      setupcomponent <componentName> using <widgetType> <widget_path>
 *          ?<optionName> <optionValue> <optionName> <optionValue> ...?
 *
 * ------------------------------------------------------------------------
 */
static int
Itcl_BiSetupComponentCmd(
    ClientData clientData,   /* info for all known objects */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    int result;
    ItclObjectInfo *infoPtr = (ItclObjectInfo*)clientData;

 *          ?<optionName> <optionValue> <optionName> <optionValue> ...?
 * FIXME !!!! seems no longer been used !!!
 *
 * ------------------------------------------------------------------------
 */
static int
Itcl_BiInitOptionsCmd(
    ClientData clientData,   /* info for all known objects */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    int result;
    ItclObjectInfo *infoPtr = (ItclObjectInfo*)clientData;
    ItclClass *iclsPtr;

 *
 *      keepcomponentoption <componentName> <optionName> ?<optionName> ...?
 *
 * ------------------------------------------------------------------------
 */
static int
Itcl_BiKeepComponentOptionCmd(
    ClientData clientData,   /* info for all known objects */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    int result;
    ItclObjectInfo *infoPtr = (ItclObjectInfo*)clientData;

 *
 *      ignorecomponentoption <componentName> <optionName> ?<optionName> ...?
 *
 * ------------------------------------------------------------------------
 */
static int
Itcl_BiIgnoreComponentOptionCmd(
    ClientData clientData,   /* info for all known objects */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashEntry *hPtr2;
    Tcl_Obj *objPtr;

        hPtr = Tcl_FindHashEntry(&ioPtr->objectComponents, (char *)objv[1]);
        if (hPtr == NULL) {
	    Tcl_AppendResult(interp,
	            "ignorecomponentoption cannot find component \"",
	            Tcl_GetString(objv[1]), "\"", NULL);
	    return TCL_ERROR;
	}
        icPtr = Tcl_GetHashValue(hPtr);
	icPtr->haveKeptOptions = 1;
	for (idx = 2; idx < objc; idx++) {
	    hPtr = Tcl_CreateHashEntry(&icPtr->keptOptions, (char *)objv[idx],
	            &isNew);
            if (isNew) {
	        Tcl_SetHashValue(hPtr, objv[idx]);
	    }

 * ------------------------------------------------------------------------
 *  Itcl_DeleteMemberFunc()
 *
 * ------------------------------------------------------------------------
 */

void Itcl_DeleteMemberFunc (
    char *cdata)
{
    /* needed for stubs compatibility */
    ItclMemberFunc *imPtr;

    imPtr = (ItclMemberFunc *)cdata;
    if (imPtr == NULL) {
        /* FIXME need code here */

 * ------------------------------------------------------------------------
 */

static void
ItclDestroyClass2(
    ClientData clientData)      /* The class being deleted. */
{
    ItclClass *iclsPtr;

    iclsPtr = clientData;
    ItclDestroyClassNamesp(iclsPtr);
    ItclReleaseClass(iclsPtr);
}

/*
 * ------------------------------------------------------------------------
 *  ClassCmdDeleteTrace()
 *
 * ------------------------------------------------------------------------
 */

static void
ClassCmdDeleteTrace(
    ClientData clientData,      /* The class being deleted. */
    Tcl_Interp *interp,         /* The interpreter containing the object. */
    const char *oldName,        /* What the object was (last) called. */
    const char *newName,        /* Always NULL. */
    int flags)                  /* Why was the object deleted? */
{
    Tcl_HashEntry *hPtr;
    Tcl_DString buffer;
    Tcl_Namespace *nsPtr;
    ItclObjectInfo *infoPtr;
    ItclClass *iclsPtr = clientData;

    /*
     * How is it decided what cleanup is done here tracing the access command deletion,
     * versus what cleanup is done by the Tcl_CmdDeleteProc tied to the access command?
     */

    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    hPtr = Tcl_FindHashEntry(&infoPtr->classes, (char *)iclsPtr);
    if (hPtr == NULL) {
        return;
    }
    if (iclsPtr->flags & ITCL_CLASS_IS_RENAMED) {	/* DUMB! name for this flag */
        return;				/* Flag very likely serves no purpose as well. */
    }
    iclsPtr->flags |= ITCL_CLASS_IS_RENAMED;		/* DUMB! name for this flag */
    ItclPreserveClass(iclsPtr);
    /* delete the namespace for the common variables */
    Tcl_DStringInit(&buffer);
    Tcl_DStringAppend(&buffer, ITCL_VARIABLES_NAMESPACE, -1);
    Tcl_DStringAppend(&buffer,
	    (Tcl_GetObjectNamespace(iclsPtr->oPtr))->fullName, -1);
    nsPtr = Tcl_FindNamespace(interp, Tcl_DStringValue(&buffer), NULL, 0);
    Tcl_DStringFree(&buffer);
    if (nsPtr != NULL) {
        Tcl_DeleteNamespace(nsPtr);
    }
    if (!(iclsPtr->flags & ITCL_CLASS_NS_IS_DESTROYED)) {
        ItclDestroyClassNamesp(iclsPtr);
    }
    ItclReleaseClass(iclsPtr);
    return;
}


/*
 * ------------------------------------------------------------------------
 *  ItclDeleteClassMetadata()
 *
 *  Delete the metadata data if any
 *-------------------------------------------------------------------------
 */
void
ItclDeleteClassMetadata(
    ClientData clientData)
{
    /*
     * This is how we get alerted from TclOO that the object corresponding
     * to an Itcl class (or its namespace...) is being torn down.
     */

    ItclClass *iclsPtr = clientData;
    Tcl_Object oPtr = iclsPtr->oPtr;
    Tcl_Namespace *ooNsPtr = Tcl_GetObjectNamespace(oPtr);

    if (ooNsPtr != iclsPtr->nsPtr) {
	/* 
	 * Itcl's idea of the class namespace is different from that of TclOO.
	 * Make sure both get torn down and pulled from tables.
	 */
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iclsPtr->infoPtr->namespaceClasses,
		(char *)ooNsPtr);
	if (hPtr != NULL) {
	    Tcl_DeleteHashEntry(hPtr);


static int
CallNewObjectInstance(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ItclObjectInfo *infoPtr = data[0];
    const char* path = data[1];
    Tcl_Object *oPtr = data[2];
    Tcl_Obj *nameObjPtr = data[3];

    *oPtr = NULL;
    if (infoPtr->clazzClassPtr) {
	*oPtr = Tcl_NewObjectInstance(interp, infoPtr->clazzClassPtr,
                path, path, 0, NULL, 0);
    }
    if (*oPtr == NULL) {

    ItclClass *iclsPtr;
    ItclVariable *ivPtr;
    Tcl_HashEntry *hPtr;
    void *callbackPtr;
    int result;
    int newEntry;
    ItclResolveInfo *resolveInfoPtr;
    Tcl_Obj *cmdNamePtr;

    if (infoPtr->clazzObjectPtr == NULL) {
	Tcl_AppendResult(interp, "oo-subsystem is deleted", NULL);
	return TCL_ERROR;
    }

    /*

     *  already exist in the current namespace context.  If a
     *  namespace exists, that's okay.  It may have been created
     *  to contain stubs during a "namespace import" operation.
     *  We'll just replace the namespace data below with the
     *  proper class data.
     */
    classNs = Tcl_FindNamespace(interp, (const char *)path,
	    (Tcl_Namespace*)NULL, /* flags */ 0);

    if (classNs != NULL && Itcl_IsClassNamespace(classNs)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "class \"", path, "\" already exists",
            (char*)NULL);
        return TCL_ERROR;
    }

    oPtr = NULL;
    /*
     *  Make sure that a command with the given class name does not
     *  already exist in the current namespace.  This prevents the
     *  usual Tcl commands from being clobbered when a programmer
     *  makes a bogus call like "class info".
     */
    cmd = Tcl_FindCommand(interp, (const char *)path,
	    (Tcl_Namespace*)NULL, /* flags */ TCL_NAMESPACE_ONLY);

    if (cmd != NULL && !Itcl_IsStub(cmd)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "command \"", path, "\" already exists",
            (char*)NULL);

        if (strstr(path,"::") == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                " in namespace \"",
                Tcl_GetCurrentNamespace(interp)->fullName, "\"",
                (char*)NULL);
        }
        return TCL_ERROR;
    }

    /*
     *  Make sure that the class name does not have any goofy
     *  characters:
     *
     *    .  =>  reserved for member access like:  class.publicVar
     */
    Itcl_ParseNamespPath(path, &buffer, &head, &tail);

    if (strstr(tail,".")) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "bad class name \"", tail, "\"",
            (char*)NULL);
        Tcl_DStringFree(&buffer);
        return TCL_ERROR;
    }
    Tcl_DStringFree(&buffer);

    /*
     *  Allocate class definition data.
     */
    iclsPtr = (ItclClass*)ItclCkalloc(sizeof(ItclClass), NULL);
    memset(iclsPtr, 0, sizeof(ItclClass));
    iclsPtr->interp = interp;
    iclsPtr->infoPtr = infoPtr;
    Itcl_PreserveData((ClientData)infoPtr);

    Tcl_InitObjHashTable(&iclsPtr->variables);
    Tcl_InitObjHashTable(&iclsPtr->functions);
    Tcl_InitObjHashTable(&iclsPtr->options);
    Tcl_InitObjHashTable(&iclsPtr->components);
    Tcl_InitObjHashTable(&iclsPtr->delegatedOptions);
    Tcl_InitObjHashTable(&iclsPtr->delegatedFunctions);
    Tcl_InitObjHashTable(&iclsPtr->methodVariables);
    Tcl_InitObjHashTable(&iclsPtr->resolveCmds);

    iclsPtr->numInstanceVars = 0;
    Tcl_InitHashTable(&iclsPtr->classCommons, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&iclsPtr->resolveVars, TCL_STRING_KEYS);
    Tcl_InitHashTable(&iclsPtr->contextCache, TCL_ONE_WORD_KEYS);

    Itcl_InitList(&iclsPtr->bases);
    Itcl_InitList(&iclsPtr->derived);

    resolveInfoPtr = (ItclResolveInfo *) ckalloc(sizeof(ItclResolveInfo));
    memset (resolveInfoPtr, 0, sizeof(ItclResolveInfo));
    resolveInfoPtr->flags = ITCL_RESOLVE_CLASS;
    resolveInfoPtr->iclsPtr = iclsPtr;
    iclsPtr->resolvePtr = (Tcl_Resolve *)ckalloc(sizeof(Tcl_Resolve));
    iclsPtr->resolvePtr->cmdProcPtr = Itcl_CmdAliasProc;
    iclsPtr->resolvePtr->varProcPtr = Itcl_VarAliasProc;
    iclsPtr->resolvePtr->clientData = resolveInfoPtr;
    iclsPtr->flags    = infoPtr->currClassFlags;

    callbackPtr = Itcl_GetCurrentCallbackPtr(interp);
    /*
     *  Create a command in the current namespace to manage the class:
     *    <className>
     *    <className> <objName> ?<constructor-args>?
     */
    Tcl_NRAddCallback(interp, CallNewObjectInstance, infoPtr,
            (ClientData)path, &oPtr, nameObjPtr);
    result = Itcl_NRRunCallbacks(interp, callbackPtr);
    if (result == TCL_ERROR) {
	result = TCL_ERROR;
        goto errorOut;
    }
    iclsPtr->clsPtr = Tcl_GetObjectAsClass(oPtr);
    iclsPtr->oPtr = oPtr;
    ItclPreserveClass(iclsPtr);
    Tcl_ObjectSetMetadata(iclsPtr->oPtr, infoPtr->class_meta_type, iclsPtr);
    cmd = Tcl_GetObjectCommand(iclsPtr->oPtr);
    Tcl_GetCommandInfoFromToken(cmd, &cmdInfo);
    cmdInfo.deleteProc = ItclDestroyClass;
    cmdInfo.deleteData = iclsPtr;
    Tcl_SetCommandInfoFromToken(cmd, &cmdInfo);
    ooNs = Tcl_GetObjectNamespace(oPtr);
    classNs = Tcl_FindNamespace(interp, Tcl_GetString(nameObjPtr),
            (Tcl_Namespace*)NULL, /* flags */ 0);
    if (_TclOONamespaceDeleteProc == NULL) {
        _TclOONamespaceDeleteProc = ooNs->deleteProc;
    }

    if (classNs == NULL) {
	Tcl_AppendResult(interp,
	        "ITCL: cannot create/get class namespace for class \"",

    Tcl_IncrRefCount(iclsPtr->namePtr);

    iclsPtr->fullNamePtr = Tcl_NewStringObj(classNs->fullName, -1);
    Tcl_IncrRefCount(iclsPtr->fullNamePtr);

    hPtr = Tcl_CreateHashEntry(&infoPtr->nameClasses,
            (char *)iclsPtr->fullNamePtr, &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)iclsPtr);


    hPtr = Tcl_CreateHashEntry(&infoPtr->namespaceClasses, (char *)classNs,
            &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)iclsPtr);
  if (classNs != ooNs) {
    hPtr = Tcl_CreateHashEntry(&infoPtr->namespaceClasses, (char *)ooNs,
            &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)iclsPtr);

    if (classNs->clientData && classNs->deleteProc) {
	(*classNs->deleteProc)(classNs->clientData);
    }
    classNs->clientData = (ClientData)iclsPtr;
    classNs->deleteProc = ItclDestroyClass2;
}

    hPtr = Tcl_CreateHashEntry(&infoPtr->classes, (char *)iclsPtr, &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)iclsPtr);

    /*
     * now build the namespace for the common private and protected variables
     * public variables go directly to the class namespace
     */
    Tcl_DStringInit(&buffer);
    Tcl_DStringAppend(&buffer, ITCL_VARIABLES_NAMESPACE, -1);

            Itcl_ThisCmd, iclsPtr, NULL);

    /*
     *  Add the built-in "type" variable to the list of data members.
     */
    if (iclsPtr->flags & ITCL_TYPE) {
        namePtr = Tcl_NewStringObj("type", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
            (char*)NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_TYPE_VAR;       /* mark as "type" variable */
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);
    }

    if (iclsPtr->flags & (ITCL_ECLASS)) {
        namePtr = Tcl_NewStringObj("win", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
            (char*)NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_WIN_VAR;        /* mark as "win" variable */
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);
    }
    if (iclsPtr->flags & (ITCL_TYPE|ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
        namePtr = Tcl_NewStringObj("self", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
            (char*)NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_SELF_VAR;       /* mark as "self" variable */
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);

        namePtr = Tcl_NewStringObj("selfns", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
            (char*)NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_SELFNS_VAR;     /* mark as "selfns" variable */
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);

        namePtr = Tcl_NewStringObj("win", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
            (char*)NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_WIN_VAR;        /* mark as "win" variable */
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);
    }
    namePtr = Tcl_NewStringObj("this", -1);
    (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
            (char*)NULL, &ivPtr);

    ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
    ivPtr->flags |= ITCL_THIS_VAR;       /* mark as "this" variable */

    hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
            &newEntry);
    Tcl_SetHashValue(hPtr, (ClientData)ivPtr);

    if (infoPtr->currClassFlags &
            (ITCL_ECLASS|ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET)) {
        /*
         *  Add the built-in "itcl_options" variable to the list of
	 *  data members.
         */
        namePtr = Tcl_NewStringObj("itcl_options", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
                (char*)NULL, &ivPtr);

        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_OPTIONS_VAR;    /* mark as "itcl_options"
	                                      * variable */
    
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);

    }
    if (infoPtr->currClassFlags &
            ITCL_ECLASS) {
        /*
         *  Add the built-in "itcl_option_components" variable to the list of
	 *  data members.
         */
        namePtr = Tcl_NewStringObj("itcl_option_components", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
                (char*)NULL, &ivPtr);

        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_OPTION_COMP_VAR; /* mark as "itcl_option_components"
	                                      * variable */
    
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);

    }
    if (infoPtr->currClassFlags & (ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
        /*
         *  Add the built-in "thiswin" variable to the list of data members.
         */
        namePtr = Tcl_NewStringObj("thiswin", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, (char*)NULL,
                (char*)NULL, &ivPtr);

        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_THIS_VAR;       /* mark as "thiswin" variable */
    
        hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr,
	        &newEntry);
        Tcl_SetHashValue(hPtr, (ClientData)ivPtr);
    }
    if (infoPtr->currClassFlags & (ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
        /* create the itcl_hull component */
        ItclComponent *icPtr;
        namePtr = Tcl_NewStringObj("itcl_hull", 9);
	/* itcl_hull must not be an ITCL_COMMON!! */
        if (ItclCreateComponent(interp, iclsPtr, namePtr, 0, &icPtr) !=
	        TCL_OK) {
	    result = TCL_ERROR;
            goto errorOut;
        }
    }

    ItclPreserveClass(iclsPtr);
    iclsPtr->accessCmd = Tcl_GetObjectCommand(oPtr);

    cmdNamePtr = Tcl_NewObj();
    Tcl_GetCommandFullName(interp, iclsPtr->accessCmd, cmdNamePtr);
    
    Tcl_TraceCommand(interp, Tcl_GetString(cmdNamePtr),
                TCL_TRACE_DELETE, ClassCmdDeleteTrace, iclsPtr);

    Tcl_DecrRefCount(cmdNamePtr);
    /* FIXME should set the class objects unknown command to Itcl_HandleClass */

    *rPtr = iclsPtr;
    result = TCL_OK;
errorOut:
    Tcl_DecrRefCount(nameObjPtr);
    return result;

    Tcl_Interp *interp,
    int result)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch place;
    ItclClass *iclsPtr2 = NULL;
    ItclObject *contextIoPtr;
    ItclClass *iclsPtr = data[0];
    ItclObjectInfo *infoPtr = data[1];
    void *callbackPtr;
    int classIsDeleted;

    if (result != TCL_OK) {
        return result;
    }
    classIsDeleted = 0;

static int
CallDeleteOneClass(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_HashEntry *hPtr;
    ItclClass *iclsPtr = data[0];
    ItclObjectInfo *infoPtr = data[1];
    int isDerivedReleased;

    if (result != TCL_OK) {
        return result;
    }
    isDerivedReleased = iclsPtr->flags & ITCL_CLASS_DERIVED_RELEASED;
    result = Itcl_DeleteClass(interp, iclsPtr);

    Tcl_HashEntry *hPtr;
    ItclObjectInfo *infoPtr;
    ItclClass *iclsPtr2 = NULL;
    Itcl_ListElem *elem;
    void *callbackPtr;
    int result;

    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    hPtr = Tcl_FindHashEntry(&infoPtr->classes, (char *)iclsPtr);
    if (hPtr == NULL) {
	/* class has already been deleted */
        return TCL_OK;
    }
    if (iclsPtr->flags & ITCL_CLASS_IS_DELETED) {
        return TCL_OK;

     */
    hPtr = Tcl_FirstHashEntry(&iclsPtr->infoPtr->objects, &place);
    while (hPtr) {
        ioPtr = (ItclObject*)Tcl_GetHashValue(hPtr);
        if (ioPtr->iclsPtr == iclsPtr) {
	    if ((ioPtr->accessCmd != NULL) && (!(ioPtr->flags &
	            (ITCL_OBJECT_IS_DESTRUCTED)))) {
		ItclPreserveObject(ioPtr);
                Tcl_DeleteCommandFromToken(iclsPtr->interp, ioPtr->accessCmd);
	        ioPtr->accessCmd = NULL;
		ItclReleaseObject(ioPtr);
	        /*
	         * Fix 227804: Whenever an object to delete was found we
	         * have to reset the search to the beginning as the
	         * current entry in the search was deleted and accessing it
	         * is therefore not allowed anymore.
	         */

	        hPtr = Tcl_FirstHashEntry(&iclsPtr->infoPtr->objects, &place);
	        continue;
	    }
        }
        hPtr = Tcl_NextHashEntry(&place);
    }




















    /*
     *  Next, remove this class from the "derived" list in
     *  all base classes.
     */
    belem = Itcl_FirstListElem(&iclsPtr->bases);
    while (belem) {

     *  Tear down the virtual method table...
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&iclsPtr->resolveCmds, &place);
        if (hPtr == NULL) {
            break;
        }
        clookupPtr = Tcl_GetHashValue(hPtr);
        ckfree((char *)clookupPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&iclsPtr->resolveCmds);

    /*
     *  Delete all option definitions.
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&iclsPtr->options, &place);
        if (hPtr == NULL) {
            break;
        }
        ioptPtr = Tcl_GetHashValue(hPtr);
	Tcl_DeleteHashEntry(hPtr);
        Itcl_ReleaseData(ioptPtr);
    }
    Tcl_DeleteHashTable(&iclsPtr->options);

    /*
     *  Delete all function definitions.
     */
    FOREACH_HASH_VALUE(imPtr, &iclsPtr->functions) {
	imPtr->iclsPtr = NULL;
        ItclReleaseIMF(imPtr);
    }
    Tcl_DeleteHashTable(&iclsPtr->functions);

    /*
     *  Delete all delegated options.
     */
    FOREACH_HASH_VALUE(idoPtr, &iclsPtr->delegatedOptions) {

    }
    Tcl_DeleteHashTable(&iclsPtr->delegatedFunctions);

    /*
     *  Delete all components
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&iclsPtr->components, &place);
        if (hPtr == NULL) {
            break;
        }
        icPtr = Tcl_GetHashValue(hPtr);
	Tcl_DeleteHashEntry(hPtr);
	if (icPtr != NULL) {
            ItclDeleteComponent(icPtr);
	}
    }
    Tcl_DeleteHashTable(&iclsPtr->components);

    /*
     *  Delete all variable definitions.
     */
    while (1) {
        hPtr = Tcl_FirstHashEntry(&iclsPtr->variables, &place);
        if (hPtr == NULL) {
            break;
        }
        ivPtr = Tcl_GetHashValue(hPtr);
	Tcl_DeleteHashEntry(hPtr);
	if (ivPtr != NULL) {
            Itcl_ReleaseData(ivPtr);
	}
    }
    Tcl_DeleteHashTable(&iclsPtr->variables);

    /*
     *  Free up the object initialization code.
     */
    if (iclsPtr->initCode) {
        Tcl_DecrRefCount(iclsPtr->initCode);
    }

    Itcl_ReleaseData((ClientData)iclsPtr->infoPtr);

    Tcl_DecrRefCount(iclsPtr->namePtr);
    Tcl_DecrRefCount(iclsPtr->fullNamePtr);

    if (iclsPtr->resolvePtr != NULL) {
        ckfree((char *)iclsPtr->resolvePtr->clientData);
        ckfree((char *)iclsPtr->resolvePtr);
    }
    ItclCkfree(iclsPtr);
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_IsClassNamespace()
 *

     *  Search for a namespace with the specified name, and if
     *  one is found, see if it is a class namespace.
     */

    Tcl_Namespace* classNs = Itcl_FindClassNamespace(interp, path);

    if (classNs) {
	ItclObjectInfo *infoPtr
		= Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses,
		(char *) classNs);
	if (hPtr) {
	    return (ItclClass *) Tcl_GetHashValue(hPtr);
	}
    }

        Tcl_DStringFree(&buf);

	return Itcl_FindClass(interp, path, 0);
    }

    Tcl_AppendResult(interp, "class \"", path, "\" not found in context \"",
        Tcl_GetCurrentNamespace(interp)->fullName, "\"",
        (char*)NULL);

    return NULL;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_FindClassNamespace()

 *  context, just like the normal command lookup.
 *
 *  This procedure returns a pointer to the desired namespace, or
 *  NULL if the namespace was not found.
 * ------------------------------------------------------------------------
 */
Tcl_Namespace*
Itcl_FindClassNamespace(interp, path)
    Tcl_Interp* interp;        /* interpreter containing class */
    const char* path;                /* path name for class */
{
    Tcl_Namespace* contextNs = Tcl_GetCurrentNamespace(interp);
    Tcl_Namespace *classNs = Tcl_FindNamespace(interp, path, NULL, 0);

    if ( !classNs /* We didn't find it... */
	    && contextNs->parentPtr != NULL	/* context is not global */
	    && (*path != ':' || *(path+1) != ':') /* path not FQ */


static int
FinalizeCreateObject(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *objNamePtr = data[0];
    ItclClass *iclsPtr = data[1];
    if (result == TCL_OK) {
	if (!(iclsPtr->flags & (ITCL_TYPE|ITCL_WIDGET|ITCL_WIDGETADAPTOR))) {
	    Tcl_ResetResult(interp);
            Tcl_AppendResult(interp, Tcl_GetString(objNamePtr), NULL);
	}
    }
    Tcl_DecrRefCount(objNamePtr);
    return result;
}

static int
CallCreateObject(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *objNamePtr = data[0];
    ItclClass *iclsPtr = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = data[3];

    if (result == TCL_OK) {
        result = ItclCreateObject(interp, Tcl_GetString(objNamePtr), iclsPtr,
                objc, objv);
    }
    return result;
}
/*
 * ------------------------------------------------------------------------
 *  Itcl_HandleClass()
 *
 *  first argument is ::itcl::parser::handleClass 
 *  Invoked by Tcl whenever the user issues the command associated with
 *  a class name.  Handles the following syntax:
 *
 *    <className>
 *    <className> <objName> ?<args>...?
 *
 *  Without any arguments, the command does nothing.  In the olden days,

    hPtr = Tcl_FindHashEntry(&infoPtr->nameClasses, (char *)objv[2]);
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "no such class: \"",
	        Tcl_GetString(objv[1]), "\"", NULL);
	return TCL_ERROR;
    }
    iclsPtr = Tcl_GetHashValue(hPtr);

    /*
     *  If the object name is "::", and if this is an old-style class
     *  definition, then treat the remaining arguments as a command
     *  in the class namespace.  This used to be the way of invoking
     *  a class proc, but the new syntax is "class::proc" (without
     *  spaces).

        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "syntax \"class :: proc\" is an anachronism\n",
            "[incr Tcl] no longer supports this syntax.\n",
            "Instead, remove the spaces from your procedure invocations:\n",
            "  ",
            Tcl_GetString(objv[1]), "::",
            Tcl_GetString(objv[4]), " ?args?",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Otherwise, we have a proper object name.  Create a new instance
     *  with that name.  If the name contains "#auto", replace this with
     *  a uniquely generated string based on the class name.

				    vlookup->varNum = 1;
				} else {
				    vlookup->varNum = iclsPtr->numInstanceVars++;
				}
			    }
			}

			Tcl_SetHashValue(hPtr, (ClientData)vlookup);
			vlookup->usage++;
		    }

		    /* if we have found it */
		    if (simpleName == lookupName || strcmp(varName, lookupName) == 0) {
			if (!reshPtr) {
			    reshPtr = hPtr;

                hPtr = Tcl_CreateHashEntry(&iclsPtr->resolveCmds,
                        (char *)objPtr, &newEntry);

                if (newEntry) {
		    clookupPtr = (ItclCmdLookup *)ckalloc(sizeof(ItclCmdLookup));
		    memset(clookupPtr, 0, sizeof(ItclCmdLookup));
		    clookupPtr->imPtr = imPtr;
                    Tcl_SetHashValue(hPtr, (ClientData)clookupPtr);
                } else {
		    Tcl_DecrRefCount(objPtr);
		}

                if (nsPtr == NULL) {
                    break;
                }

     */
    hPtr = Tcl_CreateHashEntry(&iclsPtr->variables, (char *)namePtr, &newEntry);
    if (!newEntry) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "variable name \"", Tcl_GetString(namePtr),
	    "\" already defined in class \"",
            Tcl_GetString(iclsPtr->fullNamePtr), "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this variable has some "config" code, try to capture
     *  its implementation.
     */
    if (config) {
        if (Itcl_CreateMemberCode(interp, iclsPtr, (char*)NULL, config,
                &mCodePtr) != TCL_OK) {
            Tcl_DeleteHashEntry(hPtr);
            return TCL_ERROR;
        }
	ItclPreserveMemberCode(mCodePtr);
    } else {
        mCodePtr = NULL;
    }
        

    /*
     *  If everything looks good, create the variable definition.
     */
    ivPtr = (ItclVariable*)ItclCkalloc(sizeof(ItclVariable), NULL);
    memset(ivPtr, 0, sizeof(ItclVariable));
    ivPtr->iclsPtr      = iclsPtr;
    ivPtr->infoPtr      = iclsPtr->infoPtr;
    ivPtr->protection   = Itcl_Protection(interp, 0);
    ivPtr->codePtr      = mCodePtr;
    ivPtr->namePtr      = namePtr;
    Tcl_IncrRefCount(ivPtr->namePtr);
    ivPtr->fullNamePtr = Tcl_NewStringObj(

    if (init != NULL) {
        ivPtr->init = Tcl_NewStringObj(init, -1);
        Tcl_IncrRefCount(ivPtr->init);
    } else {
        ivPtr->init = NULL;
    }

    Tcl_SetHashValue(hPtr, (ClientData)ivPtr);
    Itcl_PreserveData((ClientData)ivPtr);
    Itcl_EventuallyFree((ClientData)ivPtr, (Tcl_FreeProc *) Itcl_DeleteVariable);

    *ivPtrPtr = ivPtr;
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------

    hPtr = Tcl_CreateHashEntry(&iclsPtr->options,
            (char *)ioptPtr->namePtr, &newEntry);
    if (!newEntry) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "option name \"", Tcl_GetString(ioptPtr->namePtr),
	    "\" already defined in class \"",
            Tcl_GetString(iclsPtr->fullNamePtr), "\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    iclsPtr->numOptions++;
    ioptPtr->iclsPtr = iclsPtr;
    ioptPtr->codePtr = NULL;
    ioptPtr->fullNamePtr = Tcl_NewStringObj(
            Tcl_GetString(iclsPtr->fullNamePtr), -1);
    Tcl_AppendToObj(ioptPtr->fullNamePtr, "::", 2);
    Tcl_AppendToObj(ioptPtr->fullNamePtr, Tcl_GetString(ioptPtr->namePtr), -1);
    Tcl_IncrRefCount(ioptPtr->fullNamePtr);
    Tcl_SetHashValue(hPtr, (ClientData)ioptPtr);
    Itcl_PreserveData((ClientData)ioptPtr);
    Itcl_EventuallyFree((ClientData)ioptPtr, (Tcl_FreeProc *) ItclDeleteOption);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_CreateMethodVariable()
 *
 *  Creates a new class methdovariable definition.  If this is a public
 *  methodvariable, 
 *
 *  Returns TCL_ERROR along with an error message in the specified
 *  interpreter if anything goes wrong.  Otherwise, this returns
 *  TCL_OK and a pointer to the new option definition in "imvPtr".
 * ------------------------------------------------------------------------
 */
int

    hPtr = Tcl_CreateHashEntry(&iclsPtr->methodVariables,
            (char *)namePtr, &isNew);
    if (!isNew) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "methdovariable name \"", Tcl_GetString(namePtr),
	    "\" already defined in class \"",
            Tcl_GetString (iclsPtr->fullNamePtr), "\"",
            (char*)NULL);
        return TCL_ERROR;
    }
    Tcl_IncrRefCount(namePtr);

    /*
     *  If everything looks good, create the option definition.
     */

        Tcl_IncrRefCount(imvPtr->callbackPtr);
    }

    if (imvPtr->protection == ITCL_DEFAULT_PROTECT) {
        imvPtr->protection = ITCL_PROTECTED;
    }

    Tcl_SetHashValue(hPtr, (ClientData)imvPtr);

    *imvPtrPtr = imvPtr;
    return TCL_OK;
}




    namePtr = Tcl_NewStringObj(lastCp, -1);
    Tcl_IncrRefCount(namePtr);
    hPtr = Tcl_FindHashEntry(&contextIclsPtr->variables, (char *)namePtr);
    Tcl_DecrRefCount(namePtr);
    if (hPtr == NULL) {
        return NULL;
    }
    ivPtr = Tcl_GetHashValue(hPtr);
    /*
     *  Activate the namespace for the given class.  That installs
     *  the appropriate name resolution rules and by-passes any
     *  security restrictions.
     */

    if (lastCp == name) {
	/* 'name' is a simple name (this is untested!!!!) */

	/* Use the context class passed in */
	oPtr = contextIclsPtr->oPtr;

    } else {
	int code = TCL_ERROR;
	Tcl_Obj *classObjPtr = Tcl_NewStringObj(name, lastCp - name - 2);
	oPtr = Tcl_GetObjectFromObj(interp, classObjPtr);

	if (oPtr) {
	    ItclClass *iclsPtr = Tcl_ObjectGetMetadata(oPtr,
		    contextIclsPtr->infoPtr->class_meta_type);
	    if (iclsPtr) {

		code = TCL_OK;
		assert(oPtr == iclsPtr->oPtr);

		/*

        Tcl_DStringAppend(&buffer, ITCL_VARIABLES_NAMESPACE, -1);
    }
    Tcl_DStringAppend(&buffer, (Tcl_GetObjectNamespace(oPtr))->fullName, -1);
    Tcl_DStringAppend(&buffer, "::", -1);
    Tcl_DStringAppend(&buffer, lastCp, -1);

    val = Tcl_GetVar2(interp, (const char *)Tcl_DStringValue(&buffer),
            (char*)NULL, 0);
    Tcl_DStringFree(&buffer);
    return val;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_InitHierIter()
 *
 *  Initializes an iterator for traversing the hierarchy of the given
 *  class.  Subsequent calls to Itcl_AdvanceHierIter() will return
 *  the base classes in order from most-to-least specific.
 * ------------------------------------------------------------------------
 */
void
Itcl_InitHierIter(iter,iclsPtr)
    ItclHierIter *iter;   /* iterator used for traversal */
    ItclClass *iclsPtr;     /* class definition for start of traversal */
{
    Itcl_InitStack(&iter->stack);
    Itcl_PushStack((ClientData)iclsPtr, &iter->stack);
    iter->current = iclsPtr;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_DeleteHierIter()
 *
 *  Destroys an iterator for traversing class hierarchies, freeing
 *  all memory associated with it.
 * ------------------------------------------------------------------------
 */
void
Itcl_DeleteHierIter(iter)
    ItclHierIter *iter;  /* iterator used for traversal */
{
    Itcl_DeleteStack(&iter->stack);
    iter->current = NULL;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_AdvanceHierIter()
 *
 *  Moves a class hierarchy iterator forward to the next base class.
 *  Returns a pointer to the current class definition, or NULL when
 *  the end of the hierarchy has been reached.
 * ------------------------------------------------------------------------
 */
ItclClass*
Itcl_AdvanceHierIter(
    ItclHierIter *iter)  /* iterator used for traversal */
{
    register Itcl_ListElem *elem;
    ItclClass *iclsPtr;

    iter->current = (ItclClass*)Itcl_PopStack(&iter->stack);

    /*
     *  Push classes onto the stack in reverse order, so that
     *  they will be popped off in the proper order.

Itcl_DeleteVariable(
    char *cdata)   /* variable definition to be destroyed */
{
    Tcl_HashEntry *hPtr;
    ItclVariable *ivPtr;

    ivPtr = (ItclVariable *)cdata;
if (ivPtr->arrayInitPtr != NULL) {
}
    hPtr = Tcl_FindHashEntry(&ivPtr->infoPtr->classes, (char *)ivPtr->iclsPtr);
    if (hPtr != NULL) {
	/* unlink owerself from list of class variables */
        hPtr = Tcl_FindHashEntry(&ivPtr->iclsPtr->variables,
                (char *)ivPtr->namePtr);
        if (hPtr != NULL) {
            Tcl_DeleteHashEntry(hPtr);
        }
    }
    if (ivPtr->codePtr != NULL) {
	ItclReleaseMemberCode(ivPtr->codePtr);
    }
    Tcl_DecrRefCount(ivPtr->namePtr);
    Tcl_DecrRefCount(ivPtr->fullNamePtr);
    if (ivPtr->init) {
        Tcl_DecrRefCount(ivPtr->init);
    }
    if (ivPtr->arrayInitPtr) {
        Tcl_DecrRefCount(ivPtr->arrayInitPtr);
    }
    ItclCkfree(ivPtr);
}

/*
 * ------------------------------------------------------------------------
 *  ItclDeleteOption()
 *
 *  Destroys a option definition created by Itcl_CreateOption(),

        Tcl_DecrRefCount(ioptPtr->resourceNamePtr);
    }
    if (ioptPtr->resourceNamePtr != NULL) {
        Tcl_DecrRefCount(ioptPtr->classNamePtr);
    }

    if (ioptPtr->codePtr) {
	ItclReleaseMemberCode(ioptPtr->codePtr); 
    }
    if (ioptPtr->defaultValuePtr != NULL) {
        Tcl_DecrRefCount(ioptPtr->defaultValuePtr);
    }
    if (ioptPtr->cgetMethodPtr != NULL) {
        Tcl_DecrRefCount(ioptPtr->cgetMethodPtr);
    }

    if (ioptPtr->validateMethodPtr != NULL) {
        Tcl_DecrRefCount(ioptPtr->validateMethodPtr);
    }
    if (ioptPtr->validateMethodVarPtr != NULL) {
        Tcl_DecrRefCount(ioptPtr->validateMethodVarPtr);
    }
    Itcl_ReleaseData(ioptPtr->idoPtr);
    ItclCkfree(ioptPtr);
}

/*
 * ------------------------------------------------------------------------
 *  ItclDeleteFunction()
 *
 *  fre data associated with a function

        hPtr = Tcl_FindHashEntry(&imPtr->iclsPtr->functions,
                (char *)imPtr->namePtr);
        if (hPtr != NULL) {
            Tcl_DeleteHashEntry(hPtr);
        }
    }
    if (imPtr->codePtr != NULL) {
        ItclReleaseMemberCode(imPtr->codePtr);
    }
    Tcl_DecrRefCount(imPtr->namePtr);
    Tcl_DecrRefCount(imPtr->fullNamePtr);
    if (imPtr->usagePtr != NULL) {
        Tcl_DecrRefCount(imPtr->usagePtr);
    }
    if (imPtr->argumentPtr != NULL) {

    }
    if (imPtr->bodyPtr != NULL) {
        Tcl_DecrRefCount(imPtr->bodyPtr);
    }
    if (imPtr->argListPtr != NULL) {
        ItclDeleteArgList(imPtr->argListPtr);
    }
    ckfree((char*)imPtr);
}

/*
 * ------------------------------------------------------------------------
 *  ItclDeleteComponent()
 *
 *  free data associated with a component

    }
    FOREACH_HASH_VALUE(objPtr, &idoPtr->exceptions) {
	if (objPtr != NULL) {
            Tcl_DecrRefCount(objPtr);
        }
    }
    Tcl_DeleteHashTable(&idoPtr->exceptions);
    ItclCkfree(idoPtr);
}

/*
 * ------------------------------------------------------------------------
 *  ItclDeleteDelegatedFunction()
 *
 *  free data associated with a delegated function

    Tcl_Obj *const objv[])   /* argument objects */
{
    ClientData clientData2;
    Tcl_Object oPtr;
    ItclClass *iclsPtr;

    ItclShowArgs(1, "NRThisCmd", objc, objv);
    iclsPtr = clientData;
    clientData2 = Itcl_GetCallFrameClientData(interp);
    oPtr = Tcl_ObjectContextObject(clientData2);
    return Itcl_PublicObjectCmd(oPtr, interp, iclsPtr->clsPtr, objc, objv);
}
/* ARGSUSED */
int
Itcl_ThisCmd(
    ClientData clientData,
    Tcl_Interp *interp,

    const char *val;
    int result;

    if (objc == 1) {
        return Itcl_SelfCmd(clientData,interp, objc, objv);
    }
    ItclShowArgs(1, "Itcl_ThisCmd", objc, objv);
    iclsPtr = clientData;
    clientData2 = Itcl_GetCallFrameClientData(interp);
    if (clientData2 == NULL) {
	Tcl_AppendResult(interp,
	        "this cannot be invoked without an object context", NULL);
        return TCL_ERROR;
    }
    oPtr = Tcl_ObjectContextObject(clientData2);
    if (oPtr == NULL) {
	Tcl_AppendResult(interp,
	        "this cannot be invoked without an object context", NULL);
        return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_Obj *namePtr = Tcl_NewObj();

     *  Search through all commands in the current namespace first,
     *  in the global namespace next, then in all child namespaces
     *  in this interpreter.  If we find any commands that
     *  represent classes, report them.
     */

    Itcl_InitStack(&search);
    Itcl_PushStack((ClientData)globalNs, &search);
    Itcl_PushStack((ClientData)activeNs, &search);  /* last in, first out! */

    Tcl_InitHashTable(&unique, TCL_ONE_WORD_KEYS);

    handledActiveNs = 0;
    while (Itcl_GetStackSize(&search) > 0) {
        nsPtr = Itcl_PopStack(&search);
        if (nsPtr == activeNs && handledActiveNs) {
            continue;
        }

        hPtr = Tcl_FirstHashEntry(Itcl_GetNamespaceCommandTable(nsPtr),
	        &place);
        while (hPtr) {

                 *      another namespace.
                 *
                 *  Otherwise, report short names.
                 */
                if (forceFullNames || nsPtr != activeNs ||
                    originalCmd != NULL) {

                    objPtr = Tcl_NewStringObj((char*)NULL, 0);
                    Tcl_GetCommandFullName(interp, cmd, objPtr);
                    cmdName = Tcl_GetString(objPtr);
                } else {
                    cmdName = Tcl_GetCommandName(interp, cmd);
                    objPtr = Tcl_NewStringObj((const char *)cmdName, -1);
                }

                if (originalCmd) {
                    cmd = originalCmd;
                }
                Tcl_CreateHashEntry(&unique, (char*)cmd, &newEntry);

                if (newEntry &&
			((pattern == NULL) ||
			Tcl_StringCaseMatch((const char *)cmdName, pattern, 0))) {
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
			    Tcl_GetObjResult(interp), objPtr);
                } else {
		    /* if not appended to the result, free objPtr. */
		    Tcl_DecrRefCount(objPtr);
		}

            }

     *  Search through all commands in the current namespace first,
     *  in the global namespace next, then in all child namespaces
     *  in this interpreter.  If we find any commands that
     *  represent objects, report them.
     */

    Itcl_InitStack(&search);
    Itcl_PushStack((ClientData)globalNs, &search);
    Itcl_PushStack((ClientData)activeNs, &search);  /* last in, first out! */

    Tcl_InitHashTable(&unique, TCL_ONE_WORD_KEYS);

    handledActiveNs = 0;
    while (Itcl_GetStackSize(&search) > 0) {
        nsPtr = Itcl_PopStack(&search);
        if (nsPtr == activeNs && handledActiveNs) {
            continue;
        }

        entry = Tcl_FirstHashEntry(Itcl_GetNamespaceCommandTable(nsPtr), &place);
        while (entry) {
            cmd = (Tcl_Command)Tcl_GetHashValue(entry);

                 *      another namespace.
                 *
                 *  Otherwise, report short names.
                 */
                if (forceFullNames || nsPtr != activeNs ||
                    originalCmd != NULL) {

                    objPtr = Tcl_NewStringObj((char*)NULL, 0);
                    Tcl_GetCommandFullName(interp, cmd, objPtr);
		    cmdName = Tcl_GetString(objPtr);
                } else {
                    cmdName = Tcl_GetCommandName(interp, cmd);
                    objPtr = Tcl_NewStringObj((const char *)cmdName, -1);
                }

                                match = 1;
                            }
                        }
                    }
                }

                if (match) {
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
                        Tcl_GetObjResult(interp), objPtr);
                } else {
                    Tcl_DecrRefCount(objPtr);  /* throw away the name */
                }
            }
            entry = Tcl_NextHashEntry(&place);
        }

 */
static int
CallDeleteObject(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ItclObject *contextIoPtr = data[0];
    if (contextIoPtr->destructorHasBeenCalled) {
	Tcl_AppendResult(interp, "can't delete an object while it is being ",
	        "destructed", NULL);
        return TCL_ERROR;
    }
    if (result == TCL_OK) {
        result = Itcl_DeleteObject(interp, contextIoPtr);

    ItclShowArgs(1, "Itcl_DelObjectCmd", objc, objv);
    /*
     *  Scan through the list of objects and attempt to delete them.
     *  If anything goes wrong (i.e., destructors fail), then
     *  abort with an error.
     */
    for (i=1; i < objc; i++) {
        name = Tcl_GetStringFromObj(objv[i], (int*)NULL);
	contextIoPtr = NULL;
        if (Itcl_FindObject(interp, name, &contextIoPtr) != TCL_OK) {
            return TCL_ERROR;
        }

        if (contextIoPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "object \"", name, "\" not found",
                (char*)NULL);
            return TCL_ERROR;
        }

        callbackPtr = Itcl_GetCurrentCallbackPtr(interp);
        Tcl_NRAddCallback(interp, CallDeleteObject, contextIoPtr,
	        NULL, NULL, NULL);
        result = Itcl_NRRunCallbacks(interp, callbackPtr);

    Tcl_Var var;
    Tcl_HashEntry *entry;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclObjectInfo *infoPtr;
    ItclVarLookup *vlookup;
    char *openParen;
    register char *p;
    char *token;
    int doAppend;
    int result;

    ItclShowArgs(1, "Itcl_ScopeCmd", objc, objv);
    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "varname");
        return TCL_ERROR;
    }

    contextNsPtr = Tcl_GetCurrentNamespace(interp);
    openParen = NULL;
    result = TCL_OK;
    /*
     *  If this looks like a fully qualified name already,
     *  then return it as is.
     */
    token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
    if (*token == ':' && *(token+1) == ':') {
        Tcl_SetObjResult(interp, objv[1]);
        return TCL_OK;
    }

    /*
     *  If the variable name is an array reference, pick out

     *    the array variable as the variable name.  We must be
     *    careful to add the index (everything from openParen
     *    onward) as well.
     */
    contextIoPtr = NULL;
    contextIclsPtr = NULL;
    oPtr = NULL;
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)contextNsPtr);
    if (hPtr != NULL) {
        contextIclsPtr = (ItclClass *)Tcl_GetHashValue(hPtr);
    }
    if (Itcl_IsClassNamespace(contextNsPtr)) {
	ClientData clientData;

        entry = ItclResolveVarEntry(contextIclsPtr, token);
        if (!entry) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "variable \"", token, "\" not found in class \"",
                Tcl_GetString(contextIclsPtr->fullNamePtr), "\"",
                (char*)NULL);
            result = TCL_ERROR;
            goto scopeCmdDone;
        }
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);

        if (vlookup->ivPtr->flags & ITCL_COMMON) {
            Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);

	        contextIoPtr = infoPtr->currIoPtr;
	    }
	}
        if (contextIoPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "can't scope variable \"", token,
                "\": missing object context",
                (char*)NULL);
            result = TCL_ERROR;
            goto scopeCmdDone;
        }

        doAppend = 1;
        if (contextIclsPtr->flags & ITCL_ECLASS) {
            if (strcmp(token, "itcl_options") == 0) {
	        doAppend = 0;
            }
        }

        objPtr2 = Tcl_NewStringObj((char*)NULL, 0);
        Tcl_IncrRefCount(objPtr2);
	Tcl_AppendToObj(objPtr2, ITCL_VARIABLES_NAMESPACE, -1);
	Tcl_AppendToObj(objPtr2,
		(Tcl_GetObjectNamespace(contextIoPtr->oPtr))->fullName, -1);

        if (doAppend) {
            Tcl_AppendToObj(objPtr2,

        var = Itcl_FindNamespaceVar(interp, token, contextNsPtr,
            TCL_NAMESPACE_ONLY);

        if (!var) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "variable \"", token, "\" not found in namespace \"",
                contextNsPtr->fullName, "\"",
                (char*)NULL);
            result = TCL_ERROR;
            goto scopeCmdDone;
        }

        Itcl_GetVariableFullName(interp, var, resultPtr);
        if (openParen) {
            *openParen = '(';

    int pos;

    ItclShowArgs(1, "Itcl_CodeCmd", objc, objv);
    /*
     *  Handle flags like "-namespace"...
     */
    for (pos=1; pos < objc; pos++) {
        token = Tcl_GetStringFromObj(objv[pos], (int*)NULL);
        if (*token != '-') {
            break;
        }

        if (strcmp(token, "-namespace") == 0) {
            if (objc == 2) {
                Tcl_WrongNumArgs(interp, 1, objv,
                    "?-namespace name? command ?arg arg...?");
                return TCL_ERROR;
            } else {
                token = Tcl_GetString(objv[pos+1]);
                contextNs = Tcl_FindNamespace(interp, token,
                    (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);

                if (!contextNs) {
                    return TCL_ERROR;
                }
                pos++;
            }
        } else {
	    if (strcmp(token, "--") == 0) {
                pos++;
                break;
            } else {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "bad option \"", token, "\": should be -namespace or --",
                    (char*)NULL);
                return TCL_ERROR;
            }
        }
    }

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv,
            "?-namespace name? command ?arg arg...?");
        return TCL_ERROR;
    }

    /*
     *  Now construct a scoped command by integrating the
     *  current namespace context, and appending the remaining
     *  arguments AS A LIST...
     */
    listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);

    Tcl_ListObjAppendElement(interp, listPtr,
        Tcl_NewStringObj("namespace", -1));
    Tcl_ListObjAppendElement(interp, listPtr,
        Tcl_NewStringObj("inscope", -1));

    if (contextNs == Tcl_GetGlobalNamespace(interp)) {

    ItclClass *iclsPtr;

    ItclShowArgs(1, "Itcl_ForwardAddCmd", objc, objv);
    if (objc < 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "<forwardName> <targetName> ?<arg> ...?");
        return TCL_ERROR;
    }
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    iclsPtr = (ItclClass*)Itcl_PeekStack(&infoPtr->clsStack);
    if (iclsPtr == NULL) {
	Tcl_HashEntry *hPtr;
        hPtr = Tcl_FindHashEntry(&infoPtr->nameClasses, (char *)objv[1]);
	if (hPtr == NULL) {
	    Tcl_AppendResult(interp, "class: \"", Tcl_GetString(objv[1]),
	            "\" not found", NULL);
	    return TCL_ERROR;
	}
        iclsPtr = Tcl_GetHashValue(hPtr);
    }
    prefixObj = Tcl_NewListObj(objc-2, objv+2);
    mPtr = Itcl_NewForwardClassMethod(interp, iclsPtr->clsPtr, 1,
            objv[1], prefixObj);
    if (mPtr == NULL) {
        return TCL_ERROR;
    }

    }
    hPtr = Tcl_FindHashEntry(&infoPtr->nameClasses, (char *)objv[1]);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "class \"", Tcl_GetString(objv[1]),
	        "\" not found", NULL);
        return TCL_ERROR;
    }
    iclsPtr = Tcl_GetHashValue(hPtr);
    protectionStr = Tcl_GetString(objv[2]);
    pLevel = -1;
    if (strcmp(protectionStr, "public") == 0) {
        pLevel = ITCL_PUBLIC;
    }
    if (strcmp(protectionStr, "protected") == 0) {
        pLevel = ITCL_PROTECTED;
    }
    if (strcmp(protectionStr, "private") == 0) {
        pLevel = ITCL_PRIVATE;
    }
    if (pLevel == -1) {
	Tcl_AppendResult(interp, "bad protection \"", protectionStr, "\"",
	        NULL);
        return TCL_ERROR;
    }
    Itcl_PushStack((ClientData)iclsPtr, &infoPtr->clsStack);
    result = Itcl_ClassOptionCmd(clientData, interp, objc-2, objv+2);
    Itcl_PopStack(&infoPtr->clsStack);
    if (result != TCL_OK) {
        return result;
    }
    result = DelegatedOptionsInstall(interp, iclsPtr);
    return result;

    }
    hPtr = Tcl_FindHashEntry(&infoPtr->objectCmds, (char *)cmd);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "object \"", Tcl_GetString(objv[1]),
	        "\" not found", NULL);
        return TCL_ERROR;
    }
    ioPtr = Tcl_GetHashValue(hPtr);
    protectionStr = Tcl_GetString(objv[2]);
    pLevel = -1;
    if (strcmp(protectionStr, "public") == 0) {
        pLevel = ITCL_PUBLIC;
    }
    if (strcmp(protectionStr, "protected") == 0) {
        pLevel = ITCL_PROTECTED;

    }
    hPtr = Tcl_FindHashEntry(&infoPtr->objectCmds, (char *)cmd);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "object \"", Tcl_GetString(objv[1]),
	        "\" not found", NULL);
        return TCL_ERROR;
    }
    ioPtr = Tcl_GetHashValue(hPtr);
    result = Itcl_HandleDelegateOptionCmd(interp, ioPtr, NULL, &idoPtr,
            objc-3, objv+3);
    if (result != TCL_OK) {
        return result;
    }
    hPtr = Tcl_CreateHashEntry(&ioPtr->objectDelegatedOptions,
            (char *)idoPtr->namePtr, &isNew);

    }
    hPtr = Tcl_FindHashEntry(&infoPtr->objectCmds, (char *)cmd);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "object \"", Tcl_GetString(objv[1]),
	        "\" not found", NULL);
        return TCL_ERROR;
    }
    ioPtr = Tcl_GetHashValue(hPtr);
    result = Itcl_HandleDelegateMethodCmd(interp, ioPtr, NULL, &idmPtr,
            objc-3, objv+3);
    if (result != TCL_OK) {
        return result;
    }
    componentNamePtr = idmPtr->icPtr->namePtr;
    Itcl_InitHierIter(&hier, ioPtr->iclsPtr);

        NULL, 0);
    hPtr = Tcl_FindHashEntry(&contextIclsPtr->variables, (char *)objv[2]);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "Itcl_AddComponentCmd cannot find component",
	        " \"", Tcl_GetString(objv[2]), "\"in class variables", NULL);
        return TCL_ERROR;
    }
    ivPtr = Tcl_GetHashValue(hPtr);
    /* add entry to the virtual tables */
    vlookup = (ItclVarLookup *)ckalloc(sizeof(ItclVarLookup));
    vlookup->ivPtr = ivPtr;
    vlookup->usage = 0;
    vlookup->leastQualName = NULL;

    /*

    Tcl_DStringInit(&buffer2);
    while (1) {
        hPtr = Tcl_CreateHashEntry(&contextIclsPtr->resolveVars,
            Tcl_DStringValue(&buffer), &isNew);

        if (isNew) {
            Tcl_SetHashValue(hPtr, (ClientData)vlookup);
            vlookup->usage++;

            if (!vlookup->leastQualName) {
                vlookup->leastQualName =
                    Tcl_GetHashKey(&contextIclsPtr->resolveVars, hPtr);
            }
        }

        if (nsPtr == NULL) {
            break;
        }

    contextIoPtr = NULL;
    ItclShowArgs(1, "Itcl_SetComponentCmd", objc, objv);
    if (objc < 4) {
        Tcl_WrongNumArgs(interp, 1, objv,
	        "objectName componentName value");
	return TCL_ERROR;
    }
    name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
    if (Itcl_FindObject(interp, name, &contextIoPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (contextIoPtr == NULL) {
	Tcl_AppendResult(interp, "Itcl_SetComponentCmd contextIoPtr "
	       "for \"", Tcl_GetString(objv[1]), "\" == NULL", NULL);
        return TCL_ERROR;

    }
    Itcl_DeleteHierIter(&hier);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "object \"", Tcl_GetString(objv[1]),
	        "\" has no component \"", Tcl_GetString(objv[2]), "\"", NULL);
        return TCL_ERROR;
    }
    icPtr = Tcl_GetHashValue(hPtr);
    val = ItclGetInstanceVar(interp, Tcl_GetString(icPtr->namePtr), NULL,
            contextIoPtr, contextIclsPtr);
    if ((val != NULL) && (strlen(val) != 0)) {
        /* delete delegated options to the old component here !! */
        Itcl_InitHierIter(&hier, contextIoPtr->iclsPtr);
        while ((iclsPtr = Itcl_AdvanceHierIter(&hier)) != NULL) {
            FOREACH_HASH_VALUE(idoPtr, &iclsPtr->delegatedOptions) {

    char *name;                 /* name of this part */
    Tcl_Obj *namePtr;
    Tcl_Command cmdPtr;         /* command handling this part */
    char *usage;                /* usage string describing syntax */
    struct Ensemble* ensemble;  /* ensemble containing this part */
    ItclArgList *arglistPtr;    /* the parsed argument list */
    Tcl_ObjCmdProc *objProc;    /* handling procedure for part */
    ClientData *clientData;     /* the procPtr for the part */
    Tcl_CmdDeleteProc *deleteProc;
                                /* procedure used to destroy client data */
    int minChars;               /* chars needed to uniquely identify part */
    int flags;
    Tcl_Interp *interp;
    Tcl_Obj *mapNamePtr;
    Tcl_Obj *subEnsemblePtr;

int
Itcl_EnsembleInit(
    Tcl_Interp *interp)         /* interpreter being initialized */
{
    Tcl_DString buffer;
    ItclObjectInfo *infoPtr;

    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    Tcl_CreateObjCommand(interp, "::itcl::ensemble",
        Itcl_EnsembleCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);

    Tcl_DStringInit(&buffer);
    Tcl_DStringAppend(&buffer, ITCL_COMMANDS_NAMESPACE, -1);
    Tcl_DStringAppend(&buffer, "::ensembles", -1);
    infoPtr->ensembleInfo->ensembleNsPtr = Tcl_CreateNamespace(interp,
            Tcl_DStringValue(&buffer), NULL, NULL);
    Tcl_DStringFree(&buffer);

    if (Tcl_SplitList(interp, (const char *)ensName, &nameArgc,
	    &nameArgv) != TCL_OK) {
        goto ensCreateFail;
    }
    if (nameArgc < 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "invalid ensemble name \"", ensName, "\"",
            (char*)NULL);
        goto ensCreateFail;
    }

    /*
     *  If there is more than one path component, then follow
     *  the path down to the last component, to find the containing
     *  ensemble.
     */
    parentEnsData = NULL;
    if (nameArgc > 1) {
        if (FindEnsemble(interp, nameArgv, nameArgc-1, &parentEnsData)
            != TCL_OK) {
            goto ensCreateFail;
        }

        if (parentEnsData == NULL) {
            char *pname = Tcl_Merge(nameArgc-1, nameArgv);
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "invalid ensemble name \"", pname, "\"",
                (char*)NULL);
            ckfree(pname);
            goto ensCreateFail;
        }
    }

    /*
     *  Create the ensemble.

        goto ensPartFail;
    }

    if (ensData == NULL) {
        char *pname = Tcl_Merge(nameArgc, nameArgv);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "invalid ensemble name \"", pname, "\"",
            (char*)NULL);
        ckfree(pname);
        goto ensPartFail;
    }

    /*
     *  Install the new part into the part list.
     */

    /*
     *  Build the trail of ensemble names leading to this part.
     */
    Tcl_DStringInit(&buffer);
    Itcl_InitList(&trail);
    for (part=ensPart; part; part=part->ensemble->parent) {
        Itcl_InsertList(&trail, (ClientData)part);
    }

    while (ensData->parent != NULL) {
        ensData = ensData->parent->ensemble;
    }
    cmdPtr = ensData->cmdPtr;
    name = Tcl_GetCommandName(interp, cmdPtr);

    int isNew;
    char buf[20];
    Tcl_Obj *unkObjPtr;

    /*
     *  Create the data associated with the ensemble.
     */
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    infoPtr->ensembleInfo->numEnsembles++;
    ensData = (Ensemble*)ckalloc(sizeof(Ensemble));
    memset(ensData, 0, sizeof(Ensemble));
    ensData->namePtr = Tcl_NewStringObj(ensName, -1);
    Tcl_IncrRefCount(ensData->namePtr);
    ensData->interp = interp;
    ensData->numParts = 0;

		Tcl_GetCurrentNamespace(interp), TCL_ENSEMBLE_PREFIX);
	hPtr = Tcl_CreateHashEntry(&infoPtr->ensembleInfo->ensembles,
		(char *)ensData->cmdPtr, &isNew);
	if (!isNew) {
	    result = TCL_ERROR;
	    goto finish;
	}
	Tcl_SetHashValue(hPtr, (ClientData)ensData);
	unkObjPtr = Tcl_NewStringObj(ITCL_COMMANDS_NAMESPACE, -1);
	Tcl_AppendToObj(unkObjPtr, "::ensembles::unknown", -1);
	if (Tcl_SetEnsembleUnknownHandler(NULL, ensData->cmdPtr,
		unkObjPtr) != TCL_OK) {
	    Tcl_DecrRefCount(unkObjPtr);
	    result = TCL_ERROR;
	    goto finish;
	}

	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&buffer), -1));
	result = TCL_OK;
	goto finish;
    }

    /*
     *  Otherwise, this ensemble is contained within another parent.
     *  Install the new ensemble as a part within its parent.
     */
    if (CreateEnsemblePart(interp, parentEnsData, ensName, &ensPart)
            != TCL_OK) {
        DeleteEnsemble((ClientData)ensData);
        result = TCL_ERROR;
        goto finish;
    }
    Tcl_DStringSetLength(&buffer, 0);
    Tcl_DStringAppend(&buffer, infoPtr->ensembleInfo->ensembleNsPtr->fullName, -1);
    Tcl_DStringAppend(&buffer, "::subensembles::", -1);
    sprintf(buf, "%d", parentEnsData->ensembleId);

            Tcl_GetCurrentNamespace(interp), TCL_ENSEMBLE_PREFIX);
    hPtr = Tcl_CreateHashEntry(&infoPtr->ensembleInfo->ensembles,
            (char *)ensPart->cmdPtr, &isNew);
    if (!isNew) {
        result = TCL_ERROR;
        goto finish;
    }
    Tcl_SetHashValue(hPtr, (ClientData)ensData);
    unkObjPtr = Tcl_NewStringObj(ITCL_COMMANDS_NAMESPACE, -1);
    Tcl_AppendToObj(unkObjPtr, "::ensembles::unknown", -1);
    if (Tcl_SetEnsembleUnknownHandler(NULL, ensPart->cmdPtr,
            unkObjPtr) != TCL_OK) {
        result = TCL_ERROR;
        goto finish;
    }

     *  Install the new part into the part list.
     */
    if (CreateEnsemblePart(interp, ensData, partName, &ensPart) != TCL_OK) {
        return TCL_ERROR;
    }

    if (usageInfo) {
        ensPart->usage = ckalloc((unsigned)(strlen(usageInfo)+1));
        strcpy(ensPart->usage, usageInfo);
    }
    ensPart->objProc = objProc;
    ensPart->clientData = clientData;
    ensPart->deleteProc = deleteProc;
    ensPart->flags = flags;

    while (ensData->numParts > 0) {
        DeleteEnsemblePart(ensData->parts[0]);
    }
    Tcl_DecrRefCount(ensData->namePtr);
    ckfree((char*)ensData->parts);
    ensData->parts = NULL;
    ensData->numParts = 0;
    infoPtr = Tcl_GetAssocData(ensData->interp, ITCL_INTERP_DATA, NULL);
    FOREACH_HASH_VALUE(ensData2, &infoPtr->ensembleInfo->ensembles) {
        if (ensData2 == ensData) {
            Tcl_DeleteHashEntry(hPtr);
	}
    }
    ckfree((char*)ensData);
}

    objPtr = Tcl_NewStringObj(nameArgv[0], -1);
    cmdPtr = Tcl_FindEnsemble(interp, objPtr, 0);
    Tcl_DecrRefCount(objPtr);

    if (cmdPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "command \"", nameArgv[0], "\" is not an ensemble",
            (char*)NULL);
        return TCL_ERROR;
    }
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->ensembles, (char *)cmdPtr);
    if (hPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "command \"", nameArgv[0], "\" is not an ensemble",
            (char*)NULL);
        return TCL_ERROR;
    }
    ensData = (Ensemble *)Tcl_GetHashValue(hPtr);

    /*
     *  Follow the trail of sub-ensemble names.
     */
    for (i=1; i < nameArgc; i++) {
        if (FindEnsemblePart(interp, ensData, nameArgv[i], &ensPart)
            != TCL_OK) {
            return TCL_ERROR;
        }
        if (ensPart == NULL) {
            char *pname = Tcl_Merge(i, nameArgv);
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "invalid ensemble name \"", pname, "\"",
                (char*)NULL);
            ckfree(pname);
            return TCL_ERROR;
        }

        cmdPtr = ensPart->cmdPtr;
        if (cmdPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "part \"", nameArgv[i], "\" is not an ensemble",
                (char*)NULL);
            return TCL_ERROR;
        }
	if (!Tcl_IsEnsemble(cmdPtr)) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "part \"", nameArgv[i], "\" is not an ensemble",
                (char*)NULL);
            return TCL_ERROR;
	}
        if (Tcl_GetCommandInfoFromToken(cmdPtr, &cmdInfo) != 1) {
            return TCL_ERROR;
        }
        ensData = (Ensemble*)cmdInfo.objClientData;
    }

    /*
     *  If a matching entry was found, then return an error.
     */
    if (FindEnsemblePartIndex(ensData, partName, &pos)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "part \"", partName, "\" already exists in ensemble",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Otherwise, make room for a new entry.  Keep the parts in
     *  lexicographical order, so we can search them quickly
     *  later.

    for (i=ensData->numParts; i > pos; i--) {
        ensData->parts[i] = ensData->parts[i-1];
    }
    ensData->numParts++;

    ensPart = (EnsemblePart*)ckalloc(sizeof(EnsemblePart));
    memset(ensPart, 0, sizeof(EnsemblePart));
    ensPart->name = (char*)ckalloc((unsigned)(strlen(partName)+1));
    strcpy(ensPart->name, partName);
    ensPart->namePtr = Tcl_NewStringObj(ensPart->name, -1);
    ensPart->ensemble = ensData;
    ensPart->interp = interp;

    ensData->parts[pos] = ensPart;

     */
    if ((ensPart->deleteProc != NULL) && (ensPart->clientData != NULL)) {
        (*ensPart->deleteProc)(ensPart->clientData);
    }

    /* if it is a subensemble remove the command to free the data */
    if (ensPart->subEnsemblePtr != NULL) {
        infoPtr = Tcl_GetAssocData(ensData->interp, ITCL_INTERP_DATA, NULL);
	hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->subEnsembles,
	        (char *)ensPart->subEnsemblePtr);
        if (hPtr != NULL) {
	    ensData2 = Tcl_GetHashValue(hPtr);
	    Tcl_DeleteNamespace(ensData2->nsPtr);
	    Tcl_DeleteHashEntry(hPtr);
	}
        Tcl_SetEnsembleUnknownHandler(NULL, ensPart->cmdPtr, NULL);
	hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->ensembles,
	        (char *)ensPart->ensemble->cmdPtr);
        if (hPtr != NULL) {
	    ensData2 = Tcl_GetHashValue(hPtr);
            Tcl_GetEnsembleMappingDict(NULL, ensData2->cmdPtr, &mapDict);
            if (mapDict != NULL) {
	        Tcl_DictObjRemove(ensPart->interp, mapDict,
	                ensPart->namePtr);
	        Tcl_SetEnsembleMappingDict(NULL, ensData2->cmdPtr, mapDict);
	    }
	}

            if (strncmp(partName, ensData->parts[pos]->name, nlen) != 0) {
                pos++;
                break;
            }
        }
    }
    if (nlen < ensData->parts[pos]->minChars) {
        Tcl_Obj *resultPtr = Tcl_NewStringObj((char*)NULL, 0);

        Tcl_AppendStringsToObj(resultPtr,
            "ambiguous option \"", partName, "\": should be one of...",
            (char*)NULL);

        for (i=pos; i < ensData->numParts; i++) {
            if (strncmp(partName, ensData->parts[i]->name, nlen) != 0) {
                break;
            }
            Tcl_AppendToObj(resultPtr, "\n  ", 3);
            GetEnsemblePartUsage(interp, ensData, ensData->parts[i], resultPtr);

    ItclShowArgs(1, "Itcl_EnsembleCmd", objc, objv);
    /*
     *  Make sure that an ensemble name was specified.
     */
    if (objc < 2) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"",
            Tcl_GetStringFromObj(objv[0], (int*)NULL),
            " name ?command arg arg...?\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this is the "ensemble" command in the main interpreter,
     *  then the client data will be null.  Otherwise, it is
     *  the "ensemble" command in the ensemble body parser, and

            if (FindEnsemblePart(ensInfo->master, ensData, ensName, &ensPart)
                    != TCL_OK) {
                Tcl_Panic("Itcl_EnsembleCmd: can't create ensemble");
            }
        }

        cmd = ensPart->cmdPtr;
        infoPtr = Tcl_GetAssocData(ensInfo->master, ITCL_INTERP_DATA, NULL);
        hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->ensembles,
	        (char *)ensPart->cmdPtr);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "part \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
                "\" is not an ensemble",
                (char*)NULL);
            return TCL_ERROR;
	}
        ensData = (Ensemble *)Tcl_GetHashValue(hPtr);
    } else {

        /*
         *  Otherwise, the desired ensemble is a top-level ensemble.
         *  Find or create the access command for the ensemble, and
         *  then get its data.
         */
        cmd = Tcl_FindCommand(interp, ensName, (Tcl_Namespace*)NULL, 0);
        if (cmd == NULL) {
            if (CreateEnsemble(interp, (Ensemble*)NULL, ensName)
                != TCL_OK) {
                return TCL_ERROR;
            }
            cmd = Tcl_FindCommand(interp, ensName, (Tcl_Namespace*)NULL, 0);
        }

        if (cmd == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "command \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
                "\" is not an ensemble",
                (char*)NULL);
            return TCL_ERROR;
        }
        infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
        hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->ensembles, (char *)cmd);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "command \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
                "\" is not an ensemble",
                (char*)NULL);
            return TCL_ERROR;
        }
        ensData = (Ensemble *)Tcl_GetHashValue(hPtr);
    }

    /*
     *  At this point, we have the data for the ensemble that is

     *  master interpreter.  If an error was encountered,
     *  copy the error info first, and then set the result.
     *  Otherwise, the offending command is reported twice.
     */
    if (status == TCL_ERROR) {
	/* no longer needed, no extra interpreter !! */
        const char *errInfo = Tcl_GetVar2(ensInfo->parser, "::errorInfo",
            (char*)NULL, TCL_GLOBAL_ONLY);

        if (errInfo) {
        	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(errInfo, -1));
        }

        if (objc == 3) {
	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(

    Tcl_DeleteNamespace(Tcl_GetGlobalNamespace(ensInfo->parser));
    /*
     *  Add the allowed commands to the parser interpreter:
     *  part, delete, ensemble
     */
    Tcl_CreateObjCommand(ensInfo->parser, "part", Itcl_EnsPartCmd,
        (ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);

    Tcl_CreateObjCommand(ensInfo->parser, "option", Itcl_EnsPartCmd,
        (ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);

    Tcl_CreateObjCommand(ensInfo->parser, "ensemble", Itcl_EnsembleCmd,
        (ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);

    /*
     *  Install the parser data, so we'll have it the next time
     *  we call this procedure.
     */
    (void) Tcl_SetAssocData(interp, "itcl_ensembleParser",
            DeleteEnsParser, (ClientData)ensInfo);

    return ensInfo;
}


/*
 *----------------------------------------------------------------------

    int maxArgc;
    Tcl_CmdInfo cmdInfo;

    ItclShowArgs(1, "Itcl_EnsPartCmd", objc, objv);
    if (objc != 4) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"",
            Tcl_GetStringFromObj(objv[0], (int*)NULL),
            " name args body\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Create a Tcl-style proc definition using the specified args
     *  and body.  This is not a proc in the usual sense.  It belongs
     *  to the namespace that contains the ensemble, but it is
     *  accessed through the ensemble, not through a Tcl command.
     */
    partName = Tcl_GetStringFromObj(objv[1], (int*)NULL);

    if (ItclCreateArgList(interp, Tcl_GetString(objv[2]), &argc, &maxArgc,
            &usagePtr, &arglistPtr, NULL, partName) != TCL_OK) {
	result = TCL_ERROR;
	goto errorOut;
    }
    if (Tcl_GetCommandInfoFromToken(ensData->cmdPtr, &cmdInfo) != 1) {

    /*
     *  Create a new part within the ensemble.  If successful,
     *  plug the command token into the proc; we'll need it later
     *  if we try to compile the Tcl code for the part.  If
     *  anything goes wrong, clean up before bailing out.
     */
    result = AddEnsemblePart(ensInfo->master, ensData, partName, usage,
        Tcl_GetObjInterpProc(), (ClientData)procPtr, _Tcl_ProcDeleteProc,
        ITCL_ENSEMBLE_ENSEMBLE, &ensPart);
    if (result == TCL_ERROR) {
	_Tcl_ProcDeleteProc(procPtr);
    }
    Tcl_TransferResult(ensInfo->master, result, interp);

errorOut:

    Ensemble *ensData = (Ensemble*)clientData;

    char *cmdName;
    Tcl_Obj *objPtr;

    cmdName = Tcl_GetString(objv[0]);

    objPtr = Tcl_NewStringObj((char*)NULL, 0);
    Tcl_AppendStringsToObj(objPtr,
        "bad option \"", cmdName, "\": should be one of...\n",
        (char*)NULL);
    GetEnsembleUsage(interp, ensData, objPtr);

    Tcl_SetObjResult(interp, objPtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * EnsembleSubCmd --
 *
 *----------------------------------------------------------------------
 */

static int
CallInvokeEnsembleMethod(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Namespace *nsPtr = data[0];
    EnsemblePart *ensPart = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj *const*objv = data[3];

    result = Itcl_InvokeEnsembleMethod(interp, nsPtr, ensPart->namePtr,
	        (Tcl_Proc *)ensPart->clientData, objc, objv);
    return result;
}

static int
CallInvokeEnsembleMethod2(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    EnsemblePart *ensPart = data[0];
    int objc = PTR2INT(data[1]);
    Tcl_Obj *const*objv = data[2];
    result = (*ensPart->objProc)(ensPart->clientData, interp, objc, objv);
    return result;
}

static int
EnsembleSubCmd(
    ClientData clientData,      /* ensPart struct pointer */

    nsPtr = Tcl_GetCurrentNamespace(interp);
    callbackPtr = Itcl_GetCurrentCallbackPtr(interp);
    if (ensPart->flags & ITCL_ENSEMBLE_ENSEMBLE) {
	/* FIXME !!! */
	if (ensPart->clientData == NULL) {
	    return TCL_ERROR;
	}
	Tcl_NRAddCallback(interp, CallInvokeEnsembleMethod, nsPtr, ensPart, INT2PTR(objc), (ClientData)objv);
    } else {
	Tcl_NRAddCallback(interp, CallInvokeEnsembleMethod2, ensPart, INT2PTR(objc), (ClientData)objv, NULL);
    }
    result = Itcl_NRRunCallbacks(interp, callbackPtr);
    return result;
}
/*
 * ------------------------------------------------------------------------
 *  EnsembleUnknownCmd()

    ItclShowArgs(2, "EnsembleUnknownCmd", objc, objv);
    cmd = Tcl_GetCommandFromObj(interp, objv[1]);
    if (cmd == NULL) {
        Tcl_AppendResult(interp, "EnsembleUnknownCmd, ensemble not found!",
	        Tcl_GetString(objv[1]), NULL);
        return TCL_ERROR;
    }
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->ensembles, (char *)cmd);
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "EnsembleUnknownCmd, ensemble struct not ",
	        "found!", Tcl_GetString(objv[1]), NULL);
        return TCL_ERROR;
    }
    ensData = (Ensemble *)Tcl_GetHashValue(hPtr);

    if (FindEnsemblePart(interp, ensData, "@error", &ensPart) != TCL_OK) {
        Tcl_AppendResult(interp, "FindEnsemblePart error", NULL);
        return TCL_ERROR;
    }
    if (ensPart != NULL) {
        Tcl_Obj *listPtr;

	listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
	Tcl_ListObjAppendElement(NULL, listPtr, objv[1]);
	Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj("@error", -1));
	Tcl_ListObjAppendElement(NULL, listPtr, objv[2]);
	Tcl_SetObjResult(interp, listPtr);
        return TCL_OK;
    }

        }
        hPtr = Tcl_FindHashEntry(&infoPtr->ensembleInfo->ensembles, (char *)cmdPtr);
        if (hPtr == NULL) {
            Tcl_AppendResult(interp, "no such ensemble \"",
	    Tcl_GetString(objv[i]), "\"", NULL);
            return TCL_ERROR;
        }
        ensData = Tcl_GetHashValue(hPtr);
        Itcl_RenameCommand(ensData->interp, Tcl_GetString(ensData->namePtr), "");
	if (Tcl_FindNamespace(interp, ensData->nsPtr->fullName, NULL, 0)
	        != NULL) {
	    Tcl_DeleteNamespace(ensData->nsPtr);
        }
    }
    return TCL_OK;

/*
 * itclHelpers.c --
 *
 * This file contains the C-implemeted part of 
 * Itcl 
 *
 * Copyright (c) 2007 by Arnulf P. Wiedemann
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

	        result = TCL_ERROR;
	        break;
	    }
	    if (defaultArgc > 2) {
	        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
	            "too many fields in argument specifier \"",
		    argv[i], "\"",
		    (char*)NULL);
		ckfree((char *) defaultArgv);
	        result = TCL_ERROR;
	        break;
	    }
	    if (strstr(defaultArgv[0],"::")) {
	        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		        "bad argument name \"", defaultArgv[0], "\"",
			(char*)NULL);
		ckfree((char *) defaultArgv);
		result = TCL_ERROR;
		break;
	    }
            arglistPtr = (ItclArgList *)ckalloc(sizeof(ItclArgList));
	    memset(arglistPtr, 0, sizeof(ItclArgList));
            if (*arglistPtrPtr == NULL) {
	         *arglistPtrPtr = arglistPtr;
	    } else {
	        lastArglistPtr->nextPtr = arglistPtr;
	        Tcl_AppendToObj(*usagePtr, " ", 1);
	    }
	    arglistPtr->namePtr = 
	            Tcl_NewStringObj(defaultArgv[0], -1);
	    Tcl_IncrRefCount(arglistPtr->namePtr);
	    (*maxArgcPtr)++;
	    if (defaultArgc == 1) {
		(*argcPtr)++;
	        arglistPtr->defaultValuePtr = NULL;
		if ((strcmp(defaultArgv[0], "args") == 0) && (i == argc-1)) {
		    hadArgsArgument = 1;
		    (*argcPtr)--;
	            Tcl_AppendToObj(*usagePtr, "?arg arg ...?", -1);
		} else {
	            Tcl_AppendToObj(*usagePtr, defaultArgv[0], -1);
	        }
	    } else {
	        arglistPtr->defaultValuePtr = 
		        Tcl_NewStringObj(defaultArgv[1], -1);
		Tcl_IncrRefCount(arglistPtr->defaultValuePtr);
	        Tcl_AppendToObj(*usagePtr, "?", 1);
	        Tcl_AppendToObj(*usagePtr, defaultArgv[0], -1);
	        Tcl_AppendToObj(*usagePtr, "?", 1);
	    }
            lastArglistPtr = arglistPtr;

        cmd = Tcl_FindCommand(interp, "unknown",
            (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);

        if (cmd == NULL) {
            Tcl_ResetResult(interp);
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "invalid command name \"",
                Tcl_GetStringFromObj(objv[0], NULL), "\"", NULL);
            return TCL_ERROR;
        }

        cmdlinePtr = Itcl_CreateArgs(interp, "unknown", objc, objv);
        Tcl_ListObjGetElements(NULL, cmdlinePtr, &cmdlinec, &cmdlinev);
    }

Tcl_Obj *
ItclCapitalize(
    const char *str)
{
    Tcl_Obj *objPtr;
    char buf[2];
    
    sprintf(buf, "%c", toupper(UCHAR(*str)));
    buf[1] = '\0';
    objPtr = Tcl_NewStringObj(buf, -1);
    Tcl_AppendToObj(objPtr, str+1, -1);
    return objPtr;
}
/*

    ItclCallContext *popped;

    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&infoPtr->frameContext,
	    (char *) framePtr);

    Itcl_Stack *stackPtr = (Itcl_Stack *) Tcl_GetHashValue(hPtr);

    popped = Itcl_PopStack(stackPtr);

    if (Itcl_GetStackSize(stackPtr) == 0) {
	Itcl_DeleteStack(stackPtr);
	ckfree((char *)stackPtr);
	Tcl_DeleteHashEntry(hPtr);
    }

NRInfoWrap(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_CmdInfo info;

    Tcl_Command token = (Tcl_Command) clientData;






    if (objc == 1) {
	/*
	 * No subcommand passed.  Give good usage message.  NOT the
	 * default message of a Tcl ensemble.
	 */

	ItclObjectInfo *infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
		ITCL_INTERP_DATA, NULL);
	Tcl_Obj *objPtr = Tcl_NewStringObj(
		"wrong # args: should be one of...\n", -1);
	ItclGetInfoUsage(interp, objPtr, infoPtr, NULL);
	Tcl_SetObjResult(interp, objPtr);
	return TCL_ERROR;
    }

    /* Have a subcommand.  Pass on to the ensemble */

    /*
     * WARNING! WARNING! WARNING!
     * We are doing NOTHING to guarantee that the command corresponding to
     * token has not been deleted.  If it is deleted, this will fail very
     * badly.  Another pass to plug up dependencies like this is in order.
     * I'm not bothering now because the code is already overflowing with
     * worse uncontrolled dependencies.  I'll clean the windows sometime
     * later when the cracks in the foundation are filled in.
     */
    Tcl_GetCommandInfoFromToken(token, &info);
    return Tcl_NRCallObjProc(interp, info.objProc, info.objClientData,
	    objc, objv);
}

static int
InfoWrap(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return Tcl_NRCallObjProc(interp, NRInfoWrap, clientData, objc, objv);
}

static void
InfoCmdDelete(
    ClientData clientData,
    Tcl_Interp *interp,
    const char *oldName,
    const char *newName,
    int flags)
{
    ItclObjectInfo *infoPtr = (ItclObjectInfo *)clientData;

    infoPtr->infoCmd = NULL;
}

int

        Tcl_Panic("ITCL: error in creating namespace: ::itcl::builtin::Info \n");
    }
    if (infoPtr->infoCmd) {
	Tcl_Panic("Double init of info ensemble");
    }
    token = Tcl_CreateEnsemble(interp, nsPtr->fullName, nsPtr,
        TCL_ENSEMBLE_PREFIX);
    Tcl_TraceCommand(interp, nsPtr->fullName, TCL_TRACE_DELETE,
	    InfoCmdDelete, (ClientData) infoPtr);
    infoPtr->infoCmd = token;
    token = Tcl_NRCreateCommand(interp, "::itcl::builtin::info", InfoWrap,
	    NRInfoWrap, token, NULL);
    Tcl_GetCommandInfoFromToken(token, &info);

    /*
     * Make the C implementation of the "info" ensemble available as
     * a method body.  This makes all [$object info] become the
     * equivalent of [::itcl::builtin::Info] without any need for
     * tailcall to restore the right frame [87a1bc6e82].
     */
    Itcl_RegisterObjC(interp, "itcl-builtin-info", info.objProc,
	info.objClientData, NULL);

    Tcl_Export(interp, nsPtr, "[a-z]*", 1);
    ensObjPtr = Tcl_NewStringObj("::itcl::builtin::Info", -1);

    for (i=0 ; InfoMethodList[i].name!=NULL ; i++) {
	Tcl_Obj *cmdObjPtr = Tcl_DuplicateObj(ensObjPtr);

	Tcl_AppendToObj(cmdObjPtr, "::", 2);
	Tcl_AppendToObj(cmdObjPtr, InfoMethodList[i].name, -1);
        Tcl_CreateObjCommand(interp, Tcl_GetString(cmdObjPtr),
                InfoMethodList[i].proc, infoPtr, NULL);

	Tcl_DecrRefCount(cmdObjPtr);
    }
    unkObjPtr = Tcl_NewStringObj("::itcl::builtin::Info::unknown", -1);
    Tcl_CreateObjCommand(interp, Tcl_GetString(unkObjPtr),
	    Itcl_BiInfoUnknownCmd, infoPtr, NULL);
    if (Tcl_SetEnsembleUnknownHandler(NULL,
            Tcl_FindEnsemble(interp, ensObjPtr, TCL_LEAVE_ERR_MSG),

	ClientData clientData;
        ItclObjectInfo *infoPtr;
        Tcl_Object oPtr;
	clientData = Itcl_GetCallFrameClientData(interp);
        infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
                ITCL_INTERP_DATA, NULL);
	if (clientData != NULL) {
            oPtr = Tcl_ObjectContextObject(clientData);
            contextIoPtr = Tcl_ObjectGetMetadata(oPtr,
	            infoPtr->object_meta_type);
            contextIclsPtr = contextIoPtr->iclsPtr;
	}
	if ((contextIoPtr == NULL) || (contextIclsPtr == NULL)) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "\nget info like this instead: " \
		    "\n  namespace eval className { info class }", -1));

    int result;
    int i;

    ItclShowArgs(1, "Itcl_BiInfoClassOptionsCmd", objc, objv);
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (objc > 2) {
	Tcl_AppendResult(interp, "wrong # args should be: info options ",
	        "?pattern?", NULL);
        return TCL_ERROR;
    }

    ItclShowArgs(1, "Itcl_BiInfoContextCmd", objc, objv);
    iclsPtr = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (ioPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get object context ", (char*)NULL);
        return TCL_ERROR;
    }
    listPtr = Tcl_NewListObj(0, NULL);
    objPtr = Tcl_NewStringObj(Tcl_GetString(iclsPtr->namePtr), -1);
    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
    objPtr = Tcl_NewStringObj(Tcl_GetString(ioPtr->namePtr), -1);
    Tcl_ListObjAppendElement(interp, listPtr, objPtr);

        return TCL_ERROR;
    }

    /*
     *  Return the list of base classes.
     */

    listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
    elem = Itcl_FirstListElem(&contextIclsPtr->bases);
    while (elem) {
	Tcl_Obj *objPtr;
	ItclClass *iclsPtr = (ItclClass*)Itcl_GetListValue(elem);
            objPtr = Tcl_NewStringObj(iclsPtr->nsPtr->fullName, -1);
        Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
        elem = Itcl_NextListElem(elem);
    }

    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}


        return TCL_ERROR;
    }

    /*
     *  Traverse through the derivation hierarchy and return
     *  base class names.
     */
    listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
    Itcl_InitHierIter(&hier, contextIclsPtr);
    while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
        if (iclsPtr->nsPtr == NULL) {
            Tcl_AppendResult(interp, "ITCL: iclsPtr->nsPtr == NULL",
	            Tcl_GetString(iclsPtr->fullNamePtr), NULL);
            return TCL_ERROR;
        }
            objPtr = Tcl_NewStringObj(iclsPtr->nsPtr->fullName, -1);
        Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
    }
    Itcl_DeleteHierIter(&hier);

    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

{
    char *cmdName = NULL;
    Tcl_Obj *resultPtr = NULL;
    Tcl_Obj *objPtr = NULL;

    static const char *options[] = {
        "-args", "-body", "-name", "-protection", "-type",
        (char*)NULL
    };
    enum BIfIdx {
        BIfArgsIdx, BIfBodyIdx, BIfNameIdx, BIfProtectIdx, BIfTypeIdx
    } *iflist, iflistStorage[5];

    static enum BIfIdx DefInfoFunction[5] = {
        BIfProtectIdx,

        entry = Tcl_FindHashEntry(&contextIclsPtr->resolveCmds, (char *)objPtr);
	Tcl_DecrRefCount(objPtr);
	objPtr = NULL;
        if (entry == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", cmdName, "\" isn't a member function in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }

	clookup = (ItclCmdLookup *)Tcl_GetHashValue(entry);
	imPtr = clookup->imPtr;
        mcode = imPtr->codePtr;

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (iflist[i]) {
                case BIfArgsIdx:
                    if (mcode && mcode->argListPtr) {
			if (imPtr->usagePtr == NULL) {

                    objPtr = Tcl_NewStringObj(val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available commands.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);

        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            entry = Tcl_FirstHashEntry(&iclsPtr->functions, &place);
            while (entry) {
	        int useIt = 1;

		            useIt = 0;
		        }
		    }
		}
		if (useIt) {
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(imPtr->fullNamePtr), -1);
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
		            resultPtr, objPtr);
                }

                entry = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

    char *varName;
    const char *val;
    int i;
    int result;

    static const char *options[] = {
        "-config", "-init", "-name", "-protection", "-type",
        "-value", (char*)NULL
    };
    enum BIvIdx {
        BIvConfigIdx, BIvInitIdx, BIvNameIdx, BIvProtectIdx,
        BIvTypeIdx, BIvValueIdx
    } *ivlist, ivlistStorage[6];

    static enum BIvIdx DefInfoVariable[5] = {

     */
    if (varName) {
        entry = ItclResolveVarEntry(contextIclsPtr, varName);
        if (entry == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", varName, "\" isn't a variable in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }

        vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
        ivPtr = vlookup->ivPtr;

        /*

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (ivlist[i]) {
                case BIvConfigIdx:
                    if (ivPtr->codePtr &&
		            Itcl_IsMemberCodeImplemented(ivPtr->codePtr)) {

                    /*
                     *  If this is the built-in "this" variable, then
                     *  report the object name as its initialization string.
                     */
                    if ((ivPtr->flags & ITCL_THIS_VAR) != 0) {
                        if ((contextIoPtr != NULL) &&
			        (contextIoPtr->accessCmd != NULL)) {
                            objPtr = Tcl_NewStringObj((char*)NULL, 0);
                            Tcl_GetCommandFullName(
                                contextIoPtr->iclsPtr->interp,
                                contextIoPtr->accessCmd, objPtr);
                        } else {
                            objPtr = Tcl_NewStringObj("<objectName>", -1);
                        }
                    } else {

                            if (objc > 1) {
			        Tcl_DecrRefCount(resultPtr);
			    }
                            Tcl_ResetResult(interp);
                            Tcl_AppendResult(interp,
                                    "cannot access object-specific info ",
                                    "without an object context",
                                    (char*)NULL);
                            return TCL_ERROR;
                        } else {
                            val = Itcl_GetInstanceVar(interp,
			            Tcl_GetString(ivPtr->namePtr),
                                    contextIoPtr, ivPtr->iclsPtr);
                        }
                    }
                    if (val == NULL) {
                        val = "<undefined>";
                    }
                    objPtr = Tcl_NewStringObj((const char *)val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
            }
        }
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, Tcl_GetString(resultPtr), NULL);
	Tcl_DecrRefCount(resultPtr);
    } else {

        /*
         *  Return the list of available variables.  Report the built-in
         *  "this" variable only once, for the most-specific class.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            entry = Tcl_FirstHashEntry(&iclsPtr->variables, &place);
            while (entry) {
                ivPtr = (ItclVariable*)Tcl_GetHashValue(entry);
                if ((ivPtr->flags & ITCL_THIS_VAR) != 0) {
                    if (iclsPtr == contextIclsPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(ivPtr->fullNamePtr), -1);
                        Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
                            resultPtr, objPtr);
                    }
                } else {
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(ivPtr->fullNamePtr), -1);
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
                        resultPtr, objPtr);
                }
                entry = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

	    if (hPtr != NULL) {
		Itcl_List varList;
		Tcl_Obj *resultListPtr;
		Tcl_Obj *namePtr;
		int numElems;

		Itcl_InitList(&varList);
		iclsPtr = Tcl_GetHashValue(hPtr);
		resultListPtr = Tcl_GetObjResult(interp);
		numElems = 0;
/* FIXME !! should perhaps skip ___DO_NOT_DELETE_THIS_VARIABLE here !! */
		FOREACH_HASH_VALUE(ivPtr, &iclsPtr->variables) {
		    if ((ivPtr->flags & ITCL_VARIABLE) != 0) {
		        if (head != NULL) {
		            namePtr = Tcl_NewStringObj(

	if (contextIclsPtr->flags &
	        (ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS)) {
	    hPtr = Tcl_FindHashEntry(&contextIclsPtr->delegatedFunctions,
	            (char *)objv[1]);
	}

    if (hPtr) {
	ItclDelegatedFunction *idmPtr = Tcl_GetHashValue(hPtr);
        Tcl_Obj *objPtr = Tcl_NewStringObj("delegated ", -1);

	if (idmPtr->flags & ITCL_TYPE_METHOD) {
	    what = "typemethod";
	}
	Tcl_AppendToObj(objPtr, what, -1);
	Tcl_AppendToObj(objPtr, " \"", -1);

    if (contextIclsPtr->flags
	    & (ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS)) {
	hPtr = Tcl_FindHashEntry(&contextIclsPtr->delegatedFunctions,
		(char *)objv[1]);
    }

    if (hPtr) {
	ItclDelegatedFunction *idmPtr = Tcl_GetHashValue(hPtr);
        Tcl_Obj *objPtr = Tcl_NewStringObj("delegated ", -1);

	if (idmPtr->flags & ITCL_TYPE_METHOD) {
	    what = "typemethod";
	}
	Tcl_AppendToObj(objPtr, what, -1);
	Tcl_AppendToObj(objPtr, " \"", -1);

    static const char *options[] = {
        "-cgetmethod", "-cgetmethodvar","-class",
	"-configuremethod", "-configuremethodvar",
	"-default",
	"-name", "-protection", "-resource",
	"-validatemethod", "-validatemethodvar",
        "-value", (char*)NULL
    };
    enum BOptIdx {
        BOptCgetMethodIdx,
        BOptCgetMethodVarIdx,
	BOptClassIdx,
	BOptConfigureMethodIdx,
	BOptConfigureMethodVarIdx,

    /*
     *  Return info for a specific option.
     */
    if (optionName) {
	if (contextIoPtr == NULL) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "cannot access object-specific info ",
		    "without an object context", (char*)NULL);
	    return TCL_ERROR;
	}
	optionNamePtr = Tcl_NewStringObj(optionName, -1);
        hPtr = Tcl_FindHashEntry(&contextIoPtr->objectOptions,
	        (char *)optionNamePtr);
        Tcl_DecrRefCount(optionNamePtr);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "\"", optionName, "\" isn't a option in object \"",
                Tcl_GetString(contextIoPtr->namePtr), "\"",
                (char*)NULL);
            return TCL_ERROR;
        }
        ioptPtr = (ItclOption*)Tcl_GetHashValue(hPtr);

        /*
         *  By default, return everything.
         */

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (ioptlist[i]) {
                case BOptCgetMethodIdx:
                    if (ioptPtr->cgetMethodPtr) {
                        objPtr = Tcl_NewStringObj(

                case BOptValueIdx:
		    if (contextIoPtr == NULL) {
                        Tcl_ResetResult(interp);
                        Tcl_AppendResult(interp,
                                "cannot access object-specific info ",
                                "without an object context",
                                (char*)NULL);
                        return TCL_ERROR;
                    } else {
                        val = ItclGetInstanceVar(interp, "itcl_options",
		                Tcl_GetString(ioptPtr->namePtr),
                                    contextIoPtr, ioptPtr->iclsPtr);
                    }
                    if (val == NULL) {
                        val = "<undefined>";
                    }
                    objPtr = Tcl_NewStringObj((const char *)val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
                    objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available options.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->options, &place);
            while (hPtr) {
                ioptPtr = (ItclOption*)Tcl_GetHashValue(hPtr);
                objPtr = ioptPtr->namePtr;
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }

{
    char *componentName = NULL;
    Tcl_Obj *resultPtr = NULL;
    Tcl_Obj *objPtr = NULL;
    Tcl_Obj *componentNamePtr;

    static const char *components[] = {
	"-name", "-inherit", "-value", (char*)NULL
    };
    enum BCompIdx {
	BCompNameIdx, BCompInheritIdx, BCompValueIdx
    } *icomplist, icomplistStorage[3];

    static enum BCompIdx DefInfoComponent[3] = {
        BCompNameIdx,

    infoPtr = contextIclsPtr->infoPtr;
    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)nsPtr);
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "cannot find class name for namespace \"",
	        nsPtr->fullName, "\"", NULL);
	return TCL_ERROR;
    }
    contextIclsPtr = Tcl_GetHashValue(hPtr);

    /*
     *  Process args:
     *  ?componentName? ?-inherit? ?-name? ?-value?
     */
    objv++;  /* skip over command name */
    objc--;

	}
	Tcl_DecrRefCount(componentNamePtr);
	Itcl_DeleteHierIter(&hier);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", componentName, "\" isn't a component in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }
        icPtr = (ItclComponent *)Tcl_GetHashValue(hPtr);

        /*
         *  By default, return everything.
         */

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (icomplist[i]) {
                case BCompNameIdx:
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(icPtr->ivPtr->fullNamePtr), -1);

                case BCompValueIdx:
		    if (contextIoPtr == NULL) {
                        Tcl_ResetResult(interp);
                        Tcl_AppendResult(interp,
                                "cannot access object-specific info ",
                                "without an object context",
                                (char*)NULL);
                        return TCL_ERROR;
                    } else {
                        val = ItclGetInstanceVar(interp,
			        Tcl_GetString(icPtr->namePtr), NULL,
                                    contextIoPtr, icPtr->ivPtr->iclsPtr);
                    }
                    if (val == NULL) {
                        val = "<undefined>";
                    }
                    objPtr = Tcl_NewStringObj((const char *)val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
                    objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available components.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->components, &place);
            while (hPtr) {
                icPtr = (ItclComponent *)Tcl_GetHashValue(hPtr);
                objPtr = Tcl_NewStringObj(
		        Tcl_GetString(icPtr->ivPtr->fullNamePtr), -1);
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }

    ItclObject *contextIoPtr;
    char *name;

    ItclShowArgs(1, "Itcl_BiInfoWidgetCmd", objc, objv);
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"info widget\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        /* try it the hard way */
	ClientData clientData;
        ItclObjectInfo *infoPtr;
        Tcl_Object oPtr;
	clientData = Itcl_GetCallFrameClientData(interp);
        infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
                ITCL_INTERP_DATA, NULL);
	if (clientData != NULL) {
            oPtr = Tcl_ObjectContextObject(clientData);
            contextIoPtr = Tcl_ObjectGetMetadata(oPtr,
	            infoPtr->object_meta_type);
            contextIclsPtr = contextIoPtr->iclsPtr;
	}
	if ((contextIoPtr == NULL) || (contextIclsPtr == NULL)) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "\nget info like this instead: "
		    "\n  namespace eval className { info widget ... }", -1));

    ClientData clientData, /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
#ifdef NOTYET
    static const char *components[] = {
	"-name", "-inherit", "-value", (char*)NULL
    };
    enum BCompIdx {
	BCompNameIdx, BCompInheritIdx, BCompValueIdx
    } *icomplist, icomplistStorage[3];

    static enum BCompIdx DefInfoComponent[3] = {
        BCompNameIdx,

    ClientData clientData, /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
#ifdef NOTYET
    static const char *components[] = {
	"-name", "-inherit", "-value", (char*)NULL
    };
    enum BCompIdx {
	BCompNameIdx, BCompInheritIdx, BCompValueIdx
    } *icomplist, icomplistStorage[3];

    static enum BCompIdx DefInfoComponent[3] = {
        BCompNameIdx,

    ItclObject *contextIoPtr;
    char *name;

    ItclShowArgs(1, "Itcl_BiInfoTypeCmd", objc, objv);
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"info type\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        /* try it the hard way */
	ClientData clientData;
        ItclObjectInfo *infoPtr;
        Tcl_Object oPtr;
	clientData = Itcl_GetCallFrameClientData(interp);
        infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
                ITCL_INTERP_DATA, NULL);
	if (clientData != NULL) {
            oPtr = Tcl_ObjectContextObject(clientData);
            contextIoPtr = Tcl_ObjectGetMetadata(oPtr,
	            infoPtr->object_meta_type);
            contextIclsPtr = contextIoPtr->iclsPtr;
	}
	if ((contextIoPtr == NULL) || (contextIclsPtr == NULL)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "\nget info like this instead: "
		    "\n  namespace eval className { info type ...}", -1));

    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

    ItclShowArgs(1, "Itcl_BiInfoHullTypeCmd", objc, objv);
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"info hulltype\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        /* try it the hard way */
	ClientData clientData;
        ItclObjectInfo *infoPtr;
        Tcl_Object oPtr;
	clientData = Itcl_GetCallFrameClientData(interp);
        infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
                ITCL_INTERP_DATA, NULL);
	if (clientData != NULL) {
            oPtr = Tcl_ObjectContextObject(clientData);
            contextIoPtr = Tcl_ObjectGetMetadata(oPtr,
	            infoPtr->object_meta_type);
            contextIclsPtr = contextIoPtr->iclsPtr;
	}
	if ((contextIoPtr == NULL) || (contextIclsPtr == NULL)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "\nget info like this instead: "
		    "\n  namespace eval className { info hulltype ... }", -1));

    const char *val;
    char *cmdName;
    int i;
    int result;

    static const char *options[] = {
        "-args", "-body", "-name", "-protection", "-type",
        (char*)NULL
    };
    enum BIfIdx {
        BIfArgsIdx, BIfBodyIdx, BIfNameIdx, BIfProtectIdx, BIfTypeIdx
    } *iflist, iflistStorage[5];

    static enum BIfIdx DefInfoFunction[5] = {
        BIfProtectIdx,

        hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveCmds, (char *)objPtr);
	Tcl_DecrRefCount(objPtr);
	objPtr = NULL;
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", cmdName, "\" isn't a method in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }

	clookup = (ItclCmdLookup *)Tcl_GetHashValue(hPtr);
	imPtr = clookup->imPtr;
        mcode = imPtr->codePtr;
        if (imPtr->flags & ITCL_COMMON) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", cmdName, "\" isn't a method in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
	}

        /*
         *  By default, return everything.
         */
        if (objc == 0) {

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (iflist[i]) {
                case BIfArgsIdx:
                    if (mcode && mcode->argListPtr) {
			if (imPtr->usagePtr == NULL) {

                    objPtr = Tcl_NewStringObj(val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available commands.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);

        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->functions, &place);
            while (hPtr) {
	        int useIt = 1;

                imPtr = (ItclMemberFunc*)Tcl_GetHashValue(hPtr);
		if (!(imPtr->flags & ITCL_METHOD)) {
		    useIt = 0;
		}
		if (useIt) {
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(imPtr->fullNamePtr), -1);
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
		            resultPtr, objPtr);
                }

                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

    const char *name;
    const char *pattern;

    ItclShowArgs(1, "Itcl_BiInfoMethodsCmd", objc, objv);
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);

    int result;
    int i;

    ItclShowArgs(1, "Itcl_BiInfoOptionsCmd", objc, objv);
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc > 2) {
	Tcl_AppendResult(interp, "wrong # args should be: info options ",

    const char *name;
    const char *pattern;

    ItclShowArgs(1, "Itcl_BiInfoComponentsCmd", objc, objv);
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (iclsPtr == NULL) {
        Tcl_AppendResult(interp, "INTERNAL ERROR in Itcl_BiInfoComponentsCmd",

    const char *val;
    char *cmdName;
    int i;
    int result;

    static const char *options[] = {
        "-args", "-body", "-name", "-protection", "-type",
        (char*)NULL
    };
    enum BIfIdx {
        BIfArgsIdx, BIfBodyIdx, BIfNameIdx, BIfProtectIdx, BIfTypeIdx
    } *iflist, iflistStorage[5];

    static enum BIfIdx DefInfoFunction[5] = {
        BIfProtectIdx,

        hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveCmds, (char *)objPtr);
	Tcl_DecrRefCount(objPtr);
	objPtr = NULL;
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", cmdName, "\" isn't a typemethod in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }

	clookup = (ItclCmdLookup *)Tcl_GetHashValue(hPtr);
	imPtr = clookup->imPtr;
        mcode = imPtr->codePtr;
	if (!(imPtr->flags & ITCL_TYPE_METHOD)) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", cmdName, "\" isn't a typemethod in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
	}

        /*
         *  By default, return everything.
         */
        if (objc == 0) {

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (iflist[i]) {
                case BIfArgsIdx:
                    if (mcode && mcode->argListPtr) {
			if (imPtr->usagePtr == NULL) {

                    objPtr = Tcl_NewStringObj(val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available commands.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);

        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->functions, &place);
            while (hPtr) {
	        int useIt = 1;

                imPtr = (ItclMemberFunc*)Tcl_GetHashValue(hPtr);
		if (!(imPtr->flags & ITCL_TYPE_METHOD)) {
		    useIt = 0;
		}
		if (useIt) {
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(imPtr->fullNamePtr), -1);
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
		            resultPtr, objPtr);
                }

                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

    const char *name;
    const char *pattern;

    ItclShowArgs(1, "Itcl_BiInfoTypeMethodsCmd", objc, objv);
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc > 1) {
        pattern = Tcl_GetString(objv[1]);

	Tcl_AppendResult(interp,
	        "wrong # args should be: info typevars ?pattern?", NULL);
        return TCL_ERROR;
    }
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);

    char *varName;
    const char *val;
    int i;
    int result;

    static const char *options[] = {
        "-init", "-name", "-protection", "-type",
        "-value", (char*)NULL
    };
    enum BIvIdx {
        BIvInitIdx,
	BIvNameIdx,
	BIvProtectIdx,
        BIvTypeIdx,
	BIvValueIdx

     */
    if (varName) {
        hPtr = ItclResolveVarEntry(contextIclsPtr, varName);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", varName, "\" isn't a typevariable in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
        }
        vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
        ivPtr = vlookup->ivPtr;
        if (!(ivPtr->flags & ITCL_TYPE_VARIABLE)) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", varName, "\" isn't a typevariable in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                (char*)NULL);
            return TCL_ERROR;
	}
        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            ivlist = DefInfoVariable;

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (ivlist[i]) {
                case BIvInitIdx:
                    /*
                     *  If this is the built-in "this" variable, then
                     *  report the object name as its initialization string.
                     */
                    if ((ivPtr->flags & ITCL_THIS_VAR) != 0) {
                        if ((contextIoPtr != NULL) &&
			        (contextIoPtr->accessCmd != NULL)) {
                            objPtr = Tcl_NewStringObj((char*)NULL, 0);
                            Tcl_GetCommandFullName(
                                contextIoPtr->iclsPtr->interp,
                                contextIoPtr->accessCmd, objPtr);
                        } else {
                            objPtr = Tcl_NewStringObj("<objectName>", -1);
                        }
                    } else {

                            if (objc > 1) {
			        Tcl_DecrRefCount(resultPtr);
			    }
                            Tcl_ResetResult(interp);
                            Tcl_AppendResult(interp,
                                    "cannot access object-specific info ",
                                    "without an object context",
                                    (char*)NULL);
                            return TCL_ERROR;
                        } else {
                            val = Itcl_GetInstanceVar(interp,
			            Tcl_GetString(ivPtr->namePtr),
                                    contextIoPtr, ivPtr->iclsPtr);
                        }
                    }
                    if (val == NULL) {
                        val = "<undefined>";
                    }
                    objPtr = Tcl_NewStringObj((const char *)val, -1);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
            }
        }
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, Tcl_GetString(resultPtr), NULL);
	Tcl_DecrRefCount(resultPtr);
    } else {

        /*
         *  Return the list of available variables.  Report the built-in
         *  "this" variable only once, for the most-specific class.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->variables, &place);
            while (hPtr) {
                ivPtr = (ItclVariable*)Tcl_GetHashValue(hPtr);
		if (ivPtr->flags & ITCL_TYPE_VAR) {
                    if ((ivPtr->flags & ITCL_THIS_VAR) != 0) {
                        if (iclsPtr == contextIclsPtr) {
                            objPtr = Tcl_NewStringObj(
			            Tcl_GetString(ivPtr->fullNamePtr), -1);
                            Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
                                resultPtr, objPtr);
                        }
                    } else {
                        objPtr = Tcl_NewStringObj(
		                Tcl_GetString(ivPtr->fullNamePtr), -1);
                        Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
                            resultPtr, objPtr);
                    }
		}
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

    ItclObject *contextIoPtr;
    char *name;

    ItclShowArgs(1, "Itcl_BiInfoWidgetadaptorCmd", objc, objv);
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"info widgetadaptor\"",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        /* try it the hard way */
	ClientData clientData;
        ItclObjectInfo *infoPtr;
        Tcl_Object oPtr;
	clientData = Itcl_GetCallFrameClientData(interp);
        infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
                ITCL_INTERP_DATA, NULL);
	if (clientData != NULL) {
            oPtr = Tcl_ObjectContextObject(clientData);
            contextIoPtr = Tcl_ObjectGetMetadata(oPtr,
	            infoPtr->object_meta_type);
            contextIclsPtr = contextIoPtr->iclsPtr;
	}
	if ((contextIoPtr == NULL) || (contextIclsPtr == NULL)) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "\nget info like this instead: "
		    "\n  namespace eval className { info widgetadaptor ... }", -1));

	Tcl_AppendResult(interp,
	        "wrong # args should be: info instances ?pattern?", NULL);
        return TCL_ERROR;
    }
    iclsPtr = NULL;
    pattern = NULL;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        Tcl_AppendResult(interp, "cannot get context ", (char*)NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);

    ItclClass *iclsPtr;
    char *optionName;
    int i;
    int result;

    static const char *options[] = {
        "-as", "-class", "-component", "-exceptions",
	"-name", "-resource", (char*)NULL
    };
    enum BOptIdx {
        BOptAsIdx, BOptClassIdx, BOptComponentIdx, BOptExceptionsIdx,
	BOptNameIdx, BOptResourceIdx
    } *ioptlist, ioptlistStorage[6];

    static enum BOptIdx DefInfoOption[6] = {

    infoPtr = contextIclsPtr->infoPtr;
    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)nsPtr);
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "cannot find class name for namespace \"",
	        nsPtr->fullName, "\"", NULL);
	return TCL_ERROR;
    }
    contextIclsPtr = Tcl_GetHashValue(hPtr);

    /*
     *  Process args:
     *  ?optionName? ?-name? ?-resource? ?-class?
     * ?-as? ?-exceptions?
     */
    objv++;  /* skip over command name */

    /*
     *  Return info for a specific option.
     */
    if (optionName) {
	if (contextIoPtr == NULL) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "cannot access object-specific info ",
		    "without an object context", (char*)NULL);
	    return TCL_ERROR;
	}
	optionNamePtr = Tcl_NewStringObj(optionName, -1);
        hPtr = Tcl_FindHashEntry(&contextIoPtr->objectDelegatedOptions,
	        (char *)optionNamePtr);
        Tcl_DecrRefCount(optionNamePtr);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "\"", optionName, "\" isn't an option in object \"",
                Tcl_GetString(contextIoPtr->namePtr), "\"",
                (char*)NULL);
            return TCL_ERROR;
        }
        idoptPtr = (ItclDelegatedOption*)Tcl_GetHashValue(hPtr);

        /*
         *  By default, return everything.
         */

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (ioptlist[i]) {
                case BOptAsIdx:
                    if (idoptPtr->asPtr) {
                        objPtr = Tcl_NewStringObj(

                    break;

            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
                    objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available options.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->delegatedOptions, &place);
            while (hPtr) {
                idoptPtr = (ItclDelegatedOption*)Tcl_GetHashValue(hPtr);
                objPtr = idoptPtr->namePtr;
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }

    ItclClass *iclsPtr;
    char *cmdName;
    int i;
    int result;

    static const char *options[] = {
        "-as", "-component", "-exceptions",
	"-name", "-using", (char*)NULL
    };
    enum BOptIdx {
        BOptAsIdx,
	BOptComponentIdx,
	BOptExceptionsIdx,
	BOptNameIdx,
	BOptUsingIdx

	            (char *)cmdNamePtr);
	}
	Tcl_DecrRefCount(cmdNamePtr);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "\"", cmdName, "\" isn't a delegated method in object \"",
                Tcl_GetString(contextIoPtr->namePtr), "\"",
                (char*)NULL);
            return TCL_ERROR;
        }
        idmPtr = (ItclDelegatedFunction*)Tcl_GetHashValue(hPtr);
        if (!(idmPtr->flags & ITCL_METHOD)) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "\"", cmdName, "\" isn't a delegated method in object \"",
                Tcl_GetString(contextIoPtr->namePtr), "\"",
                (char*)NULL);
            return TCL_ERROR;
	}
        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            ioptlist = DefInfoOption;

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (ioptlist[i]) {
                case BOptAsIdx:
                    if (idmPtr->asPtr) {
                        objPtr = Tcl_NewStringObj(

                    break;

            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
                    objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available options.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->delegatedFunctions, &place);
            while (hPtr) {
                idmPtr = (ItclDelegatedFunction *)Tcl_GetHashValue(hPtr);
		if (idmPtr->flags & ITCL_METHOD) {
                    objPtr = idmPtr->namePtr;
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
		            objPtr);
		}
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

    ItclClass *iclsPtr;
    char *cmdName;
    int i;
    int result;

    static const char *options[] = {
        "-as", "-component", "-exceptions",
	"-name", "-using", (char*)NULL
    };
    enum BOptIdx {
        BOptAsIdx,
	BOptComponentIdx,
	BOptExceptionsIdx,
	BOptNameIdx,
	BOptUsingIdx

	}
	Tcl_DecrRefCount(cmdNamePtr);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "\"", cmdName, "\" isn't a delegated typemethod in ",
		contextIoPtr ? "object \"" : "class \"",
		contextIoPtr ?  Tcl_GetString(contextIoPtr->namePtr)
		: Tcl_GetString(contextIclsPtr->namePtr), "\"", (char*)NULL);
            return TCL_ERROR;
        }
        idmPtr = (ItclDelegatedFunction*)Tcl_GetHashValue(hPtr);
        if (!(idmPtr->flags & ITCL_TYPE_METHOD)) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                 "\"", cmdName, "\" isn't a delegated typemethod in ",
		contextIoPtr ? "object \"" : "class \"",
		contextIoPtr ?  Tcl_GetString(contextIoPtr->namePtr)
		: Tcl_GetString(contextIclsPtr->namePtr), "\"", (char*)NULL);
            return TCL_ERROR;
	}
        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            ioptlist = DefInfoOption;

                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        }

        for (i=0 ; i < objc; i++) {
            switch (ioptlist[i]) {
                case BOptAsIdx:
                    if (idmPtr->asPtr) {
                        objPtr = Tcl_NewStringObj(

                    break;

            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
                    objPtr);
            }
        }
        Tcl_SetObjResult(interp, resultPtr);
    } else {

        /*
         *  Return the list of available options.
         */
        resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
        Itcl_InitHierIter(&hier, contextIclsPtr);
        while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
            hPtr = Tcl_FirstHashEntry(&iclsPtr->delegatedFunctions, &place);
            while (hPtr) {
                idmPtr = (ItclDelegatedFunction *)Tcl_GetHashValue(hPtr);
		if (idmPtr->flags & ITCL_TYPE_METHOD) {
                    objPtr = idmPtr->namePtr;
                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
		            objPtr);
		}
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

#endif

/*
 * MSVC 8.0 started to mark many standard C library functions depreciated
 * including the *printf family and others. Tell it to shut up.
 * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0)
 */
#if defined(_MSC_VER) && (_MSC_VER >= 1400)
#   pragma warning(disable:4244)

#   pragma warning(disable:4267)
#   pragma warning(disable:4996)

#endif

/*
 * Since the Tcl/Tk distribution doesn't perform any asserts,
 * dynamic loading can fail to find the __assert function.
 * As a workaround, we'll include our own.
 */

 * only iterates over values.
 */

#define FOREACH_HASH_DECLS \
    Tcl_HashEntry *hPtr;Tcl_HashSearch search
#define FOREACH_HASH(key,val,tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
            ((key)=(void *)Tcl_GetHashKey((tablePtr),hPtr),\
            (val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search))
#define FOREACH_HASH_VALUE(val,tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
            ((val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search))

/*
 * What sort of size of things we like to allocate.
 */

#define ALLOC_CHUNK 8

#define ITCL_INT_NAMESPACE	    ITCL_NAMESPACE"::internal"
#define ITCL_INTDICTS_NAMESPACE	    ITCL_INT_NAMESPACE"::dicts"
#define ITCL_VARIABLES_NAMESPACE    ITCL_INT_NAMESPACE"::variables"
#define ITCL_COMMANDS_NAMESPACE	    ITCL_INT_NAMESPACE"::commands"

#ifdef ITCL_PRESERVE_DEBUG
#define ITCL_PRESERVE_BUCKET_SIZE 50
#define ITCL_PRESERVE_INCR 1
#define ITCL_PRESERVE_DECR -1
#define ITCL_PRESERVE_DELETED 0

typedef struct ItclPreserveInfoEntry {
    int type;
    int line;
    const char * fileName;
} ItclPreserveInfoEntry;

typedef struct ItclPreserveInfo {
    size_t refCount;
    ClientData clientData;
    size_t size;
    size_t numEntries;
    ItclPreserveInfoEntry *entries;
} ItclPreserveInfo;

#endif


typedef struct ItclFoundation {
    Itcl_Stack methodCallStack;
    Tcl_Command dispatchCommand;
} ItclFoundation;

typedef struct ItclArgList {

    int currClassFlags;             /* flags for the class just in creation */
    int buildingWidget;             /* set if in construction of a widget */
    int unparsedObjc;               /* number options not parsed by
                                       ItclExtendedConfigure/-Cget function */
    Tcl_Obj **unparsedObjv;         /* options not parsed by
                                       ItclExtendedConfigure/-Cget function */
    int functionFlags;              /* used for creating of ItclMemberCode */
    int activeHash;                 /* Hash tables are not yet delted */
    struct ItclDelegatedOption *currIdoPtr;
                                    /* the current delegated option info */
    int inOptionHandling;           /* used to indicate for type/widget ...
                                     * that there is an option processing
				     * and methods are allowed to be called */
            /* these are the Tcl_Obj Ptrs for the clazz unknown procedure */
	    /* need to store them to be able to free them at the end */
    int itclWidgetInitted;          /* set to 1 if itclWidget.tcl has already
                                     * been called
				     */
    int itclHullCmdsInitted;        /* set to 1 if itclHullCmds.tcl has already
                                     * been called
				     */
    Tcl_Obj *unused2;
    Tcl_Obj *unused3;
    Tcl_Obj *unused4;
    Tcl_Obj *infoVarsPtr;
    Tcl_Obj *infoVars3Ptr;
    Tcl_Obj *infoVars4Ptr;
    Tcl_Obj *typeDestructorArgumentPtr;
    struct ItclObject *lastIoPtr;   /* last object constructed */
    Tcl_Command infoCmd;
} ItclObjectInfo;

typedef struct EnsembleInfo {

#define ITCL_WIDGET_TOPLEVEL	            0x100
#define ITCL_WIDGET_TTK_FRAME               0x200
#define ITCL_WIDGET_TTK_LABEL_FRAME	    0x400
#define ITCL_WIDGET_TTK_TOPLEVEL            0x800
#define ITCL_CLASS_IS_DELETED              0x1000
#define ITCL_CLASS_IS_DESTROYED            0x2000
#define ITCL_CLASS_NS_IS_DESTROYED         0x4000
#define ITCL_CLASS_IS_RENAMED              0x8000
#define ITCL_CLASS_IS_FREED               0x10000
#define ITCL_CLASS_DERIVED_RELEASED       0x20000
#define ITCL_CLASS_NS_TEARDOWN            0x40000
#define ITCL_CLASS_NO_VARNS_DELETE        0x80000
#define ITCL_CLASS_SHOULD_VARNS_DELETE   0x100000
#define ITCL_CLASS_DESTRUCTOR_CALLED     0x400000

    Tcl_Obj *hullWindowNamePtr;   /* the window path name for the hull
                                   * (before renaming in installhull) */
    int destructorHasBeenCalled;  /* is set when the destructor is called
                                   * to avoid callin destructor twice */
    int noComponentTrace;         /* don't call component traces if
                                   * setting components in DelegationInstall */
    int hadConstructorError;      /* needed for multiple calls of CallItclObjectCmd */
    int refCount;
} ItclObject;

#define ITCL_IGNORE_ERRS  0x002  /* useful for construction/destruction */

typedef struct ItclResolveInfo {
    int flags;
    ItclClass *iclsPtr;

    Tcl_Obj *bodyPtr;           /* the function body */
    ItclArgList *argListPtr;    /* the parsed arguments */
    union {
        Tcl_CmdProc *argCmd;    /* (argc,argv) C implementation */
        Tcl_ObjCmdProc *objCmd; /* (objc,objv) C implementation */
    } cfunc;
    ClientData clientData;      /* client data for C implementations */
    int refCount;
} ItclMemberCode;

/*
 *  Flag bits for ItclMemberCode:
 */
#define ITCL_IMPLEMENT_NONE    0x001  /* no implementation */
#define ITCL_IMPLEMENT_TCL     0x002  /* Tcl implementation */

    Tcl_Obj *origArgsPtr;       /* the argument string of the original definition */
    Tcl_Obj *bodyPtr;           /* the function body */
    ItclArgList *argListPtr;    /* the parsed arguments */
    ItclClass *declaringClassPtr; /* the class which declared the method/proc */
    ClientData tmPtr;           /* TclOO methodPtr */
    ItclDelegatedFunction *idmPtr;
                                /* if the function is delegated != NULL */
    int refCount;
} ItclMemberFunc;

/*
 *  Instance variables.
 */
typedef struct ItclVariable {
    Tcl_Obj *namePtr;           /* member name */