*    } * *  NOTE:  This command is will only be provided for a limited time, *         to support backward compatibility with the old-style *         [incr Tcl] syntax.  Users should convert their scripts *         to use the newer syntax (Itcl_ClassCmd()) as soon as possible. * * ------------------------------------------------------------------------ */static intItclOldClassCmd(clientData, interp, objc, objv)    ClientData clientData;   /* info for all known objects */    Tcl_Interp *interp;      /* current interpreter */    int objc;                /* number of arguments */    Tcl_Obj *CONST objv[];   /* argument objects */{    ItclObjectInfo* info = (ItclObjectInfo*)clientData;    int result;    char *className;    Tcl_Namespace *parserNs;    ItclClass *cdefnPtr;    Tcl_HashEntry* entry;    ItclMemberFunc *mfunc;    Tcl_CallFrame frame;    if (objc != 3) {        Tcl_WrongNumArgs(interp, 1, objv, "name { definition }");        return TCL_ERROR;    }    className = Tcl_GetStringFromObj(objv[1], (int*)NULL);    /*     *  Find the namespace to use as a parser for the class definition.     *  If for some reason it is destroyed, bail out here.     */    parserNs = Tcl_FindNamespace(interp, "::itcl::old-parser",        (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);    if (parserNs == NULL) {        char msg[256];        sprintf(msg, "\n    (while parsing class definition for \"%.100s\")",            className);        Tcl_AddErrorInfo(interp, msg);        return TCL_ERROR;    }    /*     *  Try to create the specified class and its namespace.     */    if (Itcl_CreateClass(interp, className, info, &cdefnPtr) != TCL_OK) {        return TCL_ERROR;    }    cdefnPtr->flags |= ITCL_OLD_STYLE;    /*     *  Import the built-in commands from the itcl::old-builtin     *  and itcl::builtin namespaces.  Do this before parsing the     *  class definition, so methods/procs can override the built-in     *  commands.     */    result = Tcl_Import(interp, cdefnPtr->namesp, "::itcl::builtin::*",        /* allowOverwrite */ 1);    if (result == TCL_OK) {        result = Tcl_Import(interp, cdefnPtr->namesp, "::itcl::old-builtin::*",            /* allowOverwrite */ 1);    }    if (result != TCL_OK) {        char msg[256];        sprintf(msg, "\n    (while installing built-in commands for class \"%.100s\")", className);        Tcl_AddErrorInfo(interp, msg);        Tcl_DeleteNamespace(cdefnPtr->namesp);        return TCL_ERROR;    }    /*     *  Push this class onto the class definition stack so that it     *  becomes the current context for all commands in the parser.     *  Activate the parser and evaluate the class definition.     */    Itcl_PushStack((ClientData)cdefnPtr, &info->cdefnStack);    result = Tcl_PushCallFrame(interp, &frame, parserNs,        /* isProcCallFrame */ 0);    if (result == TCL_OK) {      /* CYGNUS LOCAL - Fix for Tcl8.1 */#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1      result = Tcl_EvalObj(interp, objv[2], 0);#else      result = Tcl_EvalObj(interp, objv[2]);#endif      /* END CYGNUS LOCAL */      Tcl_PopCallFrame(interp);    }    Itcl_PopStack(&info->cdefnStack);    if (result != TCL_OK) {        char msg[256];        sprintf(msg, "\n    (class \"%.200s\" body line %d)",            className, interp->errorLine);        Tcl_AddErrorInfo(interp, msg);        Tcl_DeleteNamespace(cdefnPtr->namesp);        return TCL_ERROR;    }    /*     *  At this point, parsing of the class definition has succeeded.     *  Add built-in methods such as "configure" and "cget"--as long     *  as they don't conflict with those defined in the class.     */    if (Itcl_InstallOldBiMethods(interp, cdefnPtr) != TCL_OK) {        Tcl_DeleteNamespace(cdefnPtr->namesp);        return TCL_ERROR;    }    /*     *  See if this class has a "constructor", and if it does, mark     *  it as "old-style".  This will allow the "config" argument     *  to work.     */    entry = Tcl_FindHashEntry(&cdefnPtr->functions, "constructor");    if (entry) {        mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);        mfunc->member->flags |= ITCL_OLD_STYLE;    }    /*     *  Build the virtual tables for this class.     */    Itcl_BuildVirtualTables(cdefnPtr);    Tcl_ResetResult(interp);    return TCL_OK;}/* * ------------------------------------------------------------------------ *  ItclOldMethodCmd() * *  Invoked by Tcl during the parsing of a class definition whenever *  the "method" command is invoked to define an object method. *  Handles the following syntax: * *      method <name> {<arglist>} {<body>} * * ------------------------------------------------------------------------ */static intItclOldMethodCmd(clientData, interp, objc, objv)    ClientData clientData;   /* info for all known objects */    Tcl_Interp *interp;      /* current interpreter */    int objc;                /* number of arguments */    Tcl_Obj *CONST objv[];   /* argument objects */{    ItclObjectInfo *info = (ItclObjectInfo*)clientData;    ItclClass *cdefn = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);    char *name, *arglist, *body;    Tcl_HashEntry *entry;    ItclMemberFunc *mfunc;    if (objc != 4) {        Tcl_WrongNumArgs(interp, 1, objv, "name args body");        return TCL_ERROR;    }    name = Tcl_GetStringFromObj(objv[1], (int*)NULL);    if (Tcl_FindHashEntry(&cdefn->functions, name)) {        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),            "\"", name, "\" already defined in class \"", cdefn->name, "\"",            (char*)NULL);        return TCL_ERROR;    }    arglist = Tcl_GetStringFromObj(objv[2], (int*)NULL);    body    = Tcl_GetStringFromObj(objv[3], (int*)NULL);    if (Itcl_CreateMethod(interp, cdefn, name, arglist, body) != TCL_OK) {        return TCL_ERROR;    }    /*     *  Find the method that was just created and mark it as an     *  "old-style" method, so that the magic "config" argument     *  will be allowed to work.  This is done for backward-     *  compatibility with earlier releases.  In the latest version,     *  use of the "config" argument is discouraged.     */    entry = Tcl_FindHashEntry(&cdefn->functions, name);    if (entry) {        mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);        mfunc->member->flags |= ITCL_OLD_STYLE;    }    return TCL_OK;}/* * ------------------------------------------------------------------------ *  ItclOldPublicCmd() * *  Invoked by Tcl during the parsing of a class definition whenever *  the "public" command is invoked to define a public variable. *  Handles the following syntax: * *      public <varname> ?<init>? ?<config>? * * ------------------------------------------------------------------------ */static intItclOldPublicCmd(clientData, interp, objc, objv)    ClientData clientData;   /* info for all known objects */    Tcl_Interp *interp;      /* current interpreter */    int objc;                /* number of arguments */    Tcl_Obj *CONST objv[];   /* argument objects */{    ItclObjectInfo *info = (ItclObjectInfo*)clientData;    ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);    char *name, *init, *config;    ItclVarDefn *vdefn;    if ((objc < 2) || (objc > 4)) {        Tcl_WrongNumArgs(interp, 1, objv, "varname ?init? ?config?");        return TCL_ERROR;    }    /*     *  Make sure that the variable name does not contain anything     *  goofy like a "::" scope qualifier.     */    name = Tcl_GetStringFromObj(objv[1], (int*)NULL);    if (strstr(name, "::")) {        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),            "bad variable name \"", name, "\"",            (char*)NULL);        return TCL_ERROR;    }    init   = NULL;    config = NULL;    if (objc >= 3) {        init = Tcl_GetStringFromObj(objv[2], (int*)NULL);    }    if (objc >= 4) {        config = Tcl_GetStringFromObj(objv[3], (int*)NULL);    }    if (Itcl_CreateVarDefn(interp, cdefnPtr, name, init, config,        &vdefn) != TCL_OK) {        return TCL_ERROR;    }    vdefn->member->protection = ITCL_PUBLIC;    return TCL_OK;}/* * ------------------------------------------------------------------------ *  ItclOldProtectedCmd() * *  Invoked by Tcl during the parsing of a class definition whenever *  the "protected" command is invoked to define a protected variable. *  Handles the following syntax: * *      protected <varname> ?<init>? * * ------------------------------------------------------------------------ */static intItclOldProtectedCmd(clientData, interp, objc, objv)    ClientData clientData;   /* info for all known objects */    Tcl_Interp *interp;      /* current interpreter */    int objc;                /* number of arguments */    Tcl_Obj *CONST objv[];   /* argument objects */{    ItclObjectInfo *info = (ItclObjectInfo*)clientData;    ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);    char *name, *init;    ItclVarDefn *vdefn;    if ((objc < 2) || (objc > 3)) {        Tcl_WrongNumArgs(interp, 1, objv, "varname ?init?");        return TCL_ERROR;    }    /*     *  Make sure that the variable name does not contain anything     *  goofy like a "::" scope qualifier.     */    name = Tcl_GetStringFromObj(objv[1], (int*)NULL);    if (strstr(name, "::")) {        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),            "bad variable name \"", name, "\"",            (char*)NULL);        return TCL_ERROR;    }    if (objc == 3) {        init = Tcl_GetStringFromObj(objv[2], (int*)NULL);    } else {        init = NULL;    }    if (Itcl_CreateVarDefn(interp, cdefnPtr, name, init, (char*)NULL,        &vdefn) != TCL_OK) {        return TCL_ERROR;    }    vdefn->member->protection = ITCL_PROTECTED;    return TCL_OK;}/* * ------------------------------------------------------------------------ *  ItclOldCommonCmd() * *  Invoked by Tcl during the parsing of a class definition whenever *  the "common" command is invoked to define a variable that is *  common to all objects in the class.  Handles the following syntax: * *      common <varname> ?<init>? * * ------------------------------------------------------------------------ */static intItclOldCommonCmd(clientData, interp, objc, objv)    ClientData clientData;   /* info for all known objects */    Tcl_Interp *interp;      /* current interpreter */    int objc;                /* number of arguments */    Tcl_Obj *CONST objv[];   /* argument objects */{    ItclObjectInfo *info = (ItclObjectInfo*)clientData;    ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);    int newEntry;    char *name, *init;    ItclVarDefn *vdefn;    Tcl_HashEntry *entry;    Namespace *nsPtr;    Var *varPtr;    if ((objc < 2) || (objc > 3)) {        Tcl_WrongNumArgs(interp, 1, objv, "varname ?init?");        return TCL_ERROR;    }    /*     *  Make sure that the variable name does not contain anything     *  goofy like a "::" scope qualifier.     */    name = Tcl_GetStringFromObj(objv[1], (int*)NULL);    if (strstr(name, "::")) {        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),            "bad variable name \"", name, "\"",            (char*)NULL);        return TCL_ERROR;    }    if (objc == 3) {        init = Tcl_GetStringFromObj(objv[2], (int*)NULL);    } else {        init = NULL;    }    if (Itcl_CreateVarDefn(interp, cdefnPtr, name, init, (char*)NULL,        &vdefn) != TCL_OK) {        return TCL_ERROR;    }    vdefn->member->protection = ITCL_PROTECTED;    vdefn->member->flags |= ITCL_COMMON;    /*     *  Create the variable in the namespace associated with the     *  class.  Do this the hard way, to avoid the variable resolver     *  procedures.  These procedures won't work until we rebuild     *  the virtual tables below.     */