itcl_obsolete.c

linux 下的源代码分析阅读器 red hat公司新版

        Itcl_InitHierIter(&hier, contextClass);
        cdPtr = Itcl_AdvanceHierIter(&hier);
        while (cdPtr != NULL) {
            entry = Tcl_FirstHashEntry(&cdPtr->variables, &place);
            while (entry) {
                vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
                member = vdefn->member;

                if ((member->flags & ITCL_COMMON) == 0 &&
                     member->protection == ITCL_PUBLIC) {

                    objPtr = Tcl_NewStringObj(member->classDefn->name, -1);
                    Tcl_AppendToObj(objPtr, "::", -1);
                    Tcl_AppendToObj(objPtr, member->name, -1);

                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
                        objPtr);
                }
                entry = Tcl_NextHashEntry(&place);
            }
            cdPtr = Itcl_AdvanceHierIter(&hier);
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, listPtr);
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclOldBiInfoProtectedsCmd()
 *
 *  Sets the interpreter result to contain information for protected
 *  variables in the class.  Handles the following syntax:
 *
 *     info protected ?varName? ?-init? ?-value?
 *
 *  If the ?varName? is not specified, then a list of all known public
 *  variables is returned.  Otherwise, the information (init/value)
 *  for a specific variable is returned.  Returns a status
 *  TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
ItclOldBiInfoProtectedsCmd(dummy, interp, objc, objv)
    ClientData dummy;     /* not used */
    Tcl_Interp *interp;   /* current interpreter */
    int objc;                /* number of arguments */
    Tcl_Obj *CONST objv[];   /* argument objects */
{
    char *varName = NULL;
    int varInit = 0;
    int varValue = 0;

    char *token, *val;
    ItclClass *contextClass;
    ItclObject *contextObj;

    ItclClass *cdPtr;
    ItclVarLookup *vlookup;
    ItclVarDefn *vdefn;
    ItclMember *member;
    ItclHierIter hier;
    Tcl_HashEntry *entry;
    Tcl_HashSearch place;
    Tcl_Obj *objPtr, *listPtr;

    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
        return TCL_ERROR;
    }

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

    if (objc > 0) {
        varName = Tcl_GetStringFromObj(*objv, (int*)NULL);
        objc--; objv++;
    }
    for ( ; objc > 0; objc--, objv++) {
        token = Tcl_GetStringFromObj(*objv, (int*)NULL);
        if (strcmp(token, "-init") == 0)
            varInit = ~0;
        else if (strcmp(token, "-value") == 0)
            varValue = ~0;
        else {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "bad option \"", token, "\": should be -init or -value",
                (char*)NULL);
            return TCL_ERROR;
        }
    }

    /*
     *  Return info for a specific variable.
     */
    if (varName) {
        vlookup = NULL;
        entry = Tcl_FindHashEntry(&contextClass->resolveVars, varName);
        if (entry) {
            vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
            if (vlookup->vdefn->member->protection != ITCL_PROTECTED) {
                vlookup = NULL;
            }
        }

        if (vlookup) {
            int i, valc = 0;
            Tcl_Obj *valv[5];

            member = vlookup->vdefn->member;

            if (!varInit && !varValue) {
                objPtr = Tcl_NewStringObj(member->classDefn->name, -1);
                Tcl_AppendToObj(objPtr, "::", -1);
                Tcl_AppendToObj(objPtr, member->name, -1);
                Tcl_IncrRefCount(objPtr);
                valv[valc++] = objPtr;
                varInit = varValue = ~0;
            }

            /*
             *  If this is the built-in "this" variable, then
             *  report the object name as its initialization string.
             */
            if (varInit) {
                if ((member->flags & ITCL_THIS_VAR) != 0) {
                    if (contextObj && contextObj->accessCmd) {
                        objPtr = Tcl_NewStringObj("", -1);
                        Tcl_IncrRefCount(objPtr);
                        Tcl_GetCommandFullName(contextObj->classDefn->interp,
                            contextObj->accessCmd, objPtr);
                        valv[valc++] = objPtr;
                    }
                    else {
                        objPtr = Tcl_NewStringObj("<objectName>", -1);
                        Tcl_IncrRefCount(objPtr);
                        valv[valc++] = objPtr;
                    }
                }
                else {
                    val = (vlookup->vdefn->init) ? vlookup->vdefn->init : "";
                    objPtr = Tcl_NewStringObj(val, -1);
                    Tcl_IncrRefCount(objPtr);
                    valv[valc++] = objPtr;
                }
            }

            if (varValue) {
                val = Itcl_GetInstanceVar(interp, member->fullname,
                    contextObj, contextObj->classDefn);

                if (!val) {
                    val = "<undefined>";
                }
                objPtr = Tcl_NewStringObj(val, -1);
                Tcl_IncrRefCount(objPtr);
                valv[valc++] = objPtr;
            }

            /*
             *  If the result list has a single element, then
             *  return it using Tcl_SetResult() so that it will
             *  look like a string and not a list with one element.
             */
            if (valc == 1) {
                objPtr = valv[0];
            } else {
                objPtr = Tcl_NewListObj(valc, valv);
            }
            Tcl_SetObjResult(interp, objPtr);

            for (i=0; i < valc; i++) {
                Tcl_DecrRefCount(valv[i]);
            }
        }
    }

    /*
     *  Return the list of public variables.
     */
    else {
        listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);

        Itcl_InitHierIter(&hier, contextClass);
        cdPtr = Itcl_AdvanceHierIter(&hier);
        while (cdPtr != NULL) {
            entry = Tcl_FirstHashEntry(&cdPtr->variables, &place);
            while (entry) {
                vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
                member = vdefn->member;

                if ((member->flags & ITCL_COMMON) == 0 &&
                     member->protection == ITCL_PROTECTED) {

                    objPtr = Tcl_NewStringObj(member->classDefn->name, -1);
                    Tcl_AppendToObj(objPtr, "::", -1);
                    Tcl_AppendToObj(objPtr, member->name, -1);

                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
                        objPtr);
                }
                entry = Tcl_NextHashEntry(&place);
            }
            cdPtr = Itcl_AdvanceHierIter(&hier);
        }
        Itcl_DeleteHierIter(&hier);

        Tcl_SetObjResult(interp, listPtr);
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclOldBiInfoCommonsCmd()
 *
 *  Sets the interpreter result to contain information for common
 *  variables in the class.  Handles the following syntax:
 *
 *     info common ?varName? ?-init? ?-value?
 *
 *  If the ?varName? is not specified, then a list of all known common
 *  variables is returned.  Otherwise, the information (init/value)
 *  for a specific variable is returned.  Returns a status
 *  TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
