/*
 * ------------------------------------------------------------------------
 *      PACKAGE:  [incr Tcl]
 *  DESCRIPTION:  Object-Oriented Extensions to Tcl
 *
 *  [incr Tcl] provides object-oriented extensions to Tcl, much as
 *  C++ provides object-oriented extensions to C.  It provides a means
 *  of encapsulating related procedures together with their shared data
 *  in a local namespace that is hidden from the outside world.  It
 *  promotes code re-use through inheritance.  More than anything else,
 *  it encourages better organization of Tcl applications through the
 *  object-oriented paradigm, leading to code that is easier to
 *  understand and maintain.
 *
 *  These procedures handle built-in class methods, including the
 *  "isa" method (to query hierarchy info) and the "info" method
 *  (to query class/object data).
 *
 * ========================================================================
 *  AUTHOR:  Michael J. McLennan
 *           Bell Labs Innovations for Lucent Technologies
 *           mmclennan@lucent.com
 *           http://www.tcltk.com/itcl
 *
 *  overhauled version author: Arnulf Wiedemann
 * ========================================================================
 *           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.
 */
#include "itclInt.h"

static Tcl_ObjCmdProc Itcl_BiInfoClassOptionsCmd;
static Tcl_ObjCmdProc Itcl_BiInfoComponentsCmd;
static Tcl_ObjCmdProc Itcl_BiInfoDefaultCmd;
static Tcl_ObjCmdProc Itcl_BiInfoDelegatedCmd;
static Tcl_ObjCmdProc Itcl_BiInfoExtendedClassCmd;
static Tcl_ObjCmdProc Itcl_BiInfoInstancesCmd;
static Tcl_ObjCmdProc Itcl_BiInfoHullTypeCmd;
static Tcl_ObjCmdProc Itcl_BiInfoMethodCmd;
static Tcl_ObjCmdProc Itcl_BiInfoMethodsCmd;
static Tcl_ObjCmdProc Itcl_BiInfoOptionsCmd;
static Tcl_ObjCmdProc Itcl_BiInfoTypeCmd;
static Tcl_ObjCmdProc Itcl_BiInfoTypeMethodCmd;
static Tcl_ObjCmdProc Itcl_BiInfoTypeMethodsCmd;
static Tcl_ObjCmdProc Itcl_BiInfoTypesCmd;
static Tcl_ObjCmdProc Itcl_BiInfoTypeVarsCmd;
static Tcl_ObjCmdProc Itcl_BiInfoTypeVariableCmd;
static Tcl_ObjCmdProc Itcl_BiInfoVariablesCmd;
static Tcl_ObjCmdProc Itcl_BiInfoWidgetadaptorCmd;
static Tcl_ObjCmdProc Itcl_BiInfoWidgetCmd;
static Tcl_ObjCmdProc Itcl_BiInfoDelegatedOptionsCmd;
static Tcl_ObjCmdProc Itcl_BiInfoDelegatedMethodsCmd;
static Tcl_ObjCmdProc Itcl_BiInfoDelegatedTypeMethodsCmd;
static Tcl_ObjCmdProc Itcl_BiInfoDelegatedOptionCmd;
static Tcl_ObjCmdProc Itcl_BiInfoDelegatedMethodCmd;
static Tcl_ObjCmdProc Itcl_BiInfoDelegatedTypeMethodCmd;
static Tcl_ObjCmdProc Itcl_BiInfoDelegatedUnknownCmd;
static Tcl_ObjCmdProc Itcl_BiInfoContextCmd;

typedef struct InfoMethod {
    const char* name;        /* method name */
    const char* usage;       /* string describing usage */
    Tcl_ObjCmdProc *proc;    /* implementation C proc */
    int flags;               /* which class commands have it */
} InfoMethod;

static const InfoMethod InfoMethodList[] = {
    { "args",
        "procname",
	Itcl_BiInfoArgsCmd,
	ITCL_CLASS|ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "body",
        "procname",
	Itcl_BiInfoBodyCmd,
	ITCL_CLASS|ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "class",
        "",
	Itcl_BiInfoClassCmd,
	ITCL_CLASS|ITCL_WIDGET|ITCL_ECLASS
    },
    { "classoptions",
        "?pattern?",
	Itcl_BiInfoClassOptionsCmd,
	ITCL_ECLASS
    },
    { "component",
        "?name? ?-inherit? ?-value?",
        Itcl_BiInfoComponentCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "context",
        "",
        Itcl_BiInfoContextCmd,
	ITCL_ECLASS
    },
    { "components",
        "?pattern?",
	Itcl_BiInfoComponentsCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "default",
        "method aname varname",
	Itcl_BiInfoDefaultCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "delegated",
        "?name? ?-inherit? ?-value?",
        Itcl_BiInfoDelegatedCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "extendedclass",
        "",
        Itcl_BiInfoExtendedClassCmd,
	ITCL_ECLASS
    },
    { "function",
        "?name? ?-protection? ?-type? ?-name? ?-args? ?-body?",
        Itcl_BiInfoFunctionCmd,
	ITCL_CLASS|ITCL_ECLASS
    },
    { "heritage",
        "",
	Itcl_BiInfoHeritageCmd,
	ITCL_CLASS|ITCL_WIDGET|ITCL_ECLASS
    },
    { "hulltype",
        "",
	Itcl_BiInfoHullTypeCmd,
	ITCL_WIDGET
    },
    { "hulltypes",
        "?pattern?",
        Itcl_BiInfoUnknownCmd,
	ITCL_WIDGETADAPTOR|ITCL_WIDGET
    },
    { "inherit",
        "",
	Itcl_BiInfoInheritCmd,
	ITCL_CLASS|ITCL_WIDGET|ITCL_ECLASS
    },
    { "instances",
        "?pattern?",
        Itcl_BiInfoInstancesCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET
    },
    { "method",
        "?name? ?-protection? ?-type? ?-name? ?-args? ?-body?",
        Itcl_BiInfoMethodCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "methods",
        "?pattern?",
        Itcl_BiInfoMethodsCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "option",
        "?name? ?-protection? ?-resource? ?-class? ?-name? ?-default? \
?-cgetmethod? ?-configuremethod? ?-validatemethod? \
?-cgetmethodvar? ?-configuremethodvar? ?-validatemethodvar? \
?-value?",
        Itcl_BiInfoOptionCmd,
	ITCL_WIDGET|ITCL_ECLASS
    },
    { "options",
        "?pattern?",
	Itcl_BiInfoOptionsCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "type",
        "",
	Itcl_BiInfoTypeCmd,
	ITCL_TYPE|ITCL_WIDGET|ITCL_ECLASS
    },
    { "typemethod",
        "?name? ?-protection? ?-type? ?-name? ?-args? ?-body?",
        Itcl_BiInfoTypeMethodCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "typemethods",
        "?pattern?",
	Itcl_BiInfoTypeMethodsCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "types",
        "?pattern?",
	Itcl_BiInfoTypesCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "typevariable",
        "?name? ?-protection? ?-type? ?-name? ?-init? ?-value?",
        Itcl_BiInfoTypeVariableCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "typevars",
        "?pattern?",
	Itcl_BiInfoTypeVarsCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "variable",
        "?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config? ?-scope?",
        Itcl_BiInfoVariableCmd,
	ITCL_CLASS|ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "variables",
        "?pattern?",
        Itcl_BiInfoVariablesCmd,
	ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "vars",
        "?pattern?",
	Itcl_BiInfoVarsCmd,
	ITCL_CLASS|ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "widget",
        "",
        Itcl_BiInfoWidgetCmd,
	ITCL_WIDGET
    },
    { "widgets",
        "?pattern?",
        Itcl_BiInfoUnknownCmd,
	ITCL_WIDGET
    },
    { "widgetclasses",
        "?pattern?",
        Itcl_BiInfoUnknownCmd,
	ITCL_WIDGET
    },
    { "widgetadaptor",
        "",
        Itcl_BiInfoWidgetadaptorCmd,
	ITCL_WIDGETADAPTOR
    },
    { "widgetadaptors",
        "?pattern?",
        Itcl_BiInfoUnknownCmd,
	ITCL_WIDGETADAPTOR
    },
    { NULL,
        NULL,
	NULL,
	0
    }
};

struct NameProcMap2 {
    const char* name;        /* method name */
    const char* usage;       /* string describing usage */
    Tcl_ObjCmdProc *proc;    /* implementation C proc */
    int flags;               /* which class commands have it */
};

static const struct NameProcMap2 infoCmdsDelegated2[] = {
    { "::itcl::builtin::Info::delegated::methods",
	"?pattern?",
        Itcl_BiInfoDelegatedMethodsCmd,
        ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "::itcl::builtin::Info::delegated::typemethods",
	"?pattern?",
        Itcl_BiInfoDelegatedTypeMethodsCmd,
        ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "::itcl::builtin::Info::delegated::options",
	"?pattern?",
        Itcl_BiInfoDelegatedOptionsCmd,
        ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { "::itcl::builtin::Info::delegated::method",
	"methodName",
        Itcl_BiInfoDelegatedMethodCmd,
        ITCL_ECLASS
    },
    { "::itcl::builtin::Info::delegated::typemethod",
	"methodName",
        Itcl_BiInfoDelegatedTypeMethodCmd,
        ITCL_ECLASS
    },
    { "::itcl::builtin::Info::delegated::option",
	"methodName",
        Itcl_BiInfoDelegatedOptionCmd,
        ITCL_ECLASS
    },
    { "::itcl::builtin::Info::delegated::unknown",
	"",
        Itcl_BiInfoDelegatedUnknownCmd,
        ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
    },
    { NULL, NULL, NULL, 0 }
};

static void ItclGetInfoUsage(Tcl_Interp *interp, Tcl_Obj*objPtr,
	ItclObjectInfo *infoPtr, ItclClass *iclsPtr);


/*
 * ------------------------------------------------------------------------
 *  ItclInfoInit()
 *
 *  Creates a namespace full of built-in methods/procs for [incr Tcl]
 *  classes.  This includes things like the "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.
 * ------------------------------------------------------------------------
 */

static int
InfoGutsFinish(
    void *data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    Tcl_CallFrame *framePtr = (Tcl_CallFrame *) data[0];
    ItclObjectInfo *infoPtr = (ItclObjectInfo *) data[1];
    ItclCallContext *cPtr = (ItclCallContext *) data[2];
    ItclCallContext *popped;

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

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

    popped = (ItclCallContext *)Itcl_PopStack(stackPtr);

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

    if (cPtr != popped) {
	Tcl_Panic("Context stack mismatch!");
    }
    ckfree((char *) cPtr);

    return result;
}

int
ItclInfoGuts(
    ItclObject *ioPtr,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    ItclObjectInfo *infoPtr = ioPtr->infoPtr;
    Tcl_CmdInfo info;
    ItclCallContext *cPtr;
    Tcl_CallFrame *framePtr;
    Tcl_HashEntry *hPtr;
    Itcl_Stack *stackPtr;
    int isNew;

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

	Tcl_Obj *objPtr = Tcl_NewStringObj(
		"wrong # args: should be one of...\n", TCL_INDEX_NONE);
	ItclGetInfoUsage(interp, objPtr, infoPtr, ioPtr->iclsPtr);
	Tcl_SetObjResult(interp, objPtr);
	return TCL_ERROR;
    }

    framePtr = Itcl_GetUplevelCallFrame(interp, 0);

    hPtr = Tcl_CreateHashEntry(&infoPtr->frameContext, (char *)framePtr, &isNew);
    if (isNew) {
	stackPtr = (Itcl_Stack *) ckalloc(sizeof(Itcl_Stack));
	Itcl_InitStack(stackPtr);
	Tcl_SetHashValue(hPtr, stackPtr);
    } else {
	stackPtr = (Itcl_Stack *) Tcl_GetHashValue(hPtr);
    }

    cPtr = (ItclCallContext *) ckalloc(sizeof(ItclCallContext));
    cPtr->objectFlags = ITCL_OBJECT_ROOT_METHOD;
    cPtr->nsPtr = NULL;
    cPtr->ioPtr = ioPtr;
    cPtr->imPtr = NULL;
    cPtr->refCount = 1;

    Itcl_PushStack(cPtr, stackPtr);

    Tcl_NRAddCallback(interp, InfoGutsFinish, framePtr, infoPtr, cPtr, NULL);
    Tcl_GetCommandInfoFromToken(infoPtr->infoCmd, &info);
#if TCL_MAJOR_VERSION > 8
    if (info.isNativeObjectProc == 2) {
	return Tcl_NRCallObjProc2(interp, info.objProc2, info.objClientData2,
		objc-1, objv+1);
    }
#endif
    return Tcl_NRCallObjProc(interp, info.objProc, info.objClientData,
	    objc-1, objv+1);
}

static int
NRInfoWrap(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_CmdInfo info;
    ItclObjectInfo *infoPtr = (ItclObjectInfo *)clientData;

    if (!infoPtr->infoCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"itcl info-subsystem is deleted", TCL_INDEX_NONE));
	return TCL_ERROR;
    }

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

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

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

    Tcl_GetCommandInfoFromToken(infoPtr->infoCmd, &info);
#if TCL_MAJOR_VERSION > 8
    if (info.isNativeObjectProc == 2) {
	return Tcl_NRCallObjProc2(interp, info.objProc2, info.objClientData2,
		objc, objv);
    }
#endif
    return Tcl_NRCallObjProc(interp, info.objProc, info.objClientData,
	    objc, objv);
}

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

static void
InfoCmdDelete(
    void *clientData)
{
    ItclObjectInfo *infoPtr = (ItclObjectInfo *)clientData;

    infoPtr->infoCmd = NULL;
}

