/*
 * 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.
 */

#include "itclInt.h"

void ItclDeleteArgList(ItclArgList *arglistPtr);
#ifdef ITCL_DEBUG
int _itcl_debug_level = 0;

/*
 * ------------------------------------------------------------------------
 *  ItclShowArgs()
 * ------------------------------------------------------------------------
 */

void
ItclShowArgs(
    int level,
    const char *str,
    size_t objc,
    Tcl_Obj * const* objv)
{
    size_t i;

    if (level > _itcl_debug_level) {
        return;
    }
    fprintf(stderr, "%s", str);
    for (i = 0; i < objc; i++) {
        fprintf(stderr, "!%s", objv[i] == NULL ? "??" :
                Tcl_GetString(objv[i]));
    }
    fprintf(stderr, "!\n");
}
#endif

/*
 * ------------------------------------------------------------------------
 *  Itcl_ProtectionStr()
 *
 *  Converts an integer protection code (ITCL_PUBLIC, ITCL_PROTECTED,
 *  or ITCL_PRIVATE) into a human-readable character string.  Returns
 *  a pointer to this string.
 * ------------------------------------------------------------------------
 */
const char*
Itcl_ProtectionStr(
    int pLevel)     /* protection level */
{
    switch (pLevel) {
    case ITCL_PUBLIC:
        return "public";
    case ITCL_PROTECTED:
        return "protected";
    case ITCL_PRIVATE:
        return "private";
    }
    return "<bad-protection-code>";
}

/*
 * ------------------------------------------------------------------------
 *  ItclCreateArgList()
 * ------------------------------------------------------------------------
 */

int
ItclCreateArgList(
    Tcl_Interp *interp,		/* interpreter managing this function */
    const char *str,		/* string representing argument list */
    Tcl_Size *argcPtr,		/* number of mandatory arguments */
    Tcl_Size *maxArgcPtr,		/* number of arguments parsed */
    Tcl_Obj **usagePtr,         /* store usage message for arguments here */
    ItclArgList **arglistPtrPtr,
    				/* returns pointer to parsed argument list */
    TCL_UNUSED(ItclMemberFunc *),
    const char *commandName)
{
    Tcl_Size argc;
    Tcl_Size defaultArgc;
    const char **argv;
    const char **defaultArgv;
    ItclArgList *arglistPtr;
    ItclArgList *lastArglistPtr;
    Tcl_Size i;
    int hadArgsArgument;
    int result;

    *arglistPtrPtr = NULL;
    lastArglistPtr = NULL;
    argc = 0;
    hadArgsArgument = 0;
    result = TCL_OK;
    *maxArgcPtr = 0;
    *argcPtr = 0;
    *usagePtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
    if (str) {
        if (Tcl_SplitList(interp, (const char *)str, &argc, &argv)
	        != TCL_OK) {
	    return TCL_ERROR;
	}
	i = 0;
	if (argc == 0) {
	   /* signal there are 0 arguments */
            arglistPtr = (ItclArgList *)ckalloc(sizeof(ItclArgList));
	    memset(arglistPtr, 0, sizeof(ItclArgList));
	    *arglistPtrPtr = arglistPtr;
	}
        while (i < argc) {
            if (Tcl_SplitList(interp, argv[i], &defaultArgc, &defaultArgv)
	            != TCL_OK) {
	        result = TCL_ERROR;
	        break;
	    }
	    arglistPtr = NULL;
	    if (defaultArgc == 0 || defaultArgv[0][0] == '\0') {
		if (commandName != NULL) {
	            Tcl_AppendResult(interp, "procedure \"",
		            commandName,
			    "\" has argument with no name", NULL);
		} else {
		    char buf[TCL_INTEGER_SPACE];
		    sprintf(buf, "%" ITCL_Z_MODIFIER "d", i);
		    Tcl_AppendResult(interp, "argument #", buf,
		            " has no name", NULL);
		}
		ckfree((char *) defaultArgv);
	        result = TCL_ERROR;
	        break;
	    }
	    if (defaultArgc > 2) {
	        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
	            "too many fields in argument specifier \"",
		    argv[i], "\"",
		    NULL);
		ckfree((char *) defaultArgv);
	        result = TCL_ERROR;
	        break;
	    }
	    if (strstr(defaultArgv[0],"::")) {
	        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		        "bad argument name \"", defaultArgv[0], "\"",
			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], TCL_INDEX_NONE);
	    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 ...?", TCL_INDEX_NONE);
		} else {
	            Tcl_AppendToObj(*usagePtr, defaultArgv[0], TCL_INDEX_NONE);
	        }
	    } else {
	        arglistPtr->defaultValuePtr =
		        Tcl_NewStringObj(defaultArgv[1], TCL_INDEX_NONE);
		Tcl_IncrRefCount(arglistPtr->defaultValuePtr);
	        Tcl_AppendToObj(*usagePtr, "?", 1);
	        Tcl_AppendToObj(*usagePtr, defaultArgv[0], TCL_INDEX_NONE);
	        Tcl_AppendToObj(*usagePtr, "?", 1);
	    }
            lastArglistPtr = arglistPtr;
	    i++;
	    ckfree((char *) defaultArgv);
        }
	ckfree((char *) argv);
    }
    /*
     *  If anything went wrong, destroy whatever arguments were
     *  created and return an error.
     */
    if (result != TCL_OK) {
        ItclDeleteArgList(*arglistPtrPtr);
        *arglistPtrPtr = NULL;
    }
    if (hadArgsArgument) {
        *maxArgcPtr = TCL_INDEX_NONE;
    }
    return result;
}

/*
 * ------------------------------------------------------------------------
 *  ItclDeleteArgList()
 * ------------------------------------------------------------------------
 */