ItclOldBiInfoCommonsCmd(dummy, interp, objc, objv)
    ClientData dummy;     /* not used */
    Tcl_Interp *interp;   /* current interpreter */
    int objc;                /* number of arguments */
    Tcl_Obj *CONST objv[];   /* argument objects */
{
    char *varName = NULL;
    int varInit = 0;
    int varValue = 0;

    char *token, *val;
    ItclClass *contextClass;
    ItclObject *contextObj;

    ItclClass *cdPtr;
    ItclVarDefn *vdefn;
    ItclVarLookup *vlookup;
    ItclMember *member;
    ItclHierIter hier;
    Tcl_HashEntry *entry;
    Tcl_HashSearch place;
    Tcl_Obj *objPtr, *listPtr;

    /*
     *  If this command is not invoked within a class namespace,
     *  signal an error.
     */
    if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
        return TCL_ERROR;
    }

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

    if (objc > 0) {
        varName = Tcl_GetStringFromObj(*objv, (int*)NULL);
        objc--; objv++;
    }
    for ( ; objc > 0; objc--, objv++) {
        token = Tcl_GetStringFromObj(*objv, (int*)NULL);
        if (strcmp(token, "-init") == 0)
            varInit = ~0;
        else if (strcmp(token, "-value") == 0)
            varValue = ~0;
        else {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "bad option \"", token, "\": should be -init or -value",
                (char*)NULL);
            return TCL_ERROR;
        }
    }

    /*
     *  Return info for a specific variable.
     */
    if (varName) {
        vlookup = NULL;
        entry = Tcl_FindHashEntry(&contextClass->resolveVars, varName);
        if (entry) {
            vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
            if (vlookup->vdefn->member->protection != ITCL_PROTECTED) {
                vlookup = NULL;
            }
        }

        if (vlookup) {
            int i, valc = 0;
            Tcl_Obj *valv[5];

            member = vlookup->vdefn->member;

            if (!varInit && !varValue) {
                objPtr = Tcl_NewStringObj(member->classDefn->name, -1);
                Tcl_AppendToObj(objPtr, "::", -1);
                Tcl_AppendToObj(objPtr, member->name, -1);
                Tcl_IncrRefCount(objPtr);
                valv[valc++] = objPtr;
                varInit = varValue = ~0;
            }
            if (varInit) {
                val = (vlookup->vdefn->init) ? vlookup->vdefn->init : "";
                objPtr = Tcl_NewStringObj(val, -1);
                Tcl_IncrRefCount(objPtr);
                valv[valc++] = objPtr;
            }

            if (varValue) {
                val = Itcl_GetCommonVar(interp, member->fullname,
                    contextObj->classDefn);

                if (!val) {
                    val = "<undefined>";
                }
                objPtr = Tcl_NewStringObj(val, -1);
                Tcl_IncrRefCount(objPtr);
                valv[valc++] = objPtr;
            }

            /*
             *  If the result list has a single element, then
             *  return it using Tcl_SetResult() so that it will
             *  look like a string and not a list with one element.
             */
            if (valc == 1) {
                objPtr = valv[0];
            } else {
                objPtr = Tcl_NewListObj(valc, valv);
            }
            Tcl_SetObjResult(interp, objPtr);

            for (i=0; i < valc; i++) {
                Tcl_DecrRefCount(valv[i]);
            }
        }
    }

    /*
     *  Return the list of public variables.
     */
    else {
        listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);

        Itcl_InitHierIter(&hier, contextClass);
        cdPtr = Itcl_AdvanceHierIter(&hier);
        while (cdPtr != NULL) {
            entry = Tcl_FirstHashEntry(&cdPtr->variables, &place);
            while (entry) {
                vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
                member = vdefn->member;

                if ((member->flags & ITCL_COMMON) &&
                     member->protection == ITCL_PROTECTED) {

                    objPtr = Tcl_NewStringObj(member->classDefn->name, -1);
                    Tcl_AppendToObj(objPtr, "::", -1);
                    Tcl_AppendToObj(objPtr, member->name, -1);

                    Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
                        objPtr);
                }
                entry = Tcl_NextHashEntry(&place);
            }
            cdPtr = Itcl_AdvanceHierIter(&hier);
        }
        Itcl_DeleteHierIter(&hier);

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