int
ItclInfoInit(
    Tcl_Interp *interp,      /* current interpreter */
    ItclObjectInfo *infoPtr)
{
    Tcl_Namespace *nsPtr;
    Tcl_Command token;
    Tcl_CmdInfo info;
    Tcl_Obj *unkObjPtr;
    Tcl_Obj *ensObjPtr;
    int result;
    int i;

    /*
     * Build the ensemble used to implement [info].
     */

    nsPtr = Tcl_CreateNamespace(interp, "::itcl::builtin::Info", NULL, NULL);
    if (nsPtr == NULL) {
        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);
    infoPtr->infoCmd = token;
    token = Tcl_NRCreateCommand(interp, "::itcl::builtin::info", InfoWrap,
	    NRInfoWrap, infoPtr, InfoCmdDelete);
    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", TCL_INDEX_NONE);

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

	Tcl_AppendToObj(cmdObjPtr, "::", 2);
	Tcl_AppendToObj(cmdObjPtr, InfoMethodList[i].name, TCL_INDEX_NONE);
        Tcl_CreateObjCommand(interp, Tcl_GetString(cmdObjPtr),
                InfoMethodList[i].proc, infoPtr,
                InfoMethodList[i].proc == Itcl_BiInfoVarsCmd ? ItclRestoreInfoVars : NULL);
	Tcl_DecrRefCount(cmdObjPtr);
    }
    unkObjPtr = Tcl_NewStringObj("::itcl::builtin::Info::unknown", TCL_INDEX_NONE);
    Tcl_CreateObjCommand(interp, Tcl_GetString(unkObjPtr),
	    Itcl_BiInfoUnknownCmd, infoPtr, NULL);
    if (Tcl_SetEnsembleUnknownHandler(NULL,
            Tcl_FindEnsemble(interp, ensObjPtr, TCL_LEAVE_ERR_MSG),
	    unkObjPtr) != TCL_OK) {
        Tcl_DecrRefCount(unkObjPtr);
        Tcl_DecrRefCount(ensObjPtr);
        return TCL_ERROR;
    }
    Tcl_DecrRefCount(ensObjPtr);

    /*
     * Build the ensemble used to implement [info delegated].
     */

    nsPtr = Tcl_CreateNamespace(interp, "::itcl::builtin::Info::delegated",
            NULL, NULL);
    if (nsPtr == NULL) {
        Tcl_Panic("ITCL: error in creating namespace: ::itcl::builtin::Info::delegated \n");
    }
    Tcl_CreateEnsemble(interp, nsPtr->fullName, nsPtr,
        TCL_ENSEMBLE_PREFIX);
    Tcl_Export(interp, nsPtr, "[a-z]*", 1);
    for (i=0 ; infoCmdsDelegated2[i].name!=NULL ; i++) {
        Tcl_CreateObjCommand(interp, infoCmdsDelegated2[i].name,
                infoCmdsDelegated2[i].proc, infoPtr, NULL);
    }
    ensObjPtr = Tcl_NewStringObj("::itcl::builtin::Info::delegated",
            TCL_INDEX_NONE);
    unkObjPtr = Tcl_NewStringObj(
            "::itcl::builtin::Info::delegated::unknown", TCL_INDEX_NONE);
    result = TCL_OK;
    if (Tcl_SetEnsembleUnknownHandler(NULL,
            Tcl_FindEnsemble(interp, ensObjPtr, TCL_LEAVE_ERR_MSG),
	    unkObjPtr) != TCL_OK) {
        result = TCL_ERROR;
    }
    Tcl_DecrRefCount(ensObjPtr);
    return result;
}

/*
 * ------------------------------------------------------------------------
 *  ItclGetInfoUsage()
 *
 * ------------------------------------------------------------------------
  */
void
ItclGetInfoUsage(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,       /* returns: summary of usage info */
    TCL_UNUSED(ItclObjectInfo *),
    ItclClass *iclsPtr)
{
    const char *spaces = "  ";
    int i;
    ItclObject *ioPtr;

    if (iclsPtr == NULL) {
    if (TCL_ERROR == Itcl_GetContext(interp, &iclsPtr, &ioPtr)) {
	return;
    }
    }
    for (i=0; InfoMethodList[i].name != NULL; i++) {
	if (strcmp(InfoMethodList[i].name, "vars") == 0) {
	    /* we don't report that, as it is a special case
	     * it is only adding the protected and private commons
	     * to the ::info vars command */
	    continue;
	}
	    if (iclsPtr->flags & InfoMethodList[i].flags) {
                Tcl_AppendToObj(objPtr, spaces, TCL_INDEX_NONE);
                Tcl_AppendToObj(objPtr, "info ", TCL_INDEX_NONE);
                Tcl_AppendToObj(objPtr, InfoMethodList[i].name, TCL_INDEX_NONE);
	        if (strlen(InfoMethodList[i].usage) > 0) {
                  Tcl_AppendToObj(objPtr, " ", TCL_INDEX_NONE);
                  Tcl_AppendToObj(objPtr, InfoMethodList[i].usage, TCL_INDEX_NONE);
	        }
                spaces = "\n  ";
	    }
    }
        Tcl_AppendToObj(objPtr,
            "\n...and others described on the man page", TCL_INDEX_NONE);
}

/*
 * ------------------------------------------------------------------------
 *  ItclGetInfoDelegatedUsage()
 *
 * ------------------------------------------------------------------------
  */
static void
ItclGetInfoDelegatedUsage(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,       /* returns: summary of usage info */
    TCL_UNUSED(ItclObjectInfo *))
{
    ItclClass *iclsPtr;
    const char *name;
    const char *lastName;
    const char *spaces = "  ";

    int i;

    ItclObject *ioPtr;

    if (TCL_ERROR == Itcl_GetContext(interp, &iclsPtr, &ioPtr)) {
	return;
    }
    for (i=0; infoCmdsDelegated2[i].name != NULL; i++) {
	name = infoCmdsDelegated2[i].name;
	lastName = name;
	while (name != NULL) {
	    name = strstr(name, "::");
	    if (name == NULL) {
	        break;
	    }
	    name += 2;
	    lastName = name;
	}
	name = lastName;
	if (strcmp(name, "unknown") == 0) {
	    /* we don't report that, as it is a special case */
	    continue;
	}
	    if (iclsPtr->flags & infoCmdsDelegated2[i].flags) {
                Tcl_AppendToObj(objPtr, spaces, TCL_INDEX_NONE);
                Tcl_AppendToObj(objPtr, "info ", TCL_INDEX_NONE);
                Tcl_AppendToObj(objPtr, name, TCL_INDEX_NONE);
	        if (strlen(infoCmdsDelegated2[i].usage) > 0) {
                  Tcl_AppendToObj(objPtr, " ", TCL_INDEX_NONE);
                  Tcl_AppendToObj(objPtr, infoCmdsDelegated2[i].usage, TCL_INDEX_NONE);
	        }
                spaces = "\n  ";
	    }
    }
        Tcl_AppendToObj(objPtr,
            "\n...and others described on the man page", TCL_INDEX_NONE);
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoClassCmd()
 *
 *  Returns information regarding the class for an object.  This command
 *  can be invoked with or without an object context:
 *
 *    <objName> info class   <= returns most-specific class name
 *    info class             <= returns active namespace name
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

int
Itcl_BiInfoClassCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    Tcl_Namespace *contextNs = NULL;
    ItclClass *contextIclsPtr = NULL;
    ItclObject *contextIoPtr;

    char *name;

    ItclShowArgs(1, "Itcl_BiInfoClassCmd", objc, objv);
    if (objc != 1) {
	/* TODO: convert to NR-enabled fallback to [::info] */
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
        return TCL_ERROR;
    }

    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	/* try it the hard way */
	void *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((Tcl_ObjectContext)clientData);
		contextIoPtr = (ItclObject *)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 }", TCL_INDEX_NONE));
		    return TCL_ERROR;
	}
    }

    /*
     *  If there is an object context, then return the most-specific
     *  class for the object.  Otherwise, return the class namespace
     *  name.  Use normal class names when possible.
     */
    if (contextIoPtr) {
        contextNs = contextIoPtr->iclsPtr->nsPtr;
    } else {
        assert(contextIclsPtr != NULL);
        assert(contextIclsPtr->nsPtr != NULL);
        contextNs = contextIclsPtr->nsPtr;
    }

    assert(contextNs);

        name = contextNs->fullName;

    Tcl_SetObjResult(interp, Tcl_NewStringObj(name, TCL_INDEX_NONE));
    return TCL_OK;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoClassOptionsCmd()
 *
 *  Returns information regarding the options for a class.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoClassOptionsCmd(
    TCL_UNUSED(void *),    /* 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 *listPtr;
    Tcl_Obj *listPtr2;
    Tcl_Obj *objPtr;
    Tcl_Obj **lObjv;
    Tcl_HashTable *tablePtr;
    ItclObject *ioPtr;
    ItclClass *iclsPtr;
    ItclOption *ioptPtr;
    ItclDelegatedOption *idoPtr;
    const char *name;
    const char *val;
    const char *pattern;
    Tcl_Size lObjc;
    int result;
    Tcl_Size 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 ", NULL);
        return TCL_ERROR;
    }
    if (objc > 2) {
	Tcl_AppendResult(interp, "wrong # args should be: info options ",
	        "?pattern?", NULL);
        return TCL_ERROR;
    }
    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);
    }
    listPtr = Tcl_NewListObj(0, NULL);
    tablePtr = &iclsPtr->options;
    FOREACH_HASH_VALUE(ioptPtr, tablePtr) {
	name = Tcl_GetString(ioptPtr->namePtr);
	if ((pattern == NULL) ||
                 Tcl_StringCaseMatch(name, pattern, 0)) {
            Tcl_ListObjAppendElement(interp, listPtr,
	            Tcl_NewStringObj(Tcl_GetString(ioptPtr->namePtr), TCL_INDEX_NONE));
        }
    }
    tablePtr = &iclsPtr->delegatedOptions;
    FOREACH_HASH_VALUE(idoPtr, tablePtr) {
        name = Tcl_GetString(idoPtr->namePtr);
	if (strcmp(name, "*") != 0) {
	    if ((pattern == NULL) ||
                    Tcl_StringCaseMatch(name, pattern, 0)) {
                Tcl_ListObjAppendElement(interp, listPtr,
	                Tcl_NewStringObj(Tcl_GetString(idoPtr->namePtr), TCL_INDEX_NONE));
	    }
        } else {
	    if (idoPtr->icPtr == NULL) {
		Tcl_AppendResult(interp, "component \"",
		        Tcl_GetString(idoPtr->namePtr),
			"\" is not initialized", NULL);
	        return TCL_ERROR;
	    }
	    val = ItclGetInstanceVar(interp,
	            Tcl_GetString(idoPtr->icPtr->namePtr),
	            NULL, ioPtr, ioPtr->iclsPtr);
            if ((val != NULL) && (strlen(val) != 0)) {
		objPtr = Tcl_NewStringObj(val, TCL_INDEX_NONE);
		Tcl_AppendToObj(objPtr, " configure", TCL_INDEX_NONE);
		Tcl_IncrRefCount(objPtr);
		result = Tcl_EvalObjEx(interp, objPtr, 0);
		Tcl_DecrRefCount(objPtr);
		if (result != TCL_OK) {
		    return TCL_ERROR;
		}
	        listPtr2 = Tcl_GetObjResult(interp);
		Tcl_ListObjGetElements(interp, listPtr2, &lObjc, &lObjv);
		for (i = 0; i < lObjc; i++) {
		    Tcl_ListObjIndex(interp, lObjv[i], 0, &objPtr);
		    hPtr2 = Tcl_FindHashEntry(&idoPtr->exceptions,
		            (char *)objPtr);
		    if (hPtr2 == NULL) {
			name = Tcl_GetString(objPtr);
	                if ((pattern == NULL) ||
                                 Tcl_StringCaseMatch(name, pattern, 0)) {
		            Tcl_ListObjAppendElement(interp, listPtr, objPtr);
		        }
		    }
		}
	    }
	}
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoContextCmd()
 *
 *  Returns information regarding the context object and class.  This command
 *  can only be invoked with an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoContextCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    Tcl_Obj *listPtr;
    Tcl_Obj *objPtr;
    ItclObject *ioPtr = NULL;
    ItclClass *iclsPtr;

    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 ", NULL);
        return TCL_ERROR;
    }
    listPtr = Tcl_NewListObj(0, NULL);
    objPtr = Tcl_NewStringObj(Tcl_GetString(iclsPtr->namePtr), TCL_INDEX_NONE);
    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
    objPtr = Tcl_NewStringObj(Tcl_GetString(ioPtr->namePtr), TCL_INDEX_NONE);
    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoInheritCmd()
 *
 *  Returns the list of base classes for the current class context.
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

int
Itcl_BiInfoInheritCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    ItclClass *contextIclsPtr = NULL;
    ItclObject *contextIoPtr = NULL;
    Itcl_ListElem *elem;
    Tcl_Obj *listPtr;

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

    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */

    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info inherit }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }

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

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

    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoHeritageCmd()
 *
 *  Returns the entire derivation hierarchy for this class, presented
 *  in the order that classes are traversed for finding data members
 *  and member functions.
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

int
Itcl_BiInfoHeritageCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    ItclClass *contextIclsPtr = NULL;
    ItclObject *contextIoPtr = NULL;
    ItclHierIter hier;
    Tcl_Obj *listPtr;
    Tcl_Obj *objPtr;
    ItclClass *iclsPtr;

    ItclShowArgs(2, "Itcl_BiInfoHeritageCmd", objc, objv);
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, 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) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info heritage }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }

    /*
     *  Traverse through the derivation hierarchy and return
     *  base class names.
     */
    listPtr = Tcl_NewListObj(0, 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, TCL_INDEX_NONE);
        Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
    }
    Itcl_DeleteHierIter(&hier);

    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoFunctionCmd()
 *
 *  Returns information regarding class member functions (methods/procs).
 *  Handles the following syntax:
 *
 *    info function ?cmdName? ?-protection? ?-type? ?-name? ?-args? ?-body?
 *
 *  If the ?cmdName? is not specified, then a list of all known
 *  command members is returned.  Otherwise, the information for
 *  a specific command is returned.  Returns a status TCL_OK/TCL_ERROR
 *  to indicate success/failure.
 * ------------------------------------------------------------------------
 */