void
ItclDeleteArgList(
    ItclArgList *arglistPtr)	/* first argument in arg list chain */
{
    ItclArgList *currPtr;
    ItclArgList *nextPtr;

    for (currPtr=arglistPtr; currPtr; currPtr=nextPtr) {
	if (currPtr->defaultValuePtr != NULL) {
	    Tcl_DecrRefCount(currPtr->defaultValuePtr);
	}
	if (currPtr->namePtr != NULL) {
	    Tcl_DecrRefCount(currPtr->namePtr);
	}
        nextPtr = currPtr->nextPtr;
        ckfree((char *)currPtr);
    }
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_EvalArgs()
 *
 *  This procedure invokes a list of (objc,objv) arguments as a
 *  single command.  It is similar to Tcl_EvalObj, but it doesn't
 *  do any parsing or compilation.  It simply treats the first
 *  argument as a command and invokes that command in the current
 *  context.
 *
 *  Returns TCL_OK if successful.  Otherwise, this procedure returns
 *  TCL_ERROR along with an error message in the interpreter.
 * ------------------------------------------------------------------------
 */
int
Itcl_EvalArgs(
    Tcl_Interp *interp,      /* current interpreter */
    Tcl_Size objc,          /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Command cmd;
    Tcl_CmdInfo infoPtr;

    /*
     * Resolve the command by converting it to a CmdName object.
     * This caches a pointer to the Command structure for the
     * command, so if we need it again, it's ready to use.
     */
    cmd = Tcl_GetCommandFromObj(interp, objv[0]);

    /*
     * If the command is not found, we have no hope of a truly fast
     * dispatch, so the smart thing to do is just fall back to the
     * conventional tools.
     */
    if (cmd == NULL) {
	return Tcl_EvalObjv(interp, objc, objv, 0);
    }

    /*
     *  Finally, invoke the command's Tcl_ObjCmdProc.  Be careful
     *  to pass in the proper client data.
     */
    Tcl_GetCommandInfoFromToken(cmd, &infoPtr);
#if TCL_MAJOR_VERSION > 8
    if (infoPtr.isNativeObjectProc == 2) {
	return infoPtr.objProc2(infoPtr.objClientData2, interp, objc, objv);
    }
#endif
    return infoPtr.objProc(infoPtr.objClientData, interp, objc, objv);
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_CreateArgs()
 *
 *  This procedure takes a string and a list of (objc,objv) arguments,
 *  and glues them together in a single list.  This is useful when
 *  a command word needs to be prepended or substituted into a command
 *  line before it is executed.  The arguments are returned in a single
 *  list object, and they can be retrieved by calling
 *  Tcl_ListObjGetElements.  When the arguments are no longer needed,
 *  they should be discarded by decrementing the reference count for
 *  the list object.
 *
 *  Returns a pointer to the list object containing the arguments.
 * ------------------------------------------------------------------------
 */
Tcl_Obj*
Itcl_CreateArgs(
    TCL_UNUSED(Tcl_Interp *),/* current interpreter */
    const char *string,      /* first command word */
    Tcl_Size objc,          /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Size i;
    Tcl_Obj *listPtr;

    ItclShowArgs(1, "Itcl_CreateArgs", objc, objv);
    listPtr = Tcl_NewListObj(objc+2, NULL);
    Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj("my", TCL_INDEX_NONE));
    Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(string, TCL_INDEX_NONE));

    for (i=0; i < objc; i++) {
        Tcl_ListObjAppendElement(NULL, listPtr, objv[i]);
    }
    return listPtr;
}

/*
 * ------------------------------------------------------------------------
 *  ItclEnsembleSubCmd()
 * ------------------------------------------------------------------------
 */

int
ItclEnsembleSubCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    TCL_UNUSED(const char *),
    int objc,
    Tcl_Obj *const *objv,
    TCL_UNUSED(const char *))
{
    int result;
    Tcl_Obj **newObjv;
    int isRootEnsemble;

    ItclShowArgs(2, "ItclEnsembleSubCmd", objc, objv);

    newObjv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *)*(objc));
    isRootEnsemble = Itcl_InitRewriteEnsemble(interp, 1, 1, objc, objv);
    newObjv[0] = Tcl_NewStringObj("::itcl::builtin::Info", TCL_INDEX_NONE);
    Tcl_IncrRefCount(newObjv[0]);
    if (objc > 1) {
        memcpy(newObjv+1, objv+1, sizeof(Tcl_Obj *) * (objc-1));
    }
    result = Tcl_EvalObjv(interp, objc, newObjv, TCL_EVAL_INVOKE);
    Tcl_DecrRefCount(newObjv[0]);
    ckfree((char *)newObjv);
    Itcl_ResetRewriteEnsemble(interp, isRootEnsemble);
    return result;
}


/*
 * ------------------------------------------------------------------------
 *  ItclCapitalize()
 * ------------------------------------------------------------------------
 */

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, TCL_INDEX_NONE);
    Tcl_AppendToObj(objPtr, str+1, TCL_INDEX_NONE);
    return objPtr;
}
/*
 * ------------------------------------------------------------------------
 *  DeleteClassDictInfo()
 * ------------------------------------------------------------------------
 */
static int
DeleteClassDictInfo(
    Tcl_Interp *interp,
    ItclClass *iclsPtr,
    const char *varName)
{
    Tcl_Obj *dictPtr;
    Tcl_Obj *keyPtr;

    dictPtr = Tcl_GetVar2Ex(interp, varName, NULL, 0);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", varName, NULL);
	return TCL_ERROR;
    }
    keyPtr = iclsPtr->fullNamePtr;
    if (Tcl_DictObjRemove(interp, dictPtr, keyPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    Tcl_SetVar2Ex(interp, varName, NULL, dictPtr, 0);
    return TCL_OK;
}
/*
 * ------------------------------------------------------------------------
 *  AddDictEntry()
 * ------------------------------------------------------------------------
 */
static int
AddDictEntry(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    const char *keyStr,
    Tcl_Obj *valuePtr)
{
    Tcl_Obj *keyPtr;
    int code;

    if (valuePtr == NULL) {
        return TCL_OK;
    }
    keyPtr = Tcl_NewStringObj(keyStr, TCL_INDEX_NONE);
    Tcl_IncrRefCount(keyPtr);
    code = Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr);
    Tcl_DecrRefCount(keyPtr);
    return code;
}