int
Itcl_BiInfoFunctionCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    char *cmdName = NULL;
    Tcl_Obj *resultPtr = NULL;
    Tcl_Obj *objPtr = NULL;

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

    static enum BIfIdx DefInfoFunction[5] = {
        BIfProtectIdx,
        BIfTypeIdx,
        BIfNameIdx,
        BIfArgsIdx,
        BIfBodyIdx
    };

    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

    ItclClass *iclsPtr;
    int i;
    int result;
    const char *val;
    Tcl_HashSearch place;
    Tcl_HashEntry *entry;
    ItclMemberFunc *imPtr;
    ItclMemberCode *mcode;
    ItclHierIter hier;

    ItclShowArgs(2, "Itcl_InfoFunctionCmd", objc, objv);
    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info function ... }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }

    /*
     *  Process args:
     *  ?cmdName? ?-protection? ?-type? ?-name? ?-args? ?-body?
     */
    objv++;  /* skip over command name */
    objc--;

    if (objc > 0) {
        cmdName = Tcl_GetString(*objv);
        objc--; objv++;
    }

    /*
     *  Return info for a specific command.
     */
    if (cmdName) {
	ItclCmdLookup *clookup;
	objPtr = Tcl_NewStringObj(cmdName, TCL_INDEX_NONE);
        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, "\"",
                NULL);
            return TCL_ERROR;
        }

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

        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            objc = 5;
            iflist = DefInfoFunction;
        } else {

            /*
             *  Otherwise, scan through all remaining flags and
             *  figure out what to return.
             */
            iflist = &iflistStorage[0];
            for (i=0 ; i < objc; i++) {
                result = Tcl_GetIndexFromObjStruct(interp, objv[i],
                    options, sizeof(char *), "option", 0, (int*)(&iflist[i]));
                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

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

        for (i=0 ; i < objc; i++) {
            switch (iflist[i]) {
                case BIfArgsIdx:
                    if (mcode && mcode->argListPtr) {
			if (imPtr->usagePtr == NULL) {
                            objPtr = Tcl_NewStringObj(
			            Tcl_GetString(mcode->usagePtr), TCL_INDEX_NONE);
			} else {
                            objPtr = Tcl_NewStringObj(
			            Tcl_GetString(imPtr->usagePtr), TCL_INDEX_NONE);
		        }
                    } else {
		        if ((imPtr->flags & ITCL_ARG_SPEC) != 0) {
			    if (imPtr->usagePtr == NULL) {
                                objPtr = Tcl_NewStringObj(
				        Tcl_GetString(mcode->usagePtr), TCL_INDEX_NONE);
			    } else {
			        objPtr = Tcl_NewStringObj(
				        Tcl_GetString(imPtr->usagePtr), TCL_INDEX_NONE);
			    }
                        } else {
                            objPtr = Tcl_NewStringObj("<undefined>", TCL_INDEX_NONE);
                        }
		    }
                    break;

                case BIfBodyIdx:
                    if (mcode && Itcl_IsMemberCodeImplemented(mcode)) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(mcode->bodyPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("<undefined>", TCL_INDEX_NONE);
                    }
                    break;

                case BIfNameIdx:
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(imPtr->fullNamePtr), TCL_INDEX_NONE);
                    break;

                case BIfProtectIdx:
                    val = Itcl_ProtectionStr(imPtr->protection);
                    objPtr = Tcl_NewStringObj(val, TCL_INDEX_NONE);
                    break;

                case BIfTypeIdx:
                    val = ((imPtr->flags & ITCL_COMMON) != 0)
                        ? "proc" : "method";
                    objPtr = Tcl_NewStringObj(val, TCL_INDEX_NONE);
                    break;
            }

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

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

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

                imPtr = (ItclMemberFunc*)Tcl_GetHashValue(entry);
		if (imPtr->codePtr && (imPtr->codePtr->flags & ITCL_BUILTIN)) {
		    if (strcmp(Tcl_GetString(imPtr->namePtr), "info") == 0) {
		        useIt = 0;
		    }
		    if (strcmp(Tcl_GetString(imPtr->namePtr), "setget") == 0) {
			if (!(imPtr->iclsPtr->flags & ITCL_ECLASS)) {
		            useIt = 0;
		        }
		    }
		    if (strcmp(Tcl_GetString(imPtr->namePtr),
		            "installcomponent") == 0) {
			if (!(imPtr->iclsPtr->flags &
			        (ITCL_WIDGET|ITCL_WIDGETADAPTOR))) {
		            useIt = 0;
		        }
		    }
		}
		if (useIt) {
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(imPtr->fullNamePtr), TCL_INDEX_NONE);
                    Tcl_ListObjAppendElement(NULL,
		            resultPtr, objPtr);
                }

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

        Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoVariableCmd()
 *
 *  Returns information regarding class data members (variables and
 *  commons).  Handles the following syntax:
 *
 *    info variable ?varName? ?-protection? ?-type? ?-name?
 *        ?-init? ?-config? ?-value?
 *
 *  If the ?varName? is not specified, then a list of all known
 *  data members is returned.  Otherwise, the information for a
 *  specific member is returned.  Returns a status TCL_OK/TCL_ERROR
 *  to indicate success/failure.
 * ------------------------------------------------------------------------
 */
/*&&&1*/

int
Itcl_BiInfoVariableCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    Tcl_Obj *resultPtr;
    Tcl_Obj *objPtr;
    Tcl_HashSearch place;
    Tcl_HashEntry *entry;
    ItclClass *iclsPtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclVariable *ivPtr;
    ItclVarLookup *vlookup;
    ItclHierIter hier;
    char *varName;
    const char *val;
    int i;
    int result;

    void *cfClientData;
    ItclObjectInfo *infoPtr;
    Tcl_Object oPtr;
    int doAppend;

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

    static enum BIvIdx DefInfoVariable[5] = {
        BIvProtectIdx,
        BIvTypeIdx,
        BIvNameIdx,
        BIvInitIdx,
        BIvValueIdx
    };

    static enum BIvIdx DefInfoPubVariable[6] = {
        BIvProtectIdx,
        BIvTypeIdx,
        BIvNameIdx,
        BIvInitIdx,
        BIvConfigIdx,
        BIvValueIdx
    };

    ItclShowArgs(1, "Itcl_BiInfoVariableCmd", objc, objv);
    resultPtr = NULL;
    objPtr = NULL;
    varName = NULL;
    contextIclsPtr = NULL;
    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info variable ... }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }

    /*
     *  Process args:
     *  ?varName? ?-protection? ?-type? ?-name? ?-init? ?-config? ?-value? ?-scope?
     */
    objv++;  /* skip over command name */
    objc--;

    if (objc > 0) {
        varName = Tcl_GetString(*objv);
        objc--; objv++;
    }

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

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

        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            if (ivPtr->protection == ITCL_PUBLIC &&
                    ((ivPtr->flags & ITCL_COMMON) == 0)) {
                ivlist = DefInfoPubVariable;
                objc = 6;
            } else {
                ivlist = DefInfoVariable;
                objc = 5;
            }
        } else {

            /*
             *  Otherwise, scan through all remaining flags and
             *  figure out what to return.
             */
            ivlist = &ivlistStorage[0];
            for (i=0 ; i < objc; i++) {
                result = Tcl_GetIndexFromObjStruct(interp, objv[i],
                    options, sizeof(char *), "option", 0, (int*)(&ivlist[i]));
                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

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

        for (i=0 ; i < objc; i++) {
            switch (ivlist[i]) {
                case BIvConfigIdx:
                    if (ivPtr->codePtr &&
		            Itcl_IsMemberCodeImplemented(ivPtr->codePtr)) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(ivPtr->codePtr->bodyPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                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(NULL, 0);
                            Tcl_GetCommandFullName(
                                contextIoPtr->iclsPtr->interp,
                                contextIoPtr->accessCmd, objPtr);
                        } else {
                            objPtr = Tcl_NewStringObj("<objectName>", TCL_INDEX_NONE);
                        }
                    } else {
		        if (vlookup->ivPtr->init) {
			    objPtr = Tcl_NewStringObj(
			            Tcl_GetString(vlookup->ivPtr->init), TCL_INDEX_NONE);
                        } else {
                            objPtr = Tcl_NewStringObj("<undefined>", TCL_INDEX_NONE);
		        }
                    }
                    break;

                case BIvNameIdx:
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(ivPtr->fullNamePtr), TCL_INDEX_NONE);
                    break;

                case BIvProtectIdx:
                    val = Itcl_ProtectionStr(ivPtr->protection);
                    objPtr = Tcl_NewStringObj((const char *)val, TCL_INDEX_NONE);
                    break;

                case BIvTypeIdx:
                    val = ((ivPtr->flags & ITCL_COMMON) != 0)
                        ? "common" : "variable";
                    objPtr = Tcl_NewStringObj((const char *)val, TCL_INDEX_NONE);
                    break;

                case BIvValueIdx:
                    if ((ivPtr->flags & ITCL_COMMON) != 0) {
                        val = Itcl_GetCommonVar(interp,
			        Tcl_GetString(ivPtr->fullNamePtr),
                                ivPtr->iclsPtr);
                    } else {
		        if (contextIoPtr == NULL) {
                            if (objc > 1) {
			        Tcl_DecrRefCount(resultPtr);
			    }
                            Tcl_ResetResult(interp);
                            Tcl_AppendResult(interp,
                                    "cannot access object-specific info ",
                                    "without an object context",
                                    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, TCL_INDEX_NONE);
                    break;

                case BIvScopeIdx:
                    entry = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, varName);
                    if (!entry) {
                        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                              "variable \"", varName, "\" not found in class \"",
                              Tcl_GetString(contextIclsPtr->fullNamePtr), "\"",
                              (char*)NULL);
                        return TCL_ERROR;
                    }
                    vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);

                    if (vlookup->ivPtr->flags & ITCL_COMMON) {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);

                        if (vlookup->ivPtr->protection != ITCL_PUBLIC) {
                            Tcl_AppendToObj(objPtr, ITCL_VARIABLES_NAMESPACE, TCL_INDEX_NONE);
                        }
                        Tcl_AppendToObj(objPtr,
                                Tcl_GetString(vlookup->ivPtr->fullNamePtr), TCL_INDEX_NONE);
                    } else {
                        /*
                         *  If this is not a common variable, then we better have
                         *  an object context.  Return the name as a fully qualified name.
                         */
                        infoPtr = contextIclsPtr->infoPtr;
                        cfClientData = Itcl_GetCallFrameClientData(interp);
                        if (cfClientData != NULL) {
                            oPtr = Tcl_ObjectContextObject((Tcl_ObjectContext)cfClientData);
                            if (oPtr != NULL) {
                                contextIoPtr = (ItclObject*)Tcl_ObjectGetMetadata(
                                        oPtr, infoPtr->object_meta_type);
                            }
                        }

                        if (contextIoPtr == NULL) {
                            if (infoPtr->currIoPtr != NULL) {
                                contextIoPtr = infoPtr->currIoPtr;
                            }
                        }

                        if (contextIoPtr == NULL) {
                            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                                "can't scope variable \"", varName,
                                "\": missing object context",
                                (char*)NULL);
                            return TCL_ERROR;
                        }

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

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

                        if (doAppend) {
                            Tcl_AppendToObj(objPtr,
                                    Tcl_GetString(vlookup->ivPtr->fullNamePtr), TCL_INDEX_NONE);
                        } else {
                            Tcl_AppendToObj(objPtr, "::", TCL_INDEX_NONE);
                            Tcl_AppendToObj(objPtr,
                                    Tcl_GetString(vlookup->ivPtr->namePtr), TCL_INDEX_NONE);
                        }
                    }
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement(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, 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), TCL_INDEX_NONE);
                        Tcl_ListObjAppendElement(NULL,
                            resultPtr, objPtr);
                    }
                } else {
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(ivPtr->fullNamePtr), TCL_INDEX_NONE);
                    Tcl_ListObjAppendElement(NULL,
                        resultPtr, objPtr);
                }
                entry = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoVarsCmd()
 *
 *  Returns information regarding variables
 *
 *    info vars ?pattern?
 *  uses ::info vars and adds Itcl common variables!!
 *
 *  Returns a status TCL_OK/TCL_ERROR
 *  to indicate success/failure.
 * ------------------------------------------------------------------------
 */

int
Itcl_BiInfoVarsCmd(
    void *clientData, /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *listPtr;
    Tcl_Obj **newObjv;
    Tcl_Namespace *nsPtr;
    ItclObjectInfo *infoPtr;
    ItclClass *iclsPtr = NULL;
    ItclVariable *ivPtr;
    const char *pattern;
    const char *name;
    int useGlobalInfo;
    int result;
    ItclObject *ioPtr;

    ItclShowArgs(1, "Itcl_BiInfoVars", objc, objv);
    result = TCL_OK;
    useGlobalInfo = 1;
    pattern = NULL;
    infoPtr = (ItclObjectInfo *)clientData;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, " ?pattern?");
	return TCL_ERROR;
    }

    if (TCL_OK != Itcl_GetContext(interp, &iclsPtr, &ioPtr)) {
	/* Clear the error message */
	Tcl_ResetResult(interp);
    }
    if (iclsPtr) {
	    if (iclsPtr->flags & (ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET)) {
	        /* don't use the ::tcl::info::vars command */
	        useGlobalInfo = 0;
	        if (objc == 2) {
		    pattern = Tcl_GetString(objv[1]);
		}
	    }
    }
    if (useGlobalInfo) {
        newObjv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *)*(objc));
        newObjv[0] = Tcl_NewStringObj("::tcl::info::vars", TCL_INDEX_NONE);
        Tcl_IncrRefCount(newObjv[0]);
        memcpy(newObjv+1, objv+1, sizeof(Tcl_Obj *)*(objc-1));
        result = Tcl_EvalObjv(interp, objc, newObjv, 0);
        Tcl_DecrRefCount(newObjv[0]);
        ckfree((char *)newObjv);
    } else {
	listPtr = Tcl_NewListObj(0, NULL);
	FOREACH_HASH_VALUE(ivPtr, &iclsPtr->variables) {
	    if ((ivPtr->flags & ITCL_VARIABLE) != 0) {
		name = Tcl_GetString(ivPtr->namePtr);
                if ((pattern == NULL) ||
		        Tcl_StringCaseMatch((const char *)name, pattern, 0)) {
	            Tcl_ListObjAppendElement(interp, listPtr, ivPtr->namePtr);
	        }
            }
	}
	/* always add the itcl_options variable */
        Tcl_ListObjAppendElement(interp, listPtr,
	        Tcl_NewStringObj("itcl_options", TCL_INDEX_NONE));
        Tcl_SetObjResult(interp, listPtr);
        return TCL_OK;
    }
    if (objc < 2) {
        return result;
    }
    if (result == TCL_OK) {
	Tcl_DString buffer;
	const char *head;
	const char *tail;
        /* check if the pattern contains a class namespace
	 * and if yes add the common private and protected vars
	 * and remove the ___DO_NOT_DELETE_THIS_VARIABLE var
	 */
	Itcl_ParseNamespPath(Tcl_GetString(objv[1]), &buffer, &head, &tail);
        if (head == NULL) {
	    nsPtr = Tcl_GetCurrentNamespace(interp);
	} else {
            nsPtr = Tcl_FindNamespace(interp, head, NULL, 0);
        }
	    hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses,
	            (char *)nsPtr);
	    if (hPtr != NULL) {
		Itcl_List varList;
		Tcl_Obj *resultListPtr;
		Tcl_Obj *namePtr;

		Itcl_InitList(&varList);
		iclsPtr = (ItclClass *)Tcl_GetHashValue(hPtr);
		resultListPtr = Tcl_GetObjResult(interp);
/* 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(
			            Tcl_GetString(ivPtr->fullNamePtr), TCL_INDEX_NONE);
		        } else {
		            namePtr = Tcl_NewStringObj(
			            Tcl_GetString(ivPtr->namePtr), TCL_INDEX_NONE);
		        }
		        Tcl_ListObjAppendElement(interp, resultListPtr,
		                namePtr);
		    }
		    if ((ivPtr->flags & ITCL_COMMON) != 0) {
		        if (ivPtr->protection != ITCL_PUBLIC) {
			    if (head != NULL) {
			        namePtr = Tcl_NewStringObj(
				        Tcl_GetString(ivPtr->fullNamePtr), TCL_INDEX_NONE);
			    } else {
			        namePtr = Tcl_NewStringObj(
				        Tcl_GetString(ivPtr->namePtr), TCL_INDEX_NONE);
			    }
		            Tcl_ListObjAppendElement(interp, resultListPtr,
			            namePtr);
		        }
		    }
		}
	    }
    }
    return result;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoUnknownCmd()
 *
 *  the unknown handler for the ::itcl::builtin::Info ensemble
 * ------------------------------------------------------------------------
 */

int
Itcl_BiInfoUnknownCmd(
    void *clientData,   /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj *objPtr, *listObj;
    int usage = 1;
    int code = TCL_ERROR;

    ItclShowArgs(1, "Itcl_BiInfoUnknownCmd", objc, objv);

    if (objc < 2) {
	/* Namespace ensemble unknown callbacks never do this. */
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"unknown callback should not be called directly", TCL_INDEX_NONE));
	return TCL_ERROR;
    }

    /* Redirect to the [::info] command. */
    objPtr = Tcl_NewStringObj("::info", TCL_INDEX_NONE);
    listObj = Tcl_NewListObj(1, &objPtr);
    Tcl_IncrRefCount(listObj);
    if (Tcl_GetCommandFromObj(interp, objPtr)) {
	usage = 0;
	Tcl_ListObjReplace(NULL, listObj, 1, 0, objc-2, objv+2);
	code = Tcl_EvalObjEx(interp, listObj, 0);
	if (code == TCL_ERROR) {
	    /* Redirection to [::info] failed, but why? */
	    Tcl_Obj *optDict = Tcl_GetReturnOptions(interp, code);
	    Tcl_Obj *key = Tcl_NewStringObj("-errorcode", TCL_INDEX_NONE);
	    Tcl_Obj *val, *elem;

	    Tcl_DictObjGet(NULL, optDict, key, &val);
	    Tcl_DecrRefCount(key);
	    Tcl_ListObjIndex(NULL, val, 0, &elem);
	    if (elem && !strcmp(Tcl_GetString(elem), "TCL")) {
		Tcl_ListObjIndex(NULL, val, 1, &elem);
		if (elem && !strcmp(Tcl_GetString(elem), "LOOKUP")) {
		    Tcl_ListObjIndex(NULL, val, 2, &elem);
		    if (elem && !strcmp(Tcl_GetString(elem), "SUBCOMMAND")) {

			/* [::info didn't have that subcommand] */
			usage = 1;
			Tcl_ResetResult(interp);
		    }
		}
	    }
	}
    }
    Tcl_DecrRefCount(listObj);

    if (usage) {
        /* produce usage message */
        objPtr = Tcl_NewStringObj(
	        "wrong # args: should be one of...\n", TCL_INDEX_NONE);
        ItclGetInfoUsage(interp, objPtr, (ItclObjectInfo *)clientData, NULL);
	Tcl_SetObjResult(interp, objPtr);
    }
    if (code == TCL_ERROR) {
	return TCL_ERROR;
    }

    /* Return a command to replicate the non-error redirect outcome */
    listObj = Tcl_NewStringObj(
	    "::apply {{o m args} {::tailcall ::return -options $o $m}}", TCL_INDEX_NONE);
    Tcl_ListObjAppendElement(NULL, listObj, Tcl_GetReturnOptions(interp,code));
    Tcl_ListObjAppendElement(NULL, listObj, Tcl_GetObjResult(interp));
    Tcl_SetObjResult(interp, listObj);
    return TCL_OK;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoBodyCmd()
 *
 *  Handles the usual "info body" request, returning the body for a
 *  specific proc.  Included here for backward compatibility, since
 *  otherwise Tcl would complain that class procs are not real "procs".
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

int
Itcl_BiInfoBodyCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    Tcl_HashEntry *hPtr;
    ItclClass *contextIclsPtr = NULL;
    ItclObject *contextIoPtr;
    const char *what = "procedure";

    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	int code;
	Tcl_Obj *script;

	/*
	 * We lack the context for any specialized Itcl meaning for
	 * [info body], so fallback to Tcl's.
	 */

    fallback:
	script = Tcl_NewStringObj("::info body", TCL_INDEX_NONE);
	if (objc == 2) {
	    Tcl_ListObjAppendElement(NULL, script, objv[1]);
	}
	Tcl_IncrRefCount(script);
	code = Tcl_EvalObjEx(interp, script, 0);
	Tcl_DecrRefCount(script);
	if (code == TCL_ERROR && what) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't a %s", Tcl_GetString(objv[1]), what));
	}
	return code;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }

    what = "function";
    if (contextIclsPtr->flags &
            (ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS)) {
        what = "method";
    }
    if (objc != 2) {
	Tcl_AppendResult(interp,
	        "wrong # args: should be \"info body ", what, "\"",
	        NULL);
        return TCL_ERROR;
    }

    hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveCmds, (char *)objv[1]);
    if (hPtr) {
        ItclCmdLookup *clookup = (ItclCmdLookup *)Tcl_GetHashValue(hPtr);
	ItclMemberFunc *imPtr = clookup->imPtr;
	ItclMemberCode *mcode = imPtr->codePtr;

        /*
         *  Return a string describing the implementation.
         */
        if (mcode && Itcl_IsMemberCodeImplemented(mcode)) {
            Tcl_SetObjResult(interp, mcode->bodyPtr);
        } else {
            Tcl_SetObjResult(interp, Tcl_NewStringObj("<undefined>", TCL_INDEX_NONE));
        }
	return TCL_OK;
    }

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

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

	if (idmPtr->flags & ITCL_TYPE_METHOD) {
	    what = "typemethod";
	}
	Tcl_AppendToObj(objPtr, what, TCL_INDEX_NONE);
	Tcl_AppendToObj(objPtr, " \"", TCL_INDEX_NONE);
	Tcl_AppendObjToObj(objPtr, objv[1]);
	Tcl_AppendToObj(objPtr, "\"", TCL_INDEX_NONE);
        Tcl_SetObjResult(interp, objPtr);
        return TCL_ERROR;
    }
    goto fallback;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoArgsCmd()
 *
 *  Handles the usual "info args" request, returning the argument list
 *  for a specific proc.  Included here for backward compatibility, since
 *  otherwise Tcl would complain that class procs are not real "procs".
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

int
Itcl_BiInfoArgsCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    Tcl_HashEntry *hPtr = NULL;
    ItclClass *contextIclsPtr = NULL;
    ItclObject *contextIoPtr;
    const char *what = NULL;

    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK
	    && objc > 1) {
	int code;
	Tcl_Obj *script;

	/*
	 * We lack the context for any specialized Itcl meaning for
	 * [info args], so fallback to Tcl's.
	 */

    fallback:
	script = Tcl_NewStringObj("::info args", TCL_INDEX_NONE);
	if (objc == 2) {
	    Tcl_ListObjAppendElement(NULL, script, objv[1]);
	}
	Tcl_IncrRefCount(script);
	code = Tcl_EvalObjEx(interp, script, 0);
	Tcl_DecrRefCount(script);
	if (code == TCL_ERROR && what) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't a %s", Tcl_GetString(objv[1]), what));
	}
	return code;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }
    what = "function";
    if ((contextIclsPtr != NULL) && (contextIclsPtr->flags &
            (ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET))) {
        what = "method";
    }
    if (objc != 2) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "wrong # args: should be \"info args %s\"", what));
        return TCL_ERROR;
    }

    hPtr = Tcl_FindHashEntry(&contextIclsPtr->resolveCmds, (char *)objv[1]);
    if (hPtr) {
	ItclCmdLookup *clookup = (ItclCmdLookup *)Tcl_GetHashValue(hPtr);
	ItclMemberFunc *imPtr = clookup->imPtr;
	ItclMemberCode *mcode = imPtr->codePtr;

        /*
         *  Return a string describing the argument list.
         */
        if ((mcode && mcode->argListPtr != NULL)
		|| ((imPtr->flags & ITCL_ARG_SPEC) != 0)) {
	    Tcl_SetObjResult(interp, mcode->usagePtr);
        } else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("<undefined>", TCL_INDEX_NONE));
        }
	return TCL_OK;
    }

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

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

	if (idmPtr->flags & ITCL_TYPE_METHOD) {
	    what = "typemethod";
	}
	Tcl_AppendToObj(objPtr, what, TCL_INDEX_NONE);
	Tcl_AppendToObj(objPtr, " \"", TCL_INDEX_NONE);
	Tcl_AppendObjToObj(objPtr, objv[1]);
	Tcl_AppendToObj(objPtr, "\"", TCL_INDEX_NONE);
        Tcl_SetObjResult(interp, objPtr);
        return TCL_ERROR;
    }
    goto fallback;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoOptionCmd()
 *
 *  Returns information regarding class options.
 *  Handles the following syntax:
 *
 *    info option ?optionName? ?-protection? ?-name? ?-resource? ?-class?
 *        ?-default? ?-configmethod? ?-cgetmethod? ?-validatemethod? ?-value?
 *
 *  If the ?optionName? is not specified, then a list of all known
 *  data members is returned.  Otherwise, the information for a
 *  specific member is returned.  Returns a status TCL_OK/TCL_ERROR
 *  to indicate success/failure.
 * ------------------------------------------------------------------------
 */