/*
 * ------------------------------------------------------------------------
 *  ItclAddClassesDictInfo()
 * ------------------------------------------------------------------------
 */
int
ItclAddClassesDictInfo(
    Tcl_Interp *interp,
    ItclClass *iclsPtr)
{
    Tcl_Obj *dictPtr;
    Tcl_Obj *keyPtr;
    Tcl_Obj *keyPtr1;
    Tcl_Obj *valuePtr1;
    Tcl_Obj *valuePtr2;
    Tcl_Obj *listPtr;
    FOREACH_HASH_DECLS;
    ItclHierIter hier;
    ItclClass *iclsPtr2;
    void *value;
    int found;
    int newValue1;
    int haveHierarchy;

    found = 0;
    FOREACH_HASH(keyPtr1, value, &iclsPtr->infoPtr->classTypes) {
        if (iclsPtr->flags & PTR2INT(value)) {
	    found = 1;
	    break;
	}
    }
    if (! found) {
	Tcl_AppendResult(interp, "ItclAddClassesDictInfo bad class ",
	        "type for class \"", Tcl_GetString(iclsPtr->fullNamePtr),
	        "\"", NULL);
        return TCL_ERROR;
    }
    dictPtr = Tcl_GetVar2Ex(interp,
             ITCL_NAMESPACE"::internal::dicts::classes", NULL, 0);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", ITCL_NAMESPACE,
	        "::internal::dicts::classes", NULL);
	return TCL_ERROR;
    }
    if (Tcl_DictObjGet(interp, dictPtr, keyPtr1, &valuePtr1) != TCL_OK) {
        return TCL_ERROR;
    }
    newValue1 = 0;
    if (valuePtr1 == NULL) {
        newValue1 = 1;
        valuePtr1 = Tcl_NewDictObj();
    }
    keyPtr = iclsPtr->fullNamePtr;
    if (Tcl_DictObjGet(interp, valuePtr1, keyPtr, &valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (valuePtr2 != NULL) {
        if (Tcl_DictObjRemove(interp, valuePtr1, keyPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    valuePtr2 = Tcl_NewDictObj();
    if (AddDictEntry(interp, valuePtr2, "-name", iclsPtr->namePtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (AddDictEntry(interp, valuePtr2, "-fullname", iclsPtr->fullNamePtr)
            != TCL_OK) {
        return TCL_ERROR;
    }
    Itcl_InitHierIter(&hier, iclsPtr);
    iclsPtr2 = Itcl_AdvanceHierIter(&hier);
    haveHierarchy = 0;
    listPtr = Tcl_NewListObj(0, NULL);
    while (iclsPtr2 != NULL) {
        haveHierarchy = 1;
	if (Tcl_ListObjAppendElement(interp, listPtr, iclsPtr2->fullNamePtr)
	        != TCL_OK) {
	    return TCL_ERROR;
	}
        iclsPtr2 = Itcl_AdvanceHierIter(&hier);
    }
    Itcl_DeleteHierIter(&hier);
    if (haveHierarchy) {
        if (AddDictEntry(interp, valuePtr2, "-heritage", listPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    } else {
        Tcl_DecrRefCount(listPtr);
    }
    if (iclsPtr->widgetClassPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-widget", iclsPtr->widgetClassPtr)
	        != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (iclsPtr->hullTypePtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-hulltype", iclsPtr->hullTypePtr)
	        != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (iclsPtr->typeConstructorPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-typeconstructor",
	        iclsPtr->typeConstructorPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    keyPtr = iclsPtr->fullNamePtr;
    if (Tcl_DictObjPut(interp, valuePtr1, keyPtr, valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (newValue1) {
        if (Tcl_DictObjPut(interp, dictPtr, keyPtr1, valuePtr1) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    Tcl_SetVar2Ex(interp, ITCL_NAMESPACE"::internal::dicts::classes",
            NULL, dictPtr, 0);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclDeleteClassesDictInfo()
 * ------------------------------------------------------------------------
 */
int
ItclDeleteClassesDictInfo(
    Tcl_Interp *interp,
    ItclClass *iclsPtr)
{
    Tcl_Obj *dictPtr;
    Tcl_Obj *keyPtr;
    Tcl_Obj *valuePtr;
    FOREACH_HASH_DECLS;
    void* value;
    int found;

    found = 0;
    FOREACH_HASH(keyPtr, value, &iclsPtr->infoPtr->classTypes) {
        if (iclsPtr->flags & PTR2INT(value)) {
	    found = 1;
	    break;
	}
    }
    if (! found) {
	Tcl_AppendResult(interp, "ItclDeleteClassesDictInfo bad class ",
	        "type for class \"", Tcl_GetString(iclsPtr->fullNamePtr),
	        "\"", NULL);
        return TCL_ERROR;
    }
    dictPtr = Tcl_GetVar2Ex(interp,
             ITCL_NAMESPACE"::internal::dicts::classes", NULL, 0);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", ITCL_NAMESPACE,
	        "::internal::dicts::classes", NULL);
	return TCL_ERROR;
    }
    if (Tcl_DictObjGet(interp, dictPtr, keyPtr, &valuePtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (valuePtr == NULL) {
        /* there seems to have been an error during construction
	 * and no class has been created so ignore silently */
        return TCL_OK;
    }
    if (Tcl_DictObjRemove(interp, valuePtr, iclsPtr->fullNamePtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr) != TCL_OK) {
        return TCL_ERROR;
    }
    Tcl_SetVar2Ex(interp, ITCL_NAMESPACE"::internal::dicts::classes",
            NULL, dictPtr, 0);
    DeleteClassDictInfo(interp, iclsPtr,
            ITCL_NAMESPACE"::internal::dicts::classOptions");
    DeleteClassDictInfo(interp, iclsPtr,
            ITCL_NAMESPACE"::internal::dicts::classDelegatedOptions");
    DeleteClassDictInfo(interp, iclsPtr,
            ITCL_NAMESPACE"::internal::dicts::classVariables");
    DeleteClassDictInfo(interp, iclsPtr,
            ITCL_NAMESPACE"::internal::dicts::classComponents");
    DeleteClassDictInfo(interp, iclsPtr,
            ITCL_NAMESPACE"::internal::dicts::classFunctions");
    DeleteClassDictInfo(interp, iclsPtr,
            ITCL_NAMESPACE"::internal::dicts::classDelegatedFunctions");
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclAddObjectsDictInfo()
 * ------------------------------------------------------------------------
 */
int
ItclAddObjectsDictInfo(
    Tcl_Interp *interp,
    ItclObject *ioPtr)
{
    Tcl_Obj *dictPtr;
    Tcl_Obj *keyPtr;
    Tcl_Obj *keyPtr1;
    Tcl_Obj *valuePtr1;
    Tcl_Obj *valuePtr2;
    Tcl_Obj *objPtr;
    int newValue1;

    dictPtr = Tcl_GetVar2Ex(interp,
             ITCL_NAMESPACE"::internal::dicts::objects", NULL, 0);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", ITCL_NAMESPACE,
	        "::internal::dicts::objects", NULL);
	return TCL_ERROR;
    }
    keyPtr1 = Tcl_NewStringObj("instances", TCL_INDEX_NONE);
    if (Tcl_DictObjGet(interp, dictPtr, keyPtr1, &valuePtr1) != TCL_OK) {
        return TCL_ERROR;
    }
    newValue1 = 0;
    if (valuePtr1 == NULL) {
        newValue1 = 1;
        valuePtr1 = Tcl_NewDictObj();
    }
    keyPtr = ioPtr->namePtr;
    if (Tcl_DictObjGet(interp, valuePtr1, keyPtr, &valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (valuePtr2 == NULL) {
        if (Tcl_DictObjRemove(interp, valuePtr1, keyPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    valuePtr2 = Tcl_NewDictObj();
    if (AddDictEntry(interp, valuePtr2, "-name", ioPtr->namePtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (AddDictEntry(interp, valuePtr2, "-origname", ioPtr->namePtr)
            != TCL_OK) {
        return TCL_ERROR;
    }
    if (AddDictEntry(interp, valuePtr2, "-class", ioPtr->iclsPtr->fullNamePtr)
            != TCL_OK) {
        return TCL_ERROR;
    }
    if (ioPtr->hullWindowNamePtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-hullwindow",
	        ioPtr->hullWindowNamePtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (AddDictEntry(interp, valuePtr2, "-varns", ioPtr->varNsNamePtr)
            != TCL_OK) {
        return TCL_ERROR;
    }
    objPtr = Tcl_NewObj();
    Tcl_GetCommandFullName(interp, ioPtr->accessCmd, objPtr);
    if (AddDictEntry(interp, valuePtr2, "-command", objPtr) != TCL_OK) {
	Tcl_DecrRefCount(objPtr);
        return TCL_ERROR;
    }
    keyPtr = ioPtr->namePtr;
    if (Tcl_DictObjPut(interp, valuePtr1, keyPtr, valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (newValue1) {
	/* Cannot fail. Screened non-dicts earlier. */
        Tcl_DictObjPut(interp, dictPtr, keyPtr1, valuePtr1);
    } else {
	/* Don't leak the key val... */
	Tcl_DecrRefCount(keyPtr1);
    }
    Tcl_SetVar2Ex(interp, ITCL_NAMESPACE"::internal::dicts::objects",
            NULL, dictPtr, 0);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclDeleteObjectsDictInfo()
 * ------------------------------------------------------------------------
 */
int
ItclDeleteObjectsDictInfo(
    Tcl_Interp *interp,
    ItclObject *ioPtr)
{
    Tcl_Obj *dictPtr;
    Tcl_Obj *keyPtr;
    Tcl_Obj *keyPtr1;
    Tcl_Obj *valuePtr;
    Tcl_Obj *valuePtr1;

    dictPtr = Tcl_GetVar2Ex(interp,
             ITCL_NAMESPACE"::internal::dicts::objects", NULL, 0);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", ITCL_NAMESPACE,
	        "::internal::dicts::objects", NULL);
	return TCL_ERROR;
    }
    keyPtr1 = Tcl_NewStringObj("instances", TCL_INDEX_NONE);
    if (Tcl_DictObjGet(interp, dictPtr, keyPtr1, &valuePtr) != TCL_OK) {
	Tcl_DecrRefCount(keyPtr1);
        return TCL_ERROR;
    }
    if (valuePtr == NULL) {
	/* looks like no object has been registered yet
	 * so ignore and return OK */
	Tcl_DecrRefCount(keyPtr1);
        return TCL_OK;
    }
    keyPtr = ioPtr->namePtr;
    if (Tcl_DictObjGet(interp, valuePtr, keyPtr, &valuePtr1) != TCL_OK) {
	Tcl_DecrRefCount(keyPtr1);
        return TCL_ERROR;
    }
    if (valuePtr1 == NULL) {
	/* looks like the object has not been constructed successfully
	 * so ignore and return OK */
	Tcl_DecrRefCount(keyPtr1);
        return TCL_OK;
    }
    if (Tcl_DictObjRemove(interp, valuePtr, keyPtr) != TCL_OK) {
	Tcl_DecrRefCount(keyPtr1);
        return TCL_ERROR;
    }
    if (Tcl_DictObjPut(interp, dictPtr, keyPtr1, valuePtr) != TCL_OK) {
	/* This is very likely impossible. non-dict already screened. */
	Tcl_DecrRefCount(keyPtr1);
        return TCL_ERROR;
    }
    Tcl_DecrRefCount(keyPtr1);
    Tcl_SetVar2Ex(interp, ITCL_NAMESPACE"::internal::dicts::objects",
            NULL, dictPtr, 0);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclAddOptionDictInfo()
 * ------------------------------------------------------------------------
 */
int
ItclAddOptionDictInfo(
    Tcl_Interp *interp,
    ItclClass *iclsPtr,
    ItclOption *ioptPtr)
{
    Tcl_Obj *dictPtr;
    Tcl_Obj *keyPtr;
    Tcl_Obj *valuePtr1;
    Tcl_Obj *valuePtr2;
    int newValue1;

    dictPtr = Tcl_GetVar2Ex(interp,
             ITCL_NAMESPACE"::internal::dicts::classOptions", NULL, 0);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", ITCL_NAMESPACE,
	        "::internal::dicts::classOptions", NULL);
	return TCL_ERROR;
    }
    keyPtr = iclsPtr->fullNamePtr;
    if (Tcl_DictObjGet(interp, dictPtr, keyPtr, &valuePtr1) != TCL_OK) {
        return TCL_ERROR;
    }
    newValue1 = 0;
    if (valuePtr1 == NULL) {
        valuePtr1 = Tcl_NewDictObj();
        newValue1 = 1;
    }
    keyPtr = ioptPtr->namePtr;
    if (Tcl_DictObjGet(interp, valuePtr1, keyPtr, &valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (valuePtr2 == NULL) {
        valuePtr2 = Tcl_NewDictObj();
    }
    if (AddDictEntry(interp, valuePtr2, "-name", ioptPtr->namePtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (ioptPtr->fullNamePtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-fullname", ioptPtr->fullNamePtr)
                != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (AddDictEntry(interp, valuePtr2, "-resource", ioptPtr->resourceNamePtr)
            != TCL_OK) {
        return TCL_ERROR;
    }
    if (AddDictEntry(interp, valuePtr2, "-class", ioptPtr->classNamePtr)
            != TCL_OK) {
        return TCL_ERROR;
    }
    if (ioptPtr->defaultValuePtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-default",
	        ioptPtr->defaultValuePtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (ioptPtr->flags & ITCL_OPTION_READONLY) {
        if (AddDictEntry(interp, valuePtr2, "-readonly",
	        Tcl_NewStringObj("1", TCL_INDEX_NONE)) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (ioptPtr->cgetMethodPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-cgetmethod",
	        ioptPtr->cgetMethodPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (ioptPtr->cgetMethodVarPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-cgetmethodvar",
	        ioptPtr->cgetMethodVarPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (ioptPtr->configureMethodPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-configuremethod",
	        ioptPtr->cgetMethodPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (ioptPtr->configureMethodVarPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-configuremethodvar",
	        ioptPtr->configureMethodVarPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (ioptPtr->validateMethodPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-validatemethod",
	        ioptPtr->validateMethodPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (ioptPtr->validateMethodVarPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-validatemethodvar",
	        ioptPtr->validateMethodVarPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    keyPtr = ioptPtr->namePtr;
    if (Tcl_DictObjPut(interp, valuePtr1, keyPtr, valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (newValue1) {
        keyPtr = iclsPtr->fullNamePtr;
        if (Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr1) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    Tcl_SetVar2Ex(interp, ITCL_NAMESPACE"::internal::dicts::classOptions",
            NULL, dictPtr, 0);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclAddDelegatedOptionDictInfo()
 * ------------------------------------------------------------------------
 */
int
ItclAddDelegatedOptionDictInfo(
    Tcl_Interp *interp,
    ItclClass *iclsPtr,
    ItclDelegatedOption *idoPtr)
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *dictPtr;
    Tcl_Obj *keyPtr;
    Tcl_Obj *valuePtr1;
    Tcl_Obj *valuePtr2;
    Tcl_Obj *listPtr;
    void *value;
    int haveExceptions;
    int newValue1;

    keyPtr = iclsPtr->fullNamePtr;
    dictPtr = Tcl_GetVar2Ex(interp,
             ITCL_NAMESPACE"::internal::dicts::classDelegatedOptions",
	     NULL, 0);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", ITCL_NAMESPACE,
	        "::internal::dicts::classDelegatedOptions", NULL);
	return TCL_ERROR;
    }
    if (Tcl_DictObjGet(interp, dictPtr, keyPtr, &valuePtr1) != TCL_OK) {
        return TCL_ERROR;
    }
    newValue1 = 0;
    if (valuePtr1 == NULL) {
        valuePtr1 = Tcl_NewDictObj();
        newValue1 = 1;
    }
    keyPtr = idoPtr->namePtr;
    if (Tcl_DictObjGet(interp, valuePtr1, keyPtr, &valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (valuePtr2 == NULL) {
        valuePtr2 = Tcl_NewDictObj();
    }
    if (AddDictEntry(interp, valuePtr2, "-name", idoPtr->namePtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (idoPtr->resourceNamePtr != NULL) {
         if (AddDictEntry(interp, valuePtr2, "-resource",
	         idoPtr->resourceNamePtr) != TCL_OK) {
             return TCL_ERROR;
        }
    }
    if (idoPtr->classNamePtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-class", idoPtr->classNamePtr)
                != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (idoPtr->icPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-component",
	        idoPtr->icPtr->namePtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (idoPtr->asPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-as", idoPtr->asPtr)
                != TCL_OK) {
            return TCL_ERROR;
        }
    }
    listPtr = Tcl_NewListObj(0, NULL);
    haveExceptions = 0;
    FOREACH_HASH(keyPtr, value, &idoPtr->exceptions) {
        if (value == NULL) {
            /* FIXME need code here */
        }
        haveExceptions = 1;
	Tcl_ListObjAppendElement(interp, listPtr, keyPtr);
    }
    if (haveExceptions) {
        if (AddDictEntry(interp, valuePtr2, "-except", listPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    } else {
        Tcl_DecrRefCount(listPtr);
    }
    keyPtr = idoPtr->namePtr;
    if (Tcl_DictObjPut(interp, valuePtr1, keyPtr, valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (newValue1) {
        keyPtr = iclsPtr->fullNamePtr;
        if (Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr1) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    Tcl_SetVar2Ex(interp,
            ITCL_NAMESPACE"::internal::dicts::classDelegatedOptions",
            NULL, dictPtr, 0);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclAddClassComponentDictInfo()
 * ------------------------------------------------------------------------
 */
int
ItclAddClassComponentDictInfo(
    Tcl_Interp *interp,
    ItclClass *iclsPtr,
    ItclComponent *icPtr)
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *dictPtr;
    Tcl_Obj *keyPtr;
    Tcl_Obj *valuePtr1;
    Tcl_Obj *valuePtr2;
    Tcl_Obj *listPtr;
    void *value;
    int newValue1;

    keyPtr = iclsPtr->fullNamePtr;
    dictPtr = Tcl_GetVar2Ex(interp,
             ITCL_NAMESPACE"::internal::dicts::classComponents",
	     NULL, 0);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", ITCL_NAMESPACE,
	        "::internal::dicts::classComponents", NULL);
	return TCL_ERROR;
    }
    if (Tcl_DictObjGet(interp, dictPtr, keyPtr, &valuePtr1) != TCL_OK) {
        return TCL_ERROR;
    }
    newValue1 = 0;
    if (valuePtr1 == NULL) {
        valuePtr1 = Tcl_NewDictObj();
        newValue1 = 1;
    }
    keyPtr = icPtr->namePtr;
    if (Tcl_DictObjGet(interp, valuePtr1, keyPtr, &valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (valuePtr2 == NULL) {
        valuePtr2 = Tcl_NewDictObj();
    }
    if (AddDictEntry(interp, valuePtr2, "-name", icPtr->namePtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (AddDictEntry(interp, valuePtr2, "-variable", icPtr->ivPtr->fullNamePtr)
             != TCL_OK) {
        return TCL_ERROR;
    }
    if (icPtr->flags & ITCL_COMPONENT_INHERIT) {
        if (AddDictEntry(interp, valuePtr2, "-inherit",
	        Tcl_NewStringObj("1", TCL_INDEX_NONE)) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (icPtr->flags & ITCL_COMPONENT_PUBLIC) {
        if (AddDictEntry(interp, valuePtr2, "-public",
	        Tcl_NewStringObj("1", TCL_INDEX_NONE)) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (icPtr->haveKeptOptions) {
        listPtr = Tcl_NewListObj(0, NULL);
        FOREACH_HASH(keyPtr, value, &icPtr->keptOptions) {
            if (value == NULL) {
                /* FIXME need code here */
            }
	    Tcl_ListObjAppendElement(interp, listPtr, keyPtr);
        }
        if (AddDictEntry(interp, valuePtr2, "-keptoptions", listPtr)
                != TCL_OK) {
            return TCL_ERROR;
        }
    }
    keyPtr = icPtr->namePtr;
    if (Tcl_DictObjPut(interp, valuePtr1, keyPtr, valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (newValue1) {
        keyPtr = iclsPtr->fullNamePtr;
        if (Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr1) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    Tcl_SetVar2Ex(interp,
            ITCL_NAMESPACE"::internal::dicts::classComponents",
            NULL, dictPtr, 0);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclAddClassVariableDictInfo()
 * ------------------------------------------------------------------------
 */
int
ItclAddClassVariableDictInfo(
    Tcl_Interp *interp,
    ItclClass *iclsPtr,
    ItclVariable *ivPtr)
{
    Tcl_Obj *dictPtr;
    Tcl_Obj *keyPtr;
    Tcl_Obj *valuePtr1;
    Tcl_Obj *valuePtr2;
    Tcl_Obj *listPtr;
    const char *cp;
    int haveFlags;
    int newValue1;

    keyPtr = iclsPtr->fullNamePtr;
    dictPtr = Tcl_GetVar2Ex(interp,
             ITCL_NAMESPACE"::internal::dicts::classVariables",
	     NULL, TCL_GLOBAL_ONLY);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", ITCL_NAMESPACE,
	        "::internal::dicts::classVariables", NULL);
	return TCL_ERROR;
    }
    if (Tcl_DictObjGet(interp, dictPtr, keyPtr, &valuePtr1) != TCL_OK) {
        return TCL_ERROR;
    }
    newValue1 = 0;
    if (valuePtr1 == NULL) {
        valuePtr1 = Tcl_NewDictObj();
        newValue1 = 1;
    }
    keyPtr = ivPtr->namePtr;
    if (Tcl_DictObjGet(interp, valuePtr1, keyPtr, &valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (valuePtr2 == NULL) {
        valuePtr2 = Tcl_NewDictObj();
    }
    if (AddDictEntry(interp, valuePtr2, "-name", ivPtr->namePtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (AddDictEntry(interp, valuePtr2, "-fullname", ivPtr->fullNamePtr)
             != TCL_OK) {
        return TCL_ERROR;
    }
    if (ivPtr->init != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-init", ivPtr->init)
                 != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (ivPtr->arrayInitPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-arrayinit", ivPtr->arrayInitPtr)
                 != TCL_OK) {
             return TCL_ERROR;
        }
    }
    cp = Itcl_ProtectionStr(ivPtr->protection);
    if (AddDictEntry(interp, valuePtr2, "-protection", Tcl_NewStringObj(cp, TCL_INDEX_NONE))
             != TCL_OK) {
        return TCL_ERROR;
    }
    cp = "variable";
    if (ivPtr->flags & ITCL_COMMON) {
        cp = "common";
    }
    if (ivPtr->flags & ITCL_VARIABLE) {
        cp = "variable";
    }
    if (ivPtr->flags & ITCL_TYPE_VARIABLE) {
        cp = "typevariable";
    }
    if (AddDictEntry(interp, valuePtr2, "-type", Tcl_NewStringObj(cp, TCL_INDEX_NONE))
             != TCL_OK) {
        return TCL_ERROR;
    }
    haveFlags = 0;
    listPtr = Tcl_NewListObj(0, NULL);
    if (ivPtr->flags & ITCL_THIS_VAR) {
        haveFlags = 1;
        Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("this", TCL_INDEX_NONE));
    }
    if (ivPtr->flags & ITCL_SELF_VAR) {
        haveFlags = 1;
        Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("self", TCL_INDEX_NONE));
    }
    if (ivPtr->flags & ITCL_SELFNS_VAR) {
        haveFlags = 1;
        Tcl_ListObjAppendElement(interp, listPtr,
	        Tcl_NewStringObj("selfns", TCL_INDEX_NONE));
    }
    if (ivPtr->flags & ITCL_WIN_VAR) {
        haveFlags = 1;
        Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("win", TCL_INDEX_NONE));
    }
    if (ivPtr->flags & ITCL_COMPONENT_VAR) {
        haveFlags = 1;
        Tcl_ListObjAppendElement(interp, listPtr,
	        Tcl_NewStringObj("component", TCL_INDEX_NONE));
    }
    if (ivPtr->flags & ITCL_OPTIONS_VAR) {
        haveFlags = 1;
        Tcl_ListObjAppendElement(interp, listPtr,
	        Tcl_NewStringObj("itcl_options", TCL_INDEX_NONE));
    }
    if (ivPtr->flags & ITCL_HULL_VAR) {
        haveFlags = 1;
        Tcl_ListObjAppendElement(interp, listPtr,
	        Tcl_NewStringObj("itcl_hull", TCL_INDEX_NONE));
    }
    if (ivPtr->flags & ITCL_OPTION_READONLY) {
        haveFlags = 1;
        Tcl_ListObjAppendElement(interp, listPtr,
	        Tcl_NewStringObj("option_read_only", TCL_INDEX_NONE));
    }
    if (haveFlags) {
        if (AddDictEntry(interp, valuePtr2, "-flags", listPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    } else {
        Tcl_DecrRefCount(listPtr);
    }
    if (ivPtr->codePtr != NULL) {
        if (ivPtr->codePtr->bodyPtr != NULL) {
            if (AddDictEntry(interp, valuePtr2, "-code",
	            ivPtr->codePtr->bodyPtr) != TCL_OK) {
                return TCL_ERROR;
            }
	}
    }
    keyPtr = ivPtr->namePtr;
    if (Tcl_DictObjPut(interp, valuePtr1, keyPtr, valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (newValue1) {
        keyPtr = iclsPtr->fullNamePtr;
        if (Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr1) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    Tcl_SetVar2Ex(interp,
            ITCL_NAMESPACE"::internal::dicts::classVariables",
            NULL, dictPtr, TCL_GLOBAL_ONLY);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclAddClassFunctionDictInfo()
 * ------------------------------------------------------------------------
 */
int
ItclAddClassFunctionDictInfo(
    Tcl_Interp *interp,
    ItclClass *iclsPtr,
    ItclMemberFunc *imPtr)
{
    Tcl_Obj *dictPtr;
    Tcl_Obj *keyPtr;
    Tcl_Obj *valuePtr1;
    Tcl_Obj *valuePtr2;
    Tcl_Obj *listPtr;
    const char *cp;
    int haveFlags;
    int newValue1;

    dictPtr = Tcl_GetVar2Ex(interp,
             ITCL_NAMESPACE"::internal::dicts::classFunctions",
	     NULL, TCL_GLOBAL_ONLY);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", ITCL_NAMESPACE,
	        "::internal::dicts::classFunctions", NULL);
	return TCL_ERROR;
    }
    keyPtr = iclsPtr->fullNamePtr;
    if (Tcl_DictObjGet(interp, dictPtr, keyPtr, &valuePtr1) != TCL_OK) {
        return TCL_ERROR;
    }
    newValue1 = 0;
    if (valuePtr1 == NULL) {
        valuePtr1 = Tcl_NewDictObj();
        newValue1 = 1;
    }
    keyPtr = imPtr->namePtr;
    if (Tcl_DictObjGet(interp, valuePtr1, keyPtr, &valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (valuePtr2 != NULL) {
        Tcl_DictObjRemove(interp, valuePtr1, keyPtr);
    }
    valuePtr2 = Tcl_NewDictObj();
    if (AddDictEntry(interp, valuePtr2, "-name", imPtr->namePtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (AddDictEntry(interp, valuePtr2, "-fullname", imPtr->fullNamePtr)
             != TCL_OK) {
        return TCL_ERROR;
    }
    cp = "";
    if (imPtr->protection == ITCL_PUBLIC) {
        cp = "public";
    }
    if (imPtr->protection == ITCL_PROTECTED) {
        cp = "protected";
    }
    if (imPtr->protection == ITCL_PRIVATE) {
        cp = "private";
    }
    if (AddDictEntry(interp, valuePtr2, "-protection", Tcl_NewStringObj(cp, TCL_INDEX_NONE))
             != TCL_OK) {
        return TCL_ERROR;
    }
    cp = "";
    if (imPtr->flags & ITCL_COMMON) {
        cp = "common";
    }
    if (imPtr->flags & ITCL_METHOD) {
        cp = "method";
    }
    if (imPtr->flags & ITCL_TYPE_METHOD) {
        cp = "typemethod";
    }
    if (AddDictEntry(interp, valuePtr2, "-type", Tcl_NewStringObj(cp, TCL_INDEX_NONE))
             != TCL_OK) {
        return TCL_ERROR;
    }
    haveFlags = 0;
    listPtr = Tcl_NewListObj(0, NULL);
    if (imPtr->flags & ITCL_CONSTRUCTOR) {
        haveFlags = 1;
        Tcl_ListObjAppendElement(interp, listPtr,
	        Tcl_NewStringObj("constructor", TCL_INDEX_NONE));
    }
    if (imPtr->flags & ITCL_DESTRUCTOR) {
        haveFlags = 1;
        Tcl_ListObjAppendElement(interp, listPtr,
	        Tcl_NewStringObj("destructor", TCL_INDEX_NONE));
    }
    if (imPtr->flags & ITCL_ARG_SPEC) {
        haveFlags = 1;
        Tcl_ListObjAppendElement(interp, listPtr,
	        Tcl_NewStringObj("have_args", TCL_INDEX_NONE));
    }
    if (imPtr->flags & ITCL_BODY_SPEC) {
        haveFlags = 1;
        Tcl_ListObjAppendElement(interp, listPtr,
	        Tcl_NewStringObj("have_body", TCL_INDEX_NONE));
    }
    if (haveFlags) {
        if (AddDictEntry(interp, valuePtr2, "-flags", listPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    } else {
        Tcl_DecrRefCount(listPtr);
    }
    if (imPtr->codePtr != NULL) {
        if (imPtr->codePtr->bodyPtr != NULL) {
            if (AddDictEntry(interp, valuePtr2, "-body",
	            imPtr->codePtr->bodyPtr) != TCL_OK) {
                return TCL_ERROR;
            }
	}
        if (imPtr->codePtr->argumentPtr != NULL) {
            if (AddDictEntry(interp, valuePtr2, "-args",
	            imPtr->codePtr->argumentPtr) != TCL_OK) {
                return TCL_ERROR;
            }
	}
        if (imPtr->codePtr->usagePtr != NULL) {
            if (AddDictEntry(interp, valuePtr2, "-usage",
	            imPtr->codePtr->usagePtr) != TCL_OK) {
                return TCL_ERROR;
            }
	}
	haveFlags = 0;
	listPtr = Tcl_NewListObj(0, NULL);
        if (imPtr->codePtr->flags & ITCL_BUILTIN) {
	    haveFlags = 1;
            Tcl_ListObjAppendElement(interp, listPtr,
	            Tcl_NewStringObj("builtin", TCL_INDEX_NONE));
	}
	if (haveFlags) {
            if (AddDictEntry(interp, valuePtr2, "-codeflags", listPtr)
	            != TCL_OK) {
                return TCL_ERROR;
            }
	} else {
            Tcl_DecrRefCount(listPtr);
	}
    }
    keyPtr = imPtr->namePtr;
    if (Tcl_DictObjPut(interp, valuePtr1, keyPtr, valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (newValue1) {
        keyPtr = iclsPtr->fullNamePtr;
        if (Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr1) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    Tcl_SetVar2Ex(interp,
            ITCL_NAMESPACE"::internal::dicts::classFunctions",
            NULL, dictPtr, TCL_GLOBAL_ONLY);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclAddClassDelegatedFunctionDictInfo()
 * ------------------------------------------------------------------------
 */
int
ItclAddClassDelegatedFunctionDictInfo(
    Tcl_Interp *interp,
    ItclClass *iclsPtr,
    ItclDelegatedFunction *idmPtr)
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *dictPtr;
    Tcl_Obj *keyPtr;
    Tcl_Obj *valuePtr1;
    Tcl_Obj *valuePtr2;
    Tcl_Obj *listPtr;
    void *value;
    int haveExceptions;
    int newValue1;

    keyPtr = iclsPtr->fullNamePtr;
    dictPtr = Tcl_GetVar2Ex(interp,
             ITCL_NAMESPACE"::internal::dicts::classDelegatedFunctions",
	     NULL, 0);
    if (dictPtr == NULL) {
        Tcl_AppendResult(interp, "cannot get dict ", ITCL_NAMESPACE,
	        "::internal::dicts::classDelegatedFunctions", NULL);
	return TCL_ERROR;
    }
    if (Tcl_DictObjGet(interp, dictPtr, keyPtr, &valuePtr1) != TCL_OK) {
        return TCL_ERROR;
    }
    newValue1 = 0;
    if (valuePtr1 == NULL) {
        valuePtr1 = Tcl_NewDictObj();
        newValue1 = 1;
    }
    keyPtr = idmPtr->namePtr;
    if (Tcl_DictObjGet(interp, valuePtr1, keyPtr, &valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (valuePtr2 == NULL) {
        valuePtr2 = Tcl_NewDictObj();
    }
    if (AddDictEntry(interp, valuePtr2, "-name", idmPtr->namePtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (idmPtr->icPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-component",
	         idmPtr->icPtr->ivPtr->fullNamePtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (idmPtr->asPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-as", idmPtr->asPtr)
                != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (idmPtr->usingPtr != NULL) {
        if (AddDictEntry(interp, valuePtr2, "-using", idmPtr->usingPtr)
                != TCL_OK) {
            return TCL_ERROR;
        }
    }
    haveExceptions = 0;
    listPtr = Tcl_NewListObj(0, NULL);
    FOREACH_HASH(keyPtr, value, &idmPtr->exceptions) {
        if (value == NULL) {
            /* FIXME need code here */
        }
        haveExceptions = 1;
        if (Tcl_ListObjAppendElement(interp, listPtr, keyPtr) != TCL_OK) {
            return TCL_ERROR;
	}
    }

    if (haveExceptions) {
        if (AddDictEntry(interp, valuePtr2, "-except", listPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    } else {
        Tcl_DecrRefCount(listPtr);
    }
    keyPtr = idmPtr->namePtr;
    if (Tcl_DictObjPut(interp, valuePtr1, keyPtr, valuePtr2) != TCL_OK) {
        return TCL_ERROR;
    }
    if (newValue1) {
        keyPtr = iclsPtr->fullNamePtr;
        if (Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr1) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    Tcl_SetVar2Ex(interp,
            ITCL_NAMESPACE"::internal::dicts::classDelegatedFunctions",
            NULL, dictPtr, 0);
    return TCL_OK;
}