int
Itcl_BiInfoOptionCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    char *optionName = NULL;
    Tcl_Obj *resultPtr = NULL;
    Tcl_Obj *objPtr = NULL;
    Tcl_Obj *optionNamePtr;

    static const char *options[] = {
        "-cgetmethod", "-cgetmethodvar","-class",
	"-configuremethod", "-configuremethodvar",
	"-default",
	"-name", "-protection", "-resource",
	"-validatemethod", "-validatemethodvar",
        "-value", NULL
    };
    enum BOptIdx {
        BOptCgetMethodIdx,
        BOptCgetMethodVarIdx,
	BOptClassIdx,
	BOptConfigureMethodIdx,
	BOptConfigureMethodVarIdx,
	BOptDefaultIdx,
	BOptNameIdx,
	BOptProtectIdx,
	BOptResourceIdx,
	BOptValidateMethodIdx,
	BOptValidateMethodVarIdx,
	BOptValueIdx
    } *ioptlist, ioptlistStorage[12];

    static enum BOptIdx DefInfoOption[12] = {
        BOptProtectIdx,
        BOptNameIdx,
        BOptResourceIdx,
        BOptClassIdx,
        BOptDefaultIdx,
        BOptCgetMethodIdx,
        BOptCgetMethodVarIdx,
        BOptConfigureMethodIdx,
        BOptConfigureMethodVarIdx,
        BOptValidateMethodIdx,
        BOptValidateMethodVarIdx,
        BOptValueIdx
    };

    Tcl_HashSearch place;
    Tcl_HashEntry *hPtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclOption *ioptPtr;
    ItclHierIter hier;
    ItclClass *iclsPtr;
    const char *val;
    int i;
    int result;

    ItclShowArgs(1, "Itcl_BiInfoOptionCmd", objc, objv);
    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info option ... }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }

    /*
     *  Process args:
     *  ?optionName? ?-protection? ?-name? ?-resource? ?-class?
     * ?-default? ?-cgetmethod? ?-cgetmethodvar? ?-configuremethod?
     * ?-configuremethodvar? ?-validatemethod? ?-validatemethodvar? ?-value?
     */
    objv++;  /* skip over command name */
    objc--;

    if (objc > 0) {
        optionName = Tcl_GetString(*objv);
        objc--;
	objv++;
    }

    /*
     *  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", NULL);
	    return TCL_ERROR;
	}
	optionNamePtr = Tcl_NewStringObj(optionName, TCL_INDEX_NONE);
        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), "\"",
                NULL);
            return TCL_ERROR;
        }
        ioptPtr = (ItclOption*)Tcl_GetHashValue(hPtr);

        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            ioptlist = DefInfoOption;
            objc = 9;
        } else {

            /*
             *  Otherwise, scan through all remaining flags and
             *  figure out what to return.
             */
            ioptlist = &ioptlistStorage[0];
            for (i=0 ; i < objc; i++) {
                result = Tcl_GetIndexFromObjStruct(interp, objv[i],
                    options, sizeof(char *), "option", 0, (int*)(&ioptlist[i]));
                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

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

        for (i=0 ; i < objc; i++) {
            switch (ioptlist[i]) {
                case BOptCgetMethodIdx:
                    if (ioptPtr->cgetMethodPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(ioptPtr->cgetMethodPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptCgetMethodVarIdx:
                    if (ioptPtr->cgetMethodVarPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(ioptPtr->cgetMethodVarPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptConfigureMethodIdx:
                    if (ioptPtr->configureMethodPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(ioptPtr->configureMethodPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptConfigureMethodVarIdx:
                    if (ioptPtr->configureMethodVarPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(ioptPtr->configureMethodVarPtr),
				TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptValidateMethodIdx:
                    if (ioptPtr->validateMethodPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(ioptPtr->validateMethodPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptValidateMethodVarIdx:
                    if (ioptPtr->validateMethodVarPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(ioptPtr->validateMethodVarPtr),
				TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptResourceIdx:
                    if (ioptPtr->resourceNamePtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(ioptPtr->resourceNamePtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptClassIdx:
                    if (ioptPtr->classNamePtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(ioptPtr->classNamePtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptDefaultIdx:
		    if (ioptPtr->defaultValuePtr != NULL) {
		        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(ioptPtr->defaultValuePtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("<undefined>", TCL_INDEX_NONE);
		    }
                    break;

                case BOptNameIdx:
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(ioptPtr->fullNamePtr), TCL_INDEX_NONE);
                    break;

                case BOptProtectIdx:
                    val = Itcl_ProtectionStr(ioptPtr->protection);
                    objPtr = Tcl_NewStringObj((const char *)val, TCL_INDEX_NONE);
                    break;

                case BOptValueIdx:
		    if (contextIoPtr == NULL) {
                        Tcl_ResetResult(interp);
                        Tcl_AppendResult(interp,
                                "cannot access object-specific info ",
                                "without an object context",
                                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, TCL_INDEX_NONE);
                    break;
            }

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

        /*
         *  Return the list of available options.
         */
        resultPtr = Tcl_NewListObj(0, 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(NULL, resultPtr, objPtr);
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoComponentCmd()
 *
 *  Returns information regarding class components.
 *  Handles the following syntax:
 *
 *    info component ?componentName? ?-inherit? ?-name? ?-value?
 *
 *  If the ?componentName? is not specified, then a list of all known
 *  data members is returned.  Otherwise, the information for a
 *  specific member is returned.  Returns a status TCL_OK/TCL_ERROR
 *  to indicate success/failure.
 * ------------------------------------------------------------------------
 */

int
Itcl_BiInfoComponentCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    char *componentName = NULL;
    Tcl_Obj *resultPtr = NULL;
    Tcl_Obj *objPtr = NULL;
    Tcl_Obj *componentNamePtr;

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

    static enum BCompIdx DefInfoComponent[3] = {
        BCompNameIdx,
        BCompInheritIdx,
        BCompValueIdx
    };

    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclObjectInfo *infoPtr;

    Tcl_HashSearch place;
    Tcl_HashEntry *hPtr;
    Tcl_Namespace *nsPtr;
    ItclComponent *icPtr;
    ItclHierIter hier;
    ItclClass *iclsPtr;
    const char *val;
    int i;
    int result;

    ItclShowArgs(1, "Itcl_BiInfoComponentCmd", objc, objv);
    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info component ... }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }
    nsPtr = Itcl_GetUplevelNamespace(interp, 1);
    if (nsPtr->parentPtr == NULL) {
        /* :: namespace */
	nsPtr = contextIclsPtr->nsPtr;
    }
    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 = (ItclClass *)Tcl_GetHashValue(hPtr);

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

    if (objc > 0) {
        componentName = Tcl_GetString(*objv);
        objc--;
	objv++;
    }

    /*
     *  Return info for a specific component.
     */
    if (componentName) {
	componentNamePtr = Tcl_NewStringObj(componentName, TCL_INDEX_NONE);
	if (contextIoPtr != NULL) {
	    Itcl_InitHierIter(&hier, contextIoPtr->iclsPtr);
	} else {
	    Itcl_InitHierIter(&hier, contextIclsPtr);
	}
	while ((iclsPtr = Itcl_AdvanceHierIter(&hier)) != NULL) {
	    hPtr = Tcl_FindHashEntry(&iclsPtr->components,
	            (char *)componentNamePtr);
	    if (hPtr != NULL) {
	        break;
	    }
	}
	Tcl_DecrRefCount(componentNamePtr);
	Itcl_DeleteHierIter(&hier);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", componentName, "\" isn't a component in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                NULL);
            return TCL_ERROR;
        }
        icPtr = (ItclComponent *)Tcl_GetHashValue(hPtr);

        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            icomplist = DefInfoComponent;
            objc = 3;
        } else {

            /*
             *  Otherwise, scan through all remaining flags and
             *  figure out what to return.
             */
            icomplist = &icomplistStorage[0];
            for (i=0 ; i < objc; i++) {
                result = Tcl_GetIndexFromObjStruct(interp, objv[i],
                    components, sizeof(char *), "component", 0, (int*)(&icomplist[i]));
                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

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

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

                case BCompInheritIdx:
		    if (icPtr->flags & ITCL_COMPONENT_INHERIT) {
                        val = "1";
		    } else {
                        val = "0";
		    }
                    objPtr = Tcl_NewStringObj((const char *)val, TCL_INDEX_NONE);
                    break;

                case BCompValueIdx:
		    if (contextIoPtr == NULL) {
                        Tcl_ResetResult(interp);
                        Tcl_AppendResult(interp,
                                "cannot access object-specific info ",
                                "without an object context",
                                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, TCL_INDEX_NONE);
                    break;
            }

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

        /*
         *  Return the list of available components.
         */
        resultPtr = Tcl_NewListObj(0, 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), TCL_INDEX_NONE);
                Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoWidgetCmd()
 *
 *  Returns information regarding widget classes.
 *  Handles the following syntax:
 *
 *    info widget ?widgetName?
 *
 *  If the ?widgetName? is not specified, then a list of all known
 *  data members is returned.  Otherwise, the information for a
 *  specific member is returned.  Returns a status TCL_OK/TCL_ERROR
 *  to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoWidgetCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    Tcl_Namespace *contextNs = NULL;
    Tcl_Obj *objPtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    char *name;

    ItclShowArgs(1, "Itcl_BiInfoWidgetCmd", objc, objv);
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"info widget\"",
            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 */
	void *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((Tcl_ObjectContext)clientData);
            contextIoPtr = (ItclObject *)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 ... }", TCL_INDEX_NONE));
            return TCL_ERROR;
        }
    }

    /*
     *  If there is an object context, then return the most-specific
     *  class for the object.  Otherwise, return the class namespace
     *  name.  Use normal class names when possible.
     */
    if (contextIoPtr) {
        contextNs = contextIoPtr->iclsPtr->nsPtr;
    } else {
        assert(contextIclsPtr != NULL);
        assert(contextIclsPtr->nsPtr != NULL);
        if (contextIclsPtr->infoPtr->useOldResolvers) {
            contextNs = contextIclsPtr->nsPtr;
        } else {
            contextNs = contextIclsPtr->nsPtr;
        }
    }

            name = contextNs->fullName;
    if (!(contextIclsPtr->flags & ITCL_WIDGET)) {
	Tcl_AppendResult(interp, "object or class is no widget", NULL);
        return TCL_ERROR;
    }
    objPtr = Tcl_NewStringObj(name, TCL_INDEX_NONE);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoExtendedClassCmd()
 *
 *  Returns information regarding extendedclasses.
 *  Handles the following syntax:
 *
 *    info extendedclass ?className?
 *
 *  If the ?className? is not specified, then a list of all known
 *  data members is returned.  Otherwise, the information for a
 *  specific member is returned.  Returns a status TCL_OK/TCL_ERROR
 *  to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoExtendedClassCmd(
    TCL_UNUSED(void *),    /* 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", NULL
    };
    enum BCompIdx {
	BCompNameIdx, BCompInheritIdx, BCompValueIdx
    } *icomplist, icomplistStorage[3];

    static enum BCompIdx DefInfoComponent[3] = {
        BCompNameIdx,
        BCompInheritIdx,
        BCompValueIdx
    };

    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclObjectInfo *infoPtr;

    Tcl_HashSearch place;
    Tcl_HashEntry *hPtr;
    Tcl_Namespace *nsPtr;
    ItclHierIter hier;
    ItclClass *iclsPtr;
    const char *name;
    int result;

    ItclShowArgs(1, "Itcl_BiInfoExtendedClassCmd", objc, objv);
    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info extendedclass ... }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }
    nsPtr = Itcl_GetUplevelNamespace(interp, 1);
    if (nsPtr->parentPtr == NULL) {
        /* :: namespace */
	nsPtr = contextIclsPtr->nsPtr;
    }
    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);

#else
    (void)interp;
    (void)objc;
    (void)objv;
#endif

    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoDelegatedCmd()
 *
 *  Returns information regarding extendedclasses.
 *  Handles the following syntax:
 *
 *    info extendedclass ?className?
 *
 *  If the ?className? is not specified, then a list of all known
 *  data members is returned.  Otherwise, the information for a
 *  specific member is returned.  Returns a status TCL_OK/TCL_ERROR
 *  to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoDelegatedCmd(
    TCL_UNUSED(void *),    /* 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", NULL
    };
    enum BCompIdx {
	BCompNameIdx, BCompInheritIdx, BCompValueIdx
    } *icomplist, icomplistStorage[3];

    static enum BCompIdx DefInfoComponent[3] = {
        BCompNameIdx,
        BCompInheritIdx,
        BCompValueIdx
    };

    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclObjectInfo *infoPtr;

    Tcl_HashSearch place;
    Tcl_HashEntry *hPtr;
    Tcl_Namespace *nsPtr;
    ItclHierIter hier;
    ItclClass *iclsPtr;
    const char *name;
    int result;

    ItclShowArgs(1, "Itcl_BiInfoDelegatedCmd", objc, objv);
    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    contextIclsPtr = NULL;
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info delegated ... }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }
    nsPtr = Itcl_GetUplevelNamespace(interp, 1);
    if (nsPtr->parentPtr == NULL) {
        /* :: namespace */
	nsPtr = contextIclsPtr->nsPtr;
    }
    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);

#else
    (void)interp;
    (void)objc;
    (void)objv;
#endif

    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoTypeCmd()
 *
 *  Returns information regarding the Type for an object.  This command
 *  can be invoked with or without an object context:
 *
 *    <objName> info type   <= returns most-specific class name
 *    info type             <= returns active namespace name
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoTypeCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    Tcl_Namespace *contextNs = NULL;
    Tcl_Obj *objPtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    char *name;

    ItclShowArgs(1, "Itcl_BiInfoTypeCmd", objc, objv);
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"info type\"",
            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 */
	void *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((Tcl_ObjectContext)clientData);
            contextIoPtr = (ItclObject *)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 ...}", TCL_INDEX_NONE));
            return TCL_ERROR;
        }
    }

    /*
     *  If there is an object context, then return the most-specific
     *  class for the object.  Otherwise, return the class namespace
     *  name.  Use normal class names when possible.
     */
    if (contextIoPtr) {
        contextNs = contextIoPtr->iclsPtr->nsPtr;
    } else {
        assert(contextIclsPtr != NULL);
        assert(contextIclsPtr->nsPtr != NULL);
        if (contextIclsPtr->infoPtr->useOldResolvers) {
            contextNs = contextIclsPtr->nsPtr;
        } else {
            contextNs = contextIclsPtr->nsPtr;
        }
    }

            name = contextNs->fullName;
    if (!(contextIclsPtr->flags & ITCL_TYPE)) {
	Tcl_AppendResult(interp, "object or class is no type", NULL);
        return TCL_ERROR;
    }
    objPtr = Tcl_NewStringObj(name, TCL_INDEX_NONE);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoHullTypeCmd()
 *
 *  Returns information regarding the hulltype for an object.  This command
 *  can be invoked with or without an object context:
 *
 *    <objName> info hulltype   returns the hulltype name
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoHullTypeCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;

    ItclShowArgs(1, "Itcl_BiInfoHullTypeCmd", objc, objv);
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"info hulltype\"",
            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 */
	void *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((Tcl_ObjectContext)clientData);
            contextIoPtr = (ItclObject *)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 ... }", TCL_INDEX_NONE));
            return TCL_ERROR;
        }
    }

    if (!(contextIclsPtr->flags & ITCL_WIDGET)) {
	Tcl_AppendResult(interp, "object or class is no widget.",
	        " Only ::itcl::widget has a hulltype.", NULL);
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, contextIclsPtr->hullTypePtr);
    return TCL_OK;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoDefaultCmd()
 *
 *  Returns information regarding the Type for an object.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoDefaultCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    ItclObject *ioPtr;
    ItclClass *iclsPtr;
    ItclMemberFunc *imPtr;
    ItclDelegatedFunction *idmPtr;
    ItclArgList *argListPtr;
    const char *methodName;
    const char *argName;
    const char *what;
    int found;

    ItclShowArgs(1, "Itcl_BiInfoDefaultCmd", objc, objv);
    iclsPtr = NULL;
    found = 0;
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc != 4) {
	Tcl_AppendResult(interp, "wrong # args, should be info default ",
	        "<method> <argName> <varName>", NULL);
        return TCL_ERROR;
    }
    methodName = Tcl_GetString(objv[1]);
    argName = Tcl_GetString(objv[2]);
    FOREACH_HASH_VALUE(imPtr, &iclsPtr->functions) {
        if (strcmp(methodName, Tcl_GetString(imPtr->namePtr)) == 0) {
	    found = 1;
	    break;
	}
    }
    if (found) {
        argListPtr = imPtr->argListPtr;
	while (argListPtr != NULL) {
	    if (strcmp(argName, Tcl_GetString(argListPtr->namePtr)) == 0) {
	        if (argListPtr->defaultValuePtr != NULL) {
		    if (NULL == Tcl_ObjSetVar2(interp, objv[3], NULL,
			    argListPtr->defaultValuePtr, TCL_LEAVE_ERR_MSG)) {
			return TCL_ERROR;
		    }
		    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
		    return TCL_OK;
	        } else {
	            Tcl_AppendResult(interp, "method \"", methodName,
		            "\" has no default value for argument \"",
			    argName, "\"", NULL);
		    return TCL_ERROR;
	        }
	    }
	    argListPtr = argListPtr->nextPtr;
	}
    }
    if (! found) {
        FOREACH_HASH_VALUE(idmPtr, &iclsPtr->delegatedFunctions) {
	    if (strcmp(methodName, Tcl_GetString(idmPtr->namePtr)) == 0) {
		what = "method";
		if (idmPtr->flags & ITCL_TYPE_METHOD) {
		    what = "typemethod";
		}
                Tcl_AppendResult(interp, "delegated ", what, " \"", methodName,
		        "\"", NULL);
                return TCL_ERROR;
	    }
	}
    }
    if (! found) {
        Tcl_AppendResult(interp, "unknown method \"", methodName, "\"", NULL);
        return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "method \"", methodName, "\" has no argument \"",
            argName, "\"", NULL);
    return TCL_ERROR;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoMethodCmd()
 *
 *  Returns information regarding a method for an object.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoMethodCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    Tcl_Obj *resultPtr;
    Tcl_Obj *objPtr;
    Tcl_HashSearch place;
    Tcl_HashEntry *hPtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclClass *iclsPtr;
    ItclMemberFunc *imPtr;
    ItclMemberCode *mcode;
    ItclHierIter hier;
    const char *val;
    char *cmdName;
    int i;
    int result;

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

    static enum BIfIdx DefInfoFunction[5] = {
        BIfProtectIdx,
        BIfTypeIdx,
        BIfNameIdx,
        BIfArgsIdx,
        BIfBodyIdx
    };

    ItclShowArgs(1, "Itcl_BiInfoMethodCmd", objc, objv);
    cmdName = NULL;
    objPtr = NULL;
    resultPtr = NULL;
    contextIclsPtr = NULL;
    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info method ... }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }

    /*
     *  Process args:
     *  ?cmdName? ?-protection? ?-type? ?-name? ?-args? ?-body?
     */
    objv++;  /* skip over command name */
    objc--;

    if (objc > 0) {
        cmdName = Tcl_GetString(*objv);
        objc--; objv++;
    }

    /*
     *  Return info for a specific command.
     */
    if (cmdName) {
	ItclCmdLookup *clookup;
	objPtr = Tcl_NewStringObj(cmdName, TCL_INDEX_NONE);
        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, "\"",
                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, "\"",
                NULL);
            return TCL_ERROR;
	}

        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            objc = 5;
            iflist = DefInfoFunction;
        } else {

            /*
             *  Otherwise, scan through all remaining flags and
             *  figure out what to return.
             */
            iflist = &iflistStorage[0];
            for (i=0 ; i < objc; i++) {
                result = Tcl_GetIndexFromObjStruct(interp, objv[i],
                    options, sizeof(char *), "option", 0, (int*)(&iflist[i]));
                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

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

        for (i=0 ; i < objc; i++) {
            switch (iflist[i]) {
                case BIfArgsIdx:
                    if (mcode && mcode->argListPtr) {
			if (imPtr->usagePtr == NULL) {
                            objPtr = Tcl_NewStringObj(
			            Tcl_GetString(mcode->usagePtr), TCL_INDEX_NONE);
			} else {
                            objPtr = Tcl_NewStringObj(
			            Tcl_GetString(imPtr->usagePtr), TCL_INDEX_NONE);
		        }
                    } else {
		        if ((imPtr->flags & ITCL_ARG_SPEC) != 0) {
			    if (imPtr->usagePtr == NULL) {
                                objPtr = Tcl_NewStringObj(
				        Tcl_GetString(mcode->usagePtr), TCL_INDEX_NONE);
			    } else {
			        objPtr = Tcl_NewStringObj(
				        Tcl_GetString(imPtr->usagePtr), TCL_INDEX_NONE);
			    }
                        } else {
                            objPtr = Tcl_NewStringObj("<undefined>", TCL_INDEX_NONE);
                        }
		    }
                    break;

                case BIfBodyIdx:
                    if (mcode && Itcl_IsMemberCodeImplemented(mcode)) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(mcode->bodyPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("<undefined>", TCL_INDEX_NONE);
                    }
                    break;

                case BIfNameIdx:
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(imPtr->fullNamePtr), TCL_INDEX_NONE);
                    break;

                case BIfProtectIdx:
                    val = Itcl_ProtectionStr(imPtr->protection);
                    objPtr = Tcl_NewStringObj(val, TCL_INDEX_NONE);
                    break;

                case BIfTypeIdx:
                    val = "method";
                    objPtr = Tcl_NewStringObj(val, TCL_INDEX_NONE);
                    break;
            }

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

        /*
         *  Return the list of available commands.
         */
        resultPtr = Tcl_NewListObj(0, 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), TCL_INDEX_NONE);
                    Tcl_ListObjAppendElement(NULL,
		            resultPtr, objPtr);
                }

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

        Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoMethodsCmd()
 *
 *  Returns information regarding the methods for an object.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoMethodsCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *listPtr;
    ItclObject *ioPtr;
    ItclClass *iclsPtr;
    ItclMemberFunc *imPtr;
    ItclDelegatedFunction *idmPtr;
    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 ", NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);
    }
    listPtr = Tcl_NewListObj(0, NULL);
    name = "destroy";
    if ((pattern == NULL) || Tcl_StringCaseMatch((const char *)name, pattern, 0)) {
        Tcl_ListObjAppendElement(interp, listPtr,
                Tcl_NewStringObj(name, TCL_INDEX_NONE));
    }
    name = "info";
    if ((pattern == NULL) || Tcl_StringCaseMatch((const char *)name, pattern, 0)) {
        Tcl_ListObjAppendElement(interp, listPtr,
                Tcl_NewStringObj(name, TCL_INDEX_NONE));
    }
    FOREACH_HASH_VALUE(imPtr, &iclsPtr->functions) {
	name = Tcl_GetString(imPtr->namePtr);
        if (strcmp(name, "*") == 0) {
	    continue;
	}
        if (strcmp(name, "destroy") == 0) {
	    continue;
	}
        if (strcmp(name, "info") == 0) {
	    continue;
	}
        if ((imPtr->flags & ITCL_METHOD) &&
	        !(imPtr->flags & ITCL_CONSTRUCTOR) &&
	        !(imPtr->flags & ITCL_DESTRUCTOR) &&
		!(imPtr->flags & ITCL_COMMON) &&
	        !(imPtr->codePtr->flags & ITCL_BUILTIN)) {
	    if ((pattern == NULL) ||
                     Tcl_StringCaseMatch((const char *)name, pattern, 0)) {
	        Tcl_ListObjAppendElement(interp, listPtr,
		        Tcl_NewStringObj(Tcl_GetString(imPtr->namePtr), TCL_INDEX_NONE));
	    }
	}
    }
    FOREACH_HASH_VALUE(idmPtr, &iclsPtr->delegatedFunctions) {
	name = Tcl_GetString(idmPtr->namePtr);
        if (strcmp(name, "*") == 0) {
	    continue;
	}
        if (strcmp(name, "destroy") == 0) {
	    continue;
	}
        if (strcmp(name, "info") == 0) {
	    continue;
	}
        if (idmPtr->flags & ITCL_METHOD) {
	    if ((pattern == NULL) ||
                     Tcl_StringCaseMatch((const char *)name, pattern, 0)) {
	        Tcl_ListObjAppendElement(interp, listPtr,
		        Tcl_NewStringObj(Tcl_GetString(idmPtr->namePtr), TCL_INDEX_NONE));
	    }
        }
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoOptionsCmd()
 *
 *  Returns information regarding the Type for an object.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoOptionsCmd(
    TCL_UNUSED(void *),    /* 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 *listPtr;
    Tcl_Obj *listPtr2;
    Tcl_Obj *objPtr;
    Tcl_Obj **lObjv;
    Tcl_HashTable *tablePtr;
    ItclObject *ioPtr;
    ItclClass *iclsPtr;
    ItclOption *ioptPtr;
    ItclDelegatedOption *idoPtr;
    const char *name;
    const char *val;
    const char *pattern;
    Tcl_Size lObjc;
    int result;
    Tcl_Size 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 ", NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc > 2) {
	Tcl_AppendResult(interp, "wrong # args should be: info options ",
	        "?pattern?", NULL);
        return TCL_ERROR;
    }
    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);
    }
    listPtr = Tcl_NewListObj(0, NULL);
    if (ioPtr == NULL) {
        tablePtr = &iclsPtr->options;
    } else {
        tablePtr = &ioPtr->objectOptions;
    }
    FOREACH_HASH_VALUE(ioptPtr, tablePtr) {
	name = Tcl_GetString(ioptPtr->namePtr);
	if ((pattern == NULL) ||
                 Tcl_StringCaseMatch(name, pattern, 0)) {
            Tcl_ListObjAppendElement(interp, listPtr,
	            Tcl_NewStringObj(Tcl_GetString(ioptPtr->namePtr), TCL_INDEX_NONE));
        }
    }
    if (ioPtr == NULL) {
        tablePtr = &iclsPtr->delegatedOptions;
    } else {
        tablePtr = &ioPtr->objectDelegatedOptions;
    }
    FOREACH_HASH_VALUE(idoPtr, tablePtr) {
        name = Tcl_GetString(idoPtr->namePtr);
	if (strcmp(name, "*") != 0) {
	    if ((pattern == NULL) ||
                    Tcl_StringCaseMatch(name, pattern, 0)) {
                Tcl_ListObjAppendElement(interp, listPtr,
	                Tcl_NewStringObj(Tcl_GetString(idoPtr->namePtr), TCL_INDEX_NONE));
	    }
        } else {
	    if (idoPtr->icPtr == NULL) {
		Tcl_AppendResult(interp, "component \"",
		        Tcl_GetString(idoPtr->namePtr),
			"\" is not initialized", NULL);
	        return TCL_ERROR;
	    }
	    val = ItclGetInstanceVar(interp,
	            Tcl_GetString(idoPtr->icPtr->namePtr),
	            NULL, ioPtr, ioPtr->iclsPtr);
            if ((val != NULL) && (strlen(val) != 0)) {
	        objPtr = Tcl_NewStringObj(val, TCL_INDEX_NONE);
		Tcl_AppendToObj(objPtr, " configure", TCL_INDEX_NONE);
		result = Tcl_EvalObjEx(interp, objPtr, 0);
	        if (result != TCL_OK) {
		    return TCL_ERROR;
		}
	        listPtr2 = Tcl_GetObjResult(interp);
		Tcl_ListObjGetElements(interp, listPtr2, &lObjc, &lObjv);
		for (i = 0; i < lObjc; i++) {
		    Tcl_ListObjIndex(interp, lObjv[i], 0, &objPtr);
		    hPtr2 = Tcl_FindHashEntry(&idoPtr->exceptions,
		            (char *)objPtr);
		    if (hPtr2 == NULL) {
			name = Tcl_GetString(objPtr);
	                if ((pattern == NULL) ||
                                 Tcl_StringCaseMatch(name, pattern, 0)) {
		            Tcl_ListObjAppendElement(interp, listPtr, objPtr);
		        }
		    }
		}
	    }
	}
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoTypesCmd()
 *
 *  Returns information regarding the Type for an object.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoTypesCmd(
    void *clientData,      /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *listPtr;
    ItclObjectInfo *infoPtr;
    ItclClass *iclsPtr;
    const char *name;
    const char *pattern;

    ItclShowArgs(1, "Itcl_BiInfoTypesCmd", objc, objv);
    infoPtr = (ItclObjectInfo *)clientData;
    iclsPtr = NULL;
    pattern = NULL;
    if (objc > 2) {
	Tcl_AppendResult(interp, "wrong # args should be: info types ",
	        "?pattern?", NULL);
        return TCL_ERROR;
    }
    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);
    }
    listPtr = Tcl_NewListObj(0, NULL);
    FOREACH_HASH_VALUE(iclsPtr, &infoPtr->nameClasses) {
	if (iclsPtr->flags & ITCL_TYPE) {
	    name = Tcl_GetString(iclsPtr->namePtr);
	    if ((pattern == NULL) ||
                     Tcl_StringCaseMatch(name, pattern, 0)) {
                Tcl_ListObjAppendElement(interp, listPtr,
		        Tcl_NewStringObj(Tcl_GetString(iclsPtr->namePtr), TCL_INDEX_NONE));
            }
        }
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoComponentsCmd()
 *
 *  Returns information regarding the Components for an object.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoComponentsCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *listPtr;
    ItclObject *ioPtr;
    ItclClass *iclsPtr;
    ItclComponent *icPtr;
    ItclHierIter hier;
    ItclClass *iclsPtr2;
    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 ", NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (iclsPtr == NULL) {
        Tcl_AppendResult(interp, "INTERNAL ERROR in Itcl_BiInfoComponentsCmd",
	        " iclsPtr == NULL", NULL);
        return TCL_ERROR;
    }
    if (objc > 2) {
	Tcl_AppendResult(interp, "wrong # args should be: info components ",
	        "?pattern?", NULL);
        return TCL_ERROR;
    }
    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);
    }
    listPtr = Tcl_NewListObj(0, NULL);
    Itcl_InitHierIter(&hier, iclsPtr);
    iclsPtr2 = Itcl_AdvanceHierIter(&hier);
    while (iclsPtr2 != NULL) {
        FOREACH_HASH_VALUE(icPtr, &iclsPtr2->components) {
            name = Tcl_GetString(icPtr->namePtr);
            if ((pattern == NULL) ||
                     Tcl_StringCaseMatch(name, pattern, 0)) {
                Tcl_ListObjAppendElement(interp, listPtr,
	                Tcl_NewStringObj(Tcl_GetString(icPtr->namePtr), TCL_INDEX_NONE));
            }
        }
        iclsPtr2 = Itcl_AdvanceHierIter(&hier);
    }
    Itcl_DeleteHierIter(&hier);
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoTypeMethodCmd()
 *
 *  Returns information regarding a typemethod for an object.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoTypeMethodCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    Tcl_Obj *resultPtr;
    Tcl_Obj *objPtr;
    Tcl_HashSearch place;
    Tcl_HashEntry *hPtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclClass *iclsPtr;
    ItclMemberFunc *imPtr;
    ItclMemberCode *mcode;
    ItclHierIter hier;
    const char *val;
    char *cmdName;
    int i;
    int result;

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

    static enum BIfIdx DefInfoFunction[5] = {
        BIfProtectIdx,
        BIfTypeIdx,
        BIfNameIdx,
        BIfArgsIdx,
        BIfBodyIdx
    };


    ItclShowArgs(1, "Itcl_BiInfoTypeMethodCmd", objc, objv);
    resultPtr = NULL;
    objPtr = NULL;
    cmdName = NULL;
    contextIclsPtr = NULL;
    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info function ... }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }

    /*
     *  Process args:
     *  ?cmdName? ?-protection? ?-type? ?-name? ?-args? ?-body?
     */
    objv++;  /* skip over command name */
    objc--;

    if (objc > 0) {
        cmdName = Tcl_GetString(*objv);
        objc--; objv++;
    }

    /*
     *  Return info for a specific command.
     */
    if (cmdName) {
	ItclCmdLookup *clookup;
	objPtr = Tcl_NewStringObj(cmdName, TCL_INDEX_NONE);
        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, "\"",
                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, "\"",
                NULL);
            return TCL_ERROR;
	}

        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            objc = 5;
            iflist = DefInfoFunction;
        } else {

            /*
             *  Otherwise, scan through all remaining flags and
             *  figure out what to return.
             */
            iflist = &iflistStorage[0];
            for (i=0 ; i < objc; i++) {
                result = Tcl_GetIndexFromObjStruct(interp, objv[i],
                    options, sizeof(char *), "option", 0, (int*)(&iflist[i]));
                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

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

        for (i=0 ; i < objc; i++) {
            switch (iflist[i]) {
                case BIfArgsIdx:
                    if (mcode && mcode->argListPtr) {
			if (imPtr->usagePtr == NULL) {
                            objPtr = Tcl_NewStringObj(
			            Tcl_GetString(mcode->usagePtr), TCL_INDEX_NONE);
			} else {
                            objPtr = Tcl_NewStringObj(
			            Tcl_GetString(imPtr->usagePtr), TCL_INDEX_NONE);
		        }
                    } else {
		        if ((imPtr->flags & ITCL_ARG_SPEC) != 0) {
			    if (imPtr->usagePtr == NULL) {
                                objPtr = Tcl_NewStringObj(
				        Tcl_GetString(mcode->usagePtr), TCL_INDEX_NONE);
			    } else {
			        objPtr = Tcl_NewStringObj(
				        Tcl_GetString(imPtr->usagePtr), TCL_INDEX_NONE);
			    }
                        } else {
                            objPtr = Tcl_NewStringObj("<undefined>", TCL_INDEX_NONE);
                        }
		    }
                    break;

                case BIfBodyIdx:
                    if (mcode && Itcl_IsMemberCodeImplemented(mcode)) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(mcode->bodyPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("<undefined>", TCL_INDEX_NONE);
                    }
                    break;

                case BIfNameIdx:
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(imPtr->fullNamePtr), TCL_INDEX_NONE);
                    break;

                case BIfProtectIdx:
                    val = Itcl_ProtectionStr(imPtr->protection);
                    objPtr = Tcl_NewStringObj(val, TCL_INDEX_NONE);
                    break;

                case BIfTypeIdx:
                    val = "typemethod";
                    objPtr = Tcl_NewStringObj(val, TCL_INDEX_NONE);
                    break;
            }

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

        /*
         *  Return the list of available commands.
         */
        resultPtr = Tcl_NewListObj(0, 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), TCL_INDEX_NONE);
                    Tcl_ListObjAppendElement(NULL,
		            resultPtr, objPtr);
                }

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

        Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoMethodsCmd()
 *
 *  Returns information regarding the methods for an object.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoTypeMethodsCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *listPtr;
    ItclObject *ioPtr;
    ItclClass *iclsPtr;
    ItclMemberFunc *imPtr;
    ItclDelegatedFunction *idmPtr;
    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 ", NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc > 1) {
        pattern = Tcl_GetString(objv[1]);
    }
    listPtr = Tcl_NewListObj(0, NULL);
    name = "create";
    if ((pattern == NULL) || Tcl_StringCaseMatch((const char *)name, pattern, 0)) {
        Tcl_ListObjAppendElement(interp, listPtr,
	        Tcl_NewStringObj(name, TCL_INDEX_NONE));
    }
    name = "destroy";
    if ((pattern == NULL) || Tcl_StringCaseMatch((const char *)name, pattern, 0)) {
        Tcl_ListObjAppendElement(interp, listPtr,
                Tcl_NewStringObj(name, TCL_INDEX_NONE));
    }
    name = "info";
    if ((pattern == NULL) || Tcl_StringCaseMatch((const char *)name, pattern, 0)) {
        Tcl_ListObjAppendElement(interp, listPtr,
                Tcl_NewStringObj(name, TCL_INDEX_NONE));
    }
    FOREACH_HASH_VALUE(imPtr, &iclsPtr->functions) {
	name = Tcl_GetString(imPtr->namePtr);
        if (strcmp(name, "*") == 0) {
	    continue;
	}
        if (strcmp(name, "create") == 0) {
	    continue;
	}
        if (strcmp(name, "destroy") == 0) {
	    continue;
	}
        if (strcmp(name, "info") == 0) {
	    continue;
	}
        if (imPtr->flags & ITCL_TYPE_METHOD) {
	    if ((pattern == NULL) ||
                     Tcl_StringCaseMatch((const char *)name, pattern, 0)) {
	        Tcl_ListObjAppendElement(interp, listPtr,
		        Tcl_NewStringObj(Tcl_GetString(imPtr->namePtr), TCL_INDEX_NONE));
	    }
	}
    }
    FOREACH_HASH_VALUE(idmPtr, &iclsPtr->delegatedFunctions) {
	name = Tcl_GetString(idmPtr->namePtr);
        if (strcmp(name, "*") == 0) {
	    continue;
	}
        if (strcmp(name, "create") == 0) {
	    continue;
	}
        if (strcmp(name, "destroy") == 0) {
	    continue;
	}
        if (strcmp(name, "info") == 0) {
	    continue;
	}
        if (idmPtr->flags & ITCL_TYPE_METHOD) {
	    if ((pattern == NULL) ||
                     Tcl_StringCaseMatch((const char *)name, pattern, 0)) {
	        Tcl_ListObjAppendElement(interp, listPtr,
		        Tcl_NewStringObj(Tcl_GetString(idmPtr->namePtr), TCL_INDEX_NONE));
	    }
        }
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoTypeVarsCmd()
 *
 *  Returns information regarding variables for an object.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoTypeVarsCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *listPtr;
    ItclObject *ioPtr;
    ItclClass *iclsPtr;
    ItclVariable *ivPtr;
    const char *pattern;

    ItclShowArgs(1, "Itcl_BiInfoTypeVarsCmd", objc, objv);
    if (objc > 2) {
	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 ", NULL);
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);
    }
    listPtr = Tcl_NewListObj(0, NULL);
    FOREACH_HASH_VALUE(ivPtr, &iclsPtr->variables) {
        if ((pattern == NULL) ||
            Tcl_StringCaseMatch(Tcl_GetString(ivPtr->namePtr), pattern, 0)) {
	    if (ivPtr->flags & ITCL_TYPE_VARIABLE) {
                Tcl_ListObjAppendElement(interp, listPtr, ivPtr->fullNamePtr);
	    }
        }
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoTypeVariableCmd()
 *
 *  Returns information regarding a typevariable for an object.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoTypeVariableCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    Tcl_Obj *resultPtr;
    Tcl_Obj *objPtr;
    Tcl_HashSearch place;
    Tcl_HashEntry *hPtr;
    ItclClass *iclsPtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclVariable *ivPtr;
    ItclVarLookup *vlookup;
    ItclHierIter hier;
    char *varName;
    const char *val;
    int i;
    int result;

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

    static enum BIvIdx DefInfoVariable[5] = {
        BIvProtectIdx,
        BIvTypeIdx,
        BIvNameIdx,
        BIvInitIdx,
        BIvValueIdx
    };

    ItclShowArgs(1, "Itcl_BiInfoTypeVariableCmd", objc, objv);
    resultPtr = NULL;
    objPtr = NULL;
    varName = NULL;
    contextIclsPtr = NULL;
    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info typevariable ... }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }

    /*
     *  Process args:
     *  ?varName? ?-protection? ?-type? ?-name? ?-init? ?-config? ?-value?
     */
    objv++;  /* skip over command name */
    objc--;

    if (objc > 0) {
        varName = Tcl_GetString(*objv);
        objc--; objv++;
    }

    /*
     *  Return info for a specific variable.
     */
    if (varName) {
        hPtr = ItclResolveVarEntry(contextIclsPtr, varName);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "\"", varName, "\" isn't a typevariable in class \"",
                contextIclsPtr->nsPtr->fullName, "\"",
                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, "\"",
                NULL);
            return TCL_ERROR;
	}
        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            ivlist = DefInfoVariable;
            objc = 5;
        } else {

            /*
             *  Otherwise, scan through all remaining flags and
             *  figure out what to return.
             */
            ivlist = &ivlistStorage[0];
            for (i=0 ; i < objc; i++) {
                result = Tcl_GetIndexFromObjStruct(interp, objv[i],
                    options, sizeof(char *), "option", 0, (int*)(&ivlist[i]));
                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

        if (objc > 1) {
            resultPtr = Tcl_NewListObj(0, 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(NULL, 0);
                            Tcl_GetCommandFullName(
                                contextIoPtr->iclsPtr->interp,
                                contextIoPtr->accessCmd, objPtr);
                        } else {
                            objPtr = Tcl_NewStringObj("<objectName>", TCL_INDEX_NONE);
                        }
                    } else {
		        if (vlookup->ivPtr->init) {
			    objPtr = Tcl_NewStringObj(
			            Tcl_GetString(vlookup->ivPtr->init), TCL_INDEX_NONE);
                        } else {
                            objPtr = Tcl_NewStringObj("<undefined>", TCL_INDEX_NONE);
		        }
                    }
                    break;

                case BIvNameIdx:
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(ivPtr->fullNamePtr), TCL_INDEX_NONE);
                    break;

                case BIvProtectIdx:
                    val = Itcl_ProtectionStr(ivPtr->protection);
                    objPtr = Tcl_NewStringObj((const char *)val, TCL_INDEX_NONE);
                    break;

                case BIvTypeIdx:
                    val = ((ivPtr->flags & ITCL_COMMON) != 0)
                        ? "common" : "variable";
                    objPtr = Tcl_NewStringObj((const char *)val, TCL_INDEX_NONE);
                    break;

                case BIvValueIdx:
                    if ((ivPtr->flags & ITCL_COMMON) != 0) {
                        val = Itcl_GetCommonVar(interp,
			        Tcl_GetString(ivPtr->fullNamePtr),
                                ivPtr->iclsPtr);
                    } else {
		        if (contextIoPtr == NULL) {
                            if (objc > 1) {
			        Tcl_DecrRefCount(resultPtr);
			    }
                            Tcl_ResetResult(interp);
                            Tcl_AppendResult(interp,
                                    "cannot access object-specific info ",
                                    "without an object context",
                                    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, TCL_INDEX_NONE);
                    break;
            }

            if (objc == 1) {
                resultPtr = objPtr;
            } else {
                Tcl_ListObjAppendElement(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, 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), TCL_INDEX_NONE);
                            Tcl_ListObjAppendElement(NULL,
                                resultPtr, objPtr);
                        }
                    } else {
                        objPtr = Tcl_NewStringObj(
		                Tcl_GetString(ivPtr->fullNamePtr), TCL_INDEX_NONE);
                        Tcl_ListObjAppendElement(NULL,
                            resultPtr, objPtr);
                    }
		}
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoVariablesCmd()
 *
 *  Returns information regarding typevariables for an object.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoVariablesCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    ItclShowArgs(1, "Itcl_BiInfoVariablesCmd", objc, objv);
    Tcl_AppendResult(interp, "Itcl_BiInfoVariablesCmd not yet implemented\n",
            NULL);
    return TCL_ERROR;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoWidgetadaptorCmd()
 *
 *  Returns information regarding a widgetadaptor.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoWidgetadaptorCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    Tcl_Namespace *contextNs = NULL;
    Tcl_Obj *objPtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    char *name;

    ItclShowArgs(1, "Itcl_BiInfoWidgetadaptorCmd", objc, objv);
    if (objc != 1) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be \"info widgetadaptor\"",
            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 */
	void *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((Tcl_ObjectContext)clientData);
	    contextIoPtr = (ItclObject *)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 ... }", TCL_INDEX_NONE));
	    return TCL_ERROR;
	}
    }

    /*
     *  If there is an object context, then return the most-specific
     *  class for the object.  Otherwise, return the class namespace
     *  name.  Use normal class names when possible.
     */
    if (contextIoPtr) {
        contextNs = contextIoPtr->iclsPtr->nsPtr;
    } else {
        assert(contextIclsPtr != NULL);
        assert(contextIclsPtr->nsPtr != NULL);
        if (contextIclsPtr->infoPtr->useOldResolvers) {
            contextNs = contextIclsPtr->nsPtr;
        } else {
            contextNs = contextIclsPtr->nsPtr;
        }
    }

            name = contextNs->fullName;
    if (!(contextIclsPtr->flags & ITCL_WIDGETADAPTOR)) {
	Tcl_AppendResult(interp, "object or class is no widgetadaptor", NULL);
        return TCL_ERROR;
    }
    objPtr = Tcl_NewStringObj(name, TCL_INDEX_NONE);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoInstancesCmd()
 *
 *  Returns information regarding instances.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoInstancesCmd(
    void *clientData,      /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *listPtr;
    Tcl_Obj *objPtr;
    ItclObjectInfo *infoPtr;
    ItclObject *ioPtr;
    ItclClass *iclsPtr;
    const char *pattern;

    ItclShowArgs(1, "Itcl_BiInfoInstancesCmd", objc, objv);
    if (objc > 2) {
	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 ", NULL);
	return TCL_ERROR;
    }
    if (ioPtr != NULL) {
	iclsPtr = ioPtr->iclsPtr;
    }
    if (objc == 2) {
	pattern = Tcl_GetString(objv[1]);
    }
    infoPtr = (ItclObjectInfo *)clientData;
    listPtr = Tcl_NewListObj(0, NULL);
    FOREACH_HASH_VALUE(ioPtr, &infoPtr->objects) {
	/* FIXME need to scan the inheritance too */
	if (ioPtr->iclsPtr == iclsPtr) {
	    if (ioPtr->iclsPtr->flags & ITCL_WIDGETADAPTOR) {
		objPtr = Tcl_NewStringObj(Tcl_GetCommandName(interp,
		ioPtr->accessCmd), TCL_INDEX_NONE);
	    } else {
		objPtr = Tcl_NewObj();
		Tcl_GetCommandFullName(interp, ioPtr->accessCmd, objPtr);
	    }
	    if ((pattern == NULL) ||
		Tcl_StringCaseMatch(Tcl_GetString(objPtr), pattern, 0)) {
		Tcl_ListObjAppendElement(interp, listPtr, objPtr);
	    } else {
		Tcl_DecrRefCount(objPtr);
	    }
	}
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoDelegatedOptionsCmd()
 *
 *  Returns information regarding delegated options.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoDelegatedOptionsCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *listPtr;
    Tcl_Obj *objPtr;
    Tcl_Obj *objPtr2;
    ItclObject *ioPtr;
    ItclClass *iclsPtr;
    ItclDelegatedOption *idoPtr;
    const char *name;
    const char *pattern;

    ItclShowArgs(1, "Itcl_BiInfoDelegatedOptionsCmd", objc, objv);
    pattern = NULL;
    if (objc > 2) {
	Tcl_AppendResult(interp, "wrong # args should be: info delegated ",
	        "options ?pattern?", NULL);
        return TCL_ERROR;
    }

    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);
    }
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    listPtr = Tcl_NewListObj(0, NULL);
    FOREACH_HASH_VALUE(idoPtr, &iclsPtr->delegatedOptions) {
	if (iclsPtr->flags &
	        (ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS)) {
	    name = Tcl_GetString(idoPtr->namePtr);
	    if ((pattern == NULL) ||
                     Tcl_StringCaseMatch(name, pattern, 0)) {
		objPtr = Tcl_NewListObj(0, NULL);
                Tcl_ListObjAppendElement(interp, objPtr,
	                idoPtr->namePtr);
		if (idoPtr->icPtr != NULL) {
                    Tcl_ListObjAppendElement(interp, objPtr,
	                    idoPtr->icPtr->namePtr);
		} else {
		    objPtr2 = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    Tcl_ListObjAppendElement(interp, objPtr, objPtr2);
		}
                Tcl_ListObjAppendElement(interp, listPtr, objPtr);
	    }
        }
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoDelegatedMethodsCmd()
 *
 *  Returns information regarding delegated methods.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoDelegatedMethodsCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *listPtr;
    Tcl_Obj *objPtr;
    Tcl_Obj *objPtr2;
    ItclObject *ioPtr;
    ItclClass *iclsPtr;
    ItclDelegatedFunction *idmPtr;
    const char *name;
    const char *pattern;

    ItclShowArgs(1, "Itcl_BiInfoDelegatedMethodsCmd", objc, objv);
    pattern = NULL;
    if (objc > 2) {
	Tcl_AppendResult(interp, "wrong # args should be: info delegated ",
	        "methods ?pattern?", NULL);
        return TCL_ERROR;
    }

    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);
    }
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    listPtr = Tcl_NewListObj(0, NULL);
    FOREACH_HASH_VALUE(idmPtr, &iclsPtr->delegatedFunctions) {
	if (iclsPtr->flags &
	        (ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS)) {
	    name = Tcl_GetString(idmPtr->namePtr);
	    if ((pattern == NULL) ||
                     Tcl_StringCaseMatch(name, pattern, 0)) {
		if ((idmPtr->flags & ITCL_TYPE_METHOD) == 0) {
		    objPtr = Tcl_NewListObj(0, NULL);
                    Tcl_ListObjAppendElement(interp, objPtr,
	                    idmPtr->namePtr);
		    if (idmPtr->icPtr != NULL) {
                        Tcl_ListObjAppendElement(interp, objPtr,
	                        idmPtr->icPtr->namePtr);
		    } else {
		        objPtr2 = Tcl_NewStringObj("", TCL_INDEX_NONE);
                        Tcl_ListObjAppendElement(interp, objPtr, objPtr2);
		    }
                    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
	       }
	    }
        }
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoTypeMethodsCmd()
 *
 *  Returns information regarding delegated type methods.  This command
 *  can be invoked with or without an object context:
 *
 *
 *  Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoDelegatedTypeMethodsCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *listPtr;
    Tcl_Obj *objPtr;
    Tcl_Obj *objPtr2;
    ItclObject *ioPtr;
    ItclClass *iclsPtr;
    ItclDelegatedFunction *idmPtr;
    const char *name;
    const char *pattern;

    ItclShowArgs(1, "Itcl_BiInfoDelegatedTypeMethodsCmd", objc, objv);
    pattern = NULL;
    if (objc > 2) {
	Tcl_AppendResult(interp, "wrong # args should be: info delegated ",
	        "typemethods ?pattern?", NULL);
        return TCL_ERROR;
    }

    if (objc == 2) {
        pattern = Tcl_GetString(objv[1]);
    }
    if (Itcl_GetContext(interp, &iclsPtr, &ioPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (ioPtr != NULL) {
        iclsPtr = ioPtr->iclsPtr;
    }
    listPtr = Tcl_NewListObj(0, NULL);
    FOREACH_HASH_VALUE(idmPtr, &iclsPtr->delegatedFunctions) {
	if (iclsPtr->flags &
	        (ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS)) {
	    name = Tcl_GetString(idmPtr->namePtr);
	    if ((pattern == NULL) ||
                     Tcl_StringCaseMatch(name, pattern, 0)) {
		if (idmPtr->flags & ITCL_TYPE_METHOD) {
		    objPtr = Tcl_NewListObj(0, NULL);
                    Tcl_ListObjAppendElement(interp, objPtr,
	                    idmPtr->namePtr);
		    if (idmPtr->icPtr != NULL) {
                        Tcl_ListObjAppendElement(interp, objPtr,
	                        idmPtr->icPtr->namePtr);
		    } else {
		            objPtr2 = Tcl_NewStringObj("", TCL_INDEX_NONE);
                        Tcl_ListObjAppendElement(interp, objPtr, objPtr2);
		    }
                    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
	        }
	    }
        }
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoDelegatedUnknownCmd()
 *
 *  the unknown handler for the ::itcl::builtin::Info::delagted ensemble
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoDelegatedUnknownCmd(
    void *clientData,        /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Obj *objPtr;

    ItclShowArgs(1, "Itcl_BiInfoDelegatedUnknownCmd", objc, objv);
    /* produce usage message */
    objPtr = Tcl_NewStringObj(
            "wrong # args: should be one of...\n", TCL_INDEX_NONE);
    ItclGetInfoDelegatedUsage(interp, objPtr, (ItclObjectInfo *)clientData);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_ERROR;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoDelegatedOptionCmd()
 *
 *  Returns information regarding class options.
 *  Handles the following syntax:
 *
 *    info delegated option ?optionName? ?-name? ?-resource? ?-class?
 *        ?-component? ?-as? ?-exceptions?
 *
 *  If the ?optionName? is not specified, then a list of all known
 *  data members is returned.  Otherwise, the information for a
 *  specific member is returned.  Returns a status TCL_OK/TCL_ERROR
 *  to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoDelegatedOptionCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_HashSearch place;
    Tcl_Namespace *nsPtr;
    Tcl_Obj *resultPtr;
    Tcl_Obj *objPtr;
    Tcl_Obj *optionNamePtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclObjectInfo *infoPtr;
    ItclDelegatedOption *idoptPtr;
    ItclHierIter hier;
    ItclClass *iclsPtr;
    char *optionName;
    int i;
    int result;

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

    static enum BOptIdx DefInfoOption[6] = {
        BOptNameIdx,
        BOptResourceIdx,
        BOptClassIdx,
        BOptComponentIdx,
        BOptAsIdx,
        BOptExceptionsIdx
    };

    ItclShowArgs(1, "Itcl_BiInfoDelegatedOptionCmd", objc, objv);
    optionName = NULL;
    objPtr = NULL;
    resultPtr = NULL;
    contextIclsPtr = NULL;
    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info delegated option ... }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }
    nsPtr = Itcl_GetUplevelNamespace(interp, 1);
    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 = (ItclClass *)Tcl_GetHashValue(hPtr);

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

    if (objc > 0) {
        optionName = Tcl_GetString(*objv);
        objc--;
	objv++;
    }

    /*
     *  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", NULL);
	    return TCL_ERROR;
	}
	optionNamePtr = Tcl_NewStringObj(optionName, TCL_INDEX_NONE);
        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), "\"",
                NULL);
            return TCL_ERROR;
        }
        idoptPtr = (ItclDelegatedOption*)Tcl_GetHashValue(hPtr);

        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            ioptlist = DefInfoOption;
            objc = 6;
        } else {

            /*
             *  Otherwise, scan through all remaining flags and
             *  figure out what to return.
             */
            ioptlist = &ioptlistStorage[0];
            for (i=0 ; i < objc; i++) {
                result = Tcl_GetIndexFromObjStruct(interp, objv[i],
                    options, sizeof(char *), "option", 0, (int*)(&ioptlist[i]));
                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

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

        for (i=0 ; i < objc; i++) {
            switch (ioptlist[i]) {
                case BOptAsIdx:
                    if (idoptPtr->asPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(idoptPtr->asPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptExceptionsIdx:
		    {
		    Tcl_Obj *entryObj;
		    objPtr = Tcl_NewListObj(0, NULL);
		    FOREACH_HASH_VALUE(entryObj, &idoptPtr->exceptions) {
			Tcl_ListObjAppendElement(interp, objPtr, entryObj);
		    }
                    }
                    break;
                case BOptResourceIdx:
                    if (idoptPtr->resourceNamePtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(idoptPtr->resourceNamePtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptClassIdx:
                    if (idoptPtr->classNamePtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(idoptPtr->classNamePtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptComponentIdx:
                    if (idoptPtr->icPtr != NULL) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(idoptPtr->icPtr->namePtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptNameIdx:
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(idoptPtr->namePtr), TCL_INDEX_NONE);
                    break;

            }

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

        /*
         *  Return the list of available options.
         */
        resultPtr = Tcl_NewListObj(0, 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(NULL, resultPtr, objPtr);
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoDelegatedMethodCmd()
 *
 *  Returns information regarding class options.
 *  Handles the following syntax:
 *
 *    info delegated method ?methodName? ?-name?
 *        ?-component? ?-as? ?-using? ?-exceptions?
 *
 *  If the ?optionName? is not specified, then a list of all known
 *  data members is returned.  Otherwise, the information for a
 *  specific member is returned.  Returns a status TCL_OK/TCL_ERROR
 *  to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoDelegatedMethodCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_HashSearch place;
    Tcl_Obj *resultPtr;
    Tcl_Obj *objPtr;
    Tcl_Obj *cmdNamePtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclDelegatedFunction *idmPtr;
    ItclHierIter hier;
    ItclClass *iclsPtr;
    char *cmdName;
    int i;
    int result;

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

    static enum BOptIdx DefInfoOption[5] = {
        BOptNameIdx,
        BOptComponentIdx,
        BOptAsIdx,
        BOptUsingIdx,
        BOptExceptionsIdx
    };

    ItclShowArgs(1, "Itcl_BiInfoDelegatedMethodCmd", objc, objv);
    cmdName = NULL;
    objPtr = NULL;
    resultPtr = NULL;
    contextIclsPtr = NULL;
    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info delegated method ... }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }

    /*
     *  Process args:
     *  ?methodName? ?-name? ?-using?
     * ?-as? ?-component? ?-exceptions?
     */
    objv++;  /* skip over command name */
    objc--;

    if (objc > 0) {
        cmdName = Tcl_GetString(*objv);
        objc--;
	objv++;
    }

    /*
     *  Return info for a specific option.
     */
    if (cmdName) {
	cmdNamePtr = Tcl_NewStringObj(cmdName, TCL_INDEX_NONE);
	if (contextIoPtr != NULL) {
            hPtr = Tcl_FindHashEntry(&contextIoPtr->objectDelegatedFunctions,
	            (char *)cmdNamePtr);
	} else {
            hPtr = Tcl_FindHashEntry(&contextIclsPtr->delegatedFunctions,
	            (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), "\"",
                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), "\"",
                NULL);
            return TCL_ERROR;
	}
        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            ioptlist = DefInfoOption;
            objc = 5;
        } else {

            /*
             *  Otherwise, scan through all remaining flags and
             *  figure out what to return.
             */
            ioptlist = &ioptlistStorage[0];
            for (i=0 ; i < objc; i++) {
                result = Tcl_GetIndexFromObjStruct(interp, objv[i],
                    options, sizeof(char *), "option", 0, (int*)(&ioptlist[i]));
                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

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

        for (i=0 ; i < objc; i++) {
            switch (ioptlist[i]) {
                case BOptAsIdx:
                    if (idmPtr->asPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(idmPtr->asPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptExceptionsIdx:
		    {
		    Tcl_Obj *entryObj;
		    objPtr = Tcl_NewListObj(0, NULL);
		    FOREACH_HASH_VALUE(entryObj, &idmPtr->exceptions) {
			Tcl_ListObjAppendElement(interp, objPtr, entryObj);
		    }
                    }
                    break;
                case BOptUsingIdx:
                    if (idmPtr->usingPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(idmPtr->usingPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptComponentIdx:
                    if (idmPtr->icPtr != NULL) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(idmPtr->icPtr->namePtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptNameIdx:
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(idmPtr->namePtr), TCL_INDEX_NONE);
                    break;

            }

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

        /*
         *  Return the list of available options.
         */
        resultPtr = Tcl_NewListObj(0, 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(NULL, resultPtr,
		            objPtr);
		}
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInfoDelegatedTypeMethodCmd()
 *
 *  Returns information regarding class options.
 *  Handles the following syntax:
 *
 *    info delegated typemethod ?methodName? ?-name?
 *        ?-component? ?-as? ?-exceptions?
 *
 *  If the ?optionName? is not specified, then a list of all known
 *  data members is returned.  Otherwise, the information for a
 *  specific member is returned.  Returns a status TCL_OK/TCL_ERROR
 *  to indicate success/failure.
 * ------------------------------------------------------------------------
 */

static int
Itcl_BiInfoDelegatedTypeMethodCmd(
    TCL_UNUSED(void *),    /* ItclObjectInfo Ptr */
    Tcl_Interp *interp,    /* current interpreter */
    int objc,              /* number of arguments */
    Tcl_Obj *const objv[]) /* argument objects */
{

    FOREACH_HASH_DECLS;
    Tcl_HashSearch place;
    Tcl_Obj *resultPtr;
    Tcl_Obj *objPtr;
    Tcl_Obj *cmdNamePtr;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclDelegatedFunction *idmPtr;
    ItclHierIter hier;
    ItclClass *iclsPtr;
    char *cmdName;
    int i;
    int result;

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

    static enum BOptIdx DefInfoOption[5] = {
        BOptNameIdx,
        BOptComponentIdx,
        BOptAsIdx,
        BOptUsingIdx,
        BOptExceptionsIdx
    };

    ItclShowArgs(1, "Itcl_BiInfoDelegatedTypeMethodCmd", objc, objv);
    cmdName = NULL;
    objPtr = NULL;
    resultPtr = NULL;
    contextIclsPtr = NULL;
    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "\nget info like this instead: "
            "\n  namespace eval className { info delegated type method ... }", TCL_INDEX_NONE));
        return TCL_ERROR;
    }
    if (contextIoPtr != NULL) {
        contextIclsPtr = contextIoPtr->iclsPtr;
    }

    /*
     *  Process args:
     *  ?methodName? ?-name? ?-using?
     * ?-as? ?-component? ?-exceptions?
     */
    objv++;  /* skip over command name */
    objc--;

    if (objc > 0) {
        cmdName = Tcl_GetString(*objv);
        objc--;
	objv++;
    }

    /*
     *  Return info for a specific option.
     */
    if (cmdName) {
	cmdNamePtr = Tcl_NewStringObj(cmdName, TCL_INDEX_NONE);
	if (contextIoPtr != NULL) {
            hPtr = Tcl_FindHashEntry(&contextIoPtr->objectDelegatedFunctions,
	            (char *)cmdNamePtr);
	} else {
            hPtr = Tcl_FindHashEntry(&contextIclsPtr->delegatedFunctions,
	            (char *)cmdNamePtr);
	}
	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), "\"", 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), "\"", NULL);
            return TCL_ERROR;
	}
        /*
         *  By default, return everything.
         */
        if (objc == 0) {
            ioptlist = DefInfoOption;
            objc = 5;
        } else {

            /*
             *  Otherwise, scan through all remaining flags and
             *  figure out what to return.
             */
            ioptlist = &ioptlistStorage[0];
            for (i=0 ; i < objc; i++) {
                result = Tcl_GetIndexFromObjStruct(interp, objv[i],
                    options, sizeof(char *), "option", 0, (int*)(&ioptlist[i]));
                if (result != TCL_OK) {
                    return TCL_ERROR;
                }
            }
        }

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

        for (i=0 ; i < objc; i++) {
            switch (ioptlist[i]) {
                case BOptAsIdx:
                    if (idmPtr->asPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(idmPtr->asPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptExceptionsIdx:
		    {
		    Tcl_Obj *entryObj;
		    objPtr = Tcl_NewListObj(0, NULL);
		    FOREACH_HASH_VALUE(entryObj, &idmPtr->exceptions) {
			Tcl_ListObjAppendElement(interp, objPtr, entryObj);
		    }
                    }
                    break;
                case BOptUsingIdx:
                    if (idmPtr->usingPtr) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(idmPtr->usingPtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptComponentIdx:
                    if (idmPtr->icPtr != NULL) {
                        objPtr = Tcl_NewStringObj(
			        Tcl_GetString(idmPtr->icPtr->namePtr), TCL_INDEX_NONE);
                    } else {
                        objPtr = Tcl_NewStringObj("", TCL_INDEX_NONE);
                    }
                    break;

                case BOptNameIdx:
                    objPtr = Tcl_NewStringObj(
		            Tcl_GetString(idmPtr->namePtr), TCL_INDEX_NONE);
                    break;

            }

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

        /*
         *  Return the list of available options.
         */
        resultPtr = Tcl_NewListObj(0, 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(NULL, resultPtr,
		            objPtr);
		}
                hPtr = Tcl_NextHashEntry(&place);
            }
        }
        Itcl_DeleteHierIter(&hier);

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