0001: /*
0002: * ------------------------------------------------------------------------
0003: * PACKAGE: [incr Tcl]
0004: * DESCRIPTION: Object-Oriented Extensions to Tcl
0005: *
0006: * [incr Tcl] provides object-oriented extensions to Tcl, much as
0007: * C++ provides object-oriented extensions to C. It provides a means
0008: * of encapsulating related procedures together with their shared data
0009: * in a local namespace that is hidden from the outside world. It
0010: * promotes code re-use through inheritance. More than anything else,
0011: * it encourages better organization of Tcl applications through the
0012: * object-oriented paradigm, leading to code that is easier to
0013: * understand and maintain.
0014: *
0015: * These procedures handle class definitions. Classes are composed of
0016: * data members (public/protected/common) and the member functions
0017: * (methods/procs) that operate on them. Each class has its own
0018: * namespace which manages the class scope.
0019: *
0020: * ========================================================================
0021: * AUTHOR: Michael J. McLennan
0022: * Bell Labs Innovations for Lucent Technologies
0023: * mmclennan@lucent.com
0024: * http://www.tcltk.com/itcl
0025: *
0026: * RCS: $Id: Class.java,v 1.4 2006/01/26 19:49:18 mdejong Exp $
0027: * ========================================================================
0028: * Copyright (c) 1993-1998 Lucent Technologies, Inc.
0029: * ------------------------------------------------------------------------
0030: * See the file "license.terms" for information on usage and redistribution
0031: * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
0032: */
0033:
0034: package itcl.lang;
0035:
0036: import tcl.lang.*;
0037:
0038: import java.util.Iterator;
0039: import java.util.Map;
0040: import java.util.HashMap;
0041:
0042: // Note: ItclResolvedVarInfo structure not ported since it seems
0043: // to be used only in the bytecode compiler implementation.
0044:
0045: class Class {
0046:
0047: static int itclCompatFlags = Cmds.itclCompatFlags;
0048:
0049: /*
0050: * ------------------------------------------------------------------------
0051: * Itcl_CreateClass -> Class.CreateClass
0052: *
0053: * Creates a namespace and its associated class definition data.
0054: * If a namespace already exists with that name, then this routine
0055: * will raise a TclException to indicate failure. If successful,
0056: * a reference to a new class definition will be returned.
0057: * ------------------------------------------------------------------------
0058: */
0059:
0060: static ItclClass CreateClass(Interp interp, // interpreter that will contain new class
0061: String path, // name of new class
0062: ItclObjectInfo info) // info for all known objects
0063: throws TclException {
0064: String head, tail;
0065: WrappedCommand wcmd;
0066: Namespace classNs;
0067: ItclClass cd;
0068: ItclVarDefn vdefn;
0069:
0070: // Make sure that a class with the given name does not
0071: // already exist in the current namespace context. If a
0072: // namespace exists, that's okay. It may have been created
0073: // to contain stubs during a "namespace import" operation.
0074: // We'll just replace the namespace data below with the
0075: // proper class data.
0076:
0077: classNs = Namespace.findNamespace(interp, path, null, 0);
0078:
0079: if (classNs != null && Class.IsClassNamespace(classNs)) {
0080: throw new TclException(interp, "class \"" + path
0081: + "\" already exists");
0082: }
0083:
0084: // Make sure that a command with the given class name does not
0085: // already exist in the current namespace. This prevents the
0086: // usual Tcl commands from being clobbered when a programmer
0087: // makes a bogus call like "class info".
0088:
0089: wcmd = Namespace.findCommand(interp, path, null,
0090: TCL.NAMESPACE_ONLY);
0091:
0092: if (wcmd != null && !Cmds.IsStub(wcmd)) {
0093: StringBuffer buffer = new StringBuffer(64);
0094:
0095: buffer.append("command \"" + path + "\" already exists");
0096:
0097: if (path.indexOf("::") == -1) {
0098: buffer
0099: .append(" in namespace \""
0100: + Namespace.getCurrentNamespace(interp).fullName
0101: + "\"");
0102: }
0103:
0104: throw new TclException(interp, buffer.toString());
0105: }
0106:
0107: // Make sure that the class name does not have any goofy
0108: // characters:
0109: //
0110: // . => reserved for member access like: class.publicVar
0111:
0112: Util.ParseNamespPathResult res = Util.ParseNamespPath(path);
0113: head = res.head;
0114: tail = res.tail;
0115:
0116: if (tail.indexOf(".") != -1) {
0117: throw new TclException(interp, "bad class name \"" + tail
0118: + "\"");
0119: }
0120:
0121: // Allocate class definition data.
0122:
0123: cd = new ItclClass();
0124: cd.name = null;
0125: cd.fullname = null;
0126: cd.interp = interp;
0127: cd.info = info;
0128: Util.PreserveData(info);
0129: cd.namesp = null;
0130: cd.accessCmd = null;
0131: cd.w_accessCmd = null;
0132:
0133: cd.variables = new HashMap();
0134: cd.functions = new HashMap();
0135:
0136: cd.numInstanceVars = 0;
0137: cd.resolveVars = new HashMap();
0138: cd.resolveCmds = new HashMap();
0139:
0140: cd.bases = new Itcl_List();
0141: Util.InitList(cd.bases);
0142: cd.derived = new Itcl_List();
0143: Util.InitList(cd.derived);
0144:
0145: cd.initCode = null;
0146: cd.unique = 0;
0147: cd.flags = 0;
0148:
0149: // Initialize the heritage info--each class starts with its
0150: // own class definition in the heritage. Base classes are
0151: // added to the heritage from the "inherit" statement.
0152:
0153: cd.heritage = new HashMap();
0154: cd.heritage.put(cd, "");
0155:
0156: // Create a namespace to represent the class. Add the class
0157: // definition info as client data for the namespace. If the
0158: // namespace already exists, then replace any existing client
0159: // data with the class data.
0160:
0161: Util.PreserveData(cd);
0162:
0163: if (classNs == null) {
0164: classNs = Namespace.createNamespace(interp, path,
0165: new DestroyClassNamespImpl(cd));
0166: } else {
0167: if (classNs.deleteProc != null) {
0168: classNs.deleteProc.delete();
0169: }
0170: classNs.deleteProc = new DestroyClassNamespImpl(cd);
0171: }
0172:
0173: //Util.EventuallyFree(cd, ItclFreeClass);
0174:
0175: if (classNs == null) {
0176: Util.ReleaseData(cd);
0177: throw new TclException(interp, interp.getResult()
0178: .toString());
0179: }
0180:
0181: cd.namesp = classNs;
0182:
0183: cd.name = classNs.name;
0184:
0185: cd.fullname = classNs.fullName;
0186:
0187: // Add special name resolution procedures to the class namespace
0188: // so that members are accessed according to the rules for
0189: // [incr Tcl].
0190:
0191: Resolver resolver = new ClassResolverImpl();
0192: Namespace.setNamespaceResolver(classNs, resolver);
0193:
0194: // Add the built-in "this" variable to the list of data members.
0195:
0196: try {
0197: vdefn = CreateVarDefn(interp, cd, "this", null, null);
0198: } catch (TclException ex) {
0199: throw new TclRuntimeError("unexpected TclException");
0200: }
0201:
0202: vdefn.member.protection = Itcl.PROTECTED; // always "protected"
0203: vdefn.member.flags |= ItclInt.THIS_VAR; // mark as "this" variable
0204:
0205: cd.variables.put("this", vdefn);
0206:
0207: // Create a command in the current namespace to manage the class:
0208: // <className>
0209: // <className> <objName> ?<constructor-args>?
0210:
0211: Util.PreserveData(cd);
0212:
0213: interp.createCommand(cd.fullname, new HandleClassCmd(cd));
0214:
0215: cd.w_accessCmd = Namespace.findCommand(interp, cd.fullname,
0216: null, TCL.NAMESPACE_ONLY);
0217: cd.accessCmd = cd.w_accessCmd.cmd;
0218:
0219: return cd;
0220: }
0221:
0222: /*
0223: * ------------------------------------------------------------------------
0224: * Itcl_DeleteClass -> Class.DeleteClass
0225: *
0226: * Deletes a class by deleting all derived classes and all objects in
0227: * that class, and finally, by destroying the class namespace. This
0228: * procedure provides a friendly way of doing this. If any errors
0229: * are detected along the way, the process is aborted.
0230: *
0231: * Will raise a TclException to indicate failure.
0232: * ------------------------------------------------------------------------
0233: */
0234:
0235: static void DeleteClass(Interp interp, // interpreter managing this class
0236: ItclClass cdefn) // class namespace
0237: throws TclException {
0238: ItclClass cd = null;
0239:
0240: Itcl_ListElem elem;
0241: ItclObject contextObj;
0242:
0243: // Destroy all derived classes, since these lose their meaning
0244: // when the base class goes away. If anything goes wrong,
0245: // abort with an error.
0246: //
0247: // TRICKY NOTE: When a derived class is destroyed, it
0248: // automatically deletes itself from the "derived" list.
0249:
0250: elem = Util.FirstListElem(cdefn.derived);
0251: while (elem != null) {
0252: cd = (ItclClass) Util.GetListValue(elem);
0253: elem = Util.NextListElem(elem); // advance here--elem will go away
0254:
0255: try {
0256: Class.DeleteClass(interp, cd);
0257: } catch (TclException ex) {
0258: DeleteClassFailed(interp, cd.namesp.fullName, ex);
0259: }
0260: }
0261:
0262: // Scan through and find all objects that belong to this class.
0263: // Note that more specialized objects have already been
0264: // destroyed above, when derived classes were destroyed.
0265: // Destroy objects and report any errors.
0266:
0267: for (Iterator iter = cdefn.info.objects.entrySet().iterator(); iter
0268: .hasNext();) {
0269: Map.Entry entry = (Map.Entry) iter.next();
0270: contextObj = (ItclObject) entry.getValue();
0271:
0272: if (contextObj.classDefn == cdefn) {
0273: try {
0274: Objects.DeleteObject(interp, contextObj);
0275: } catch (TclException ex) {
0276: cd = cdefn;
0277: DeleteClassFailed(interp, cd.namesp.fullName, ex);
0278: }
0279:
0280: // Fix 227804: Whenever an object to delete was found we
0281: // have to reset the search to the beginning as the
0282: // current entry in the search was deleted and accessing it
0283: // is therefore not allowed anymore.
0284:
0285: iter = cdefn.info.objects.entrySet().iterator();
0286: }
0287: }
0288:
0289: // Destroy the namespace associated with this class.
0290: //
0291: // TRICKY NOTE:
0292: // The cleanup procedure associated with the namespace is
0293: // invoked automatically. It does all of the same things
0294: // above, but it also disconnects this class from its
0295: // base-class lists, and removes the class access command.
0296:
0297: Namespace.deleteNamespace(cdefn.namesp);
0298: }
0299:
0300: // Helper function used when DeleteClass fails
0301:
0302: static void DeleteClassFailed(Interp interp, String fullName,
0303: TclException ex) throws TclException {
0304: StringBuffer buffer = new StringBuffer(64);
0305:
0306: buffer.append("\n (while deleting class \"");
0307: buffer.append(fullName);
0308: buffer.append("\")");
0309: interp.addErrorInfo(buffer.toString());
0310:
0311: throw ex;
0312: }
0313:
0314: /*
0315: * ------------------------------------------------------------------------
0316: * ItclDestroyClass -> Class.DestroyClass
0317: *
0318: * Invoked whenever the access command for a class is destroyed.
0319: * Destroys the namespace associated with the class, which also
0320: * destroys all objects in the class and all derived classes.
0321: * Disconnects this class from the "derived" class lists of its
0322: * base classes, and releases any claim to the class definition
0323: * data. If this is the last use of that data, the class will
0324: * completely vanish at this point.
0325: * ------------------------------------------------------------------------
0326: */
0327:
0328: static void DestroyClass(ItclClass cdefn) // class definition to be destroyed
0329: {
0330: cdefn.accessCmd = null;
0331: cdefn.w_accessCmd = null;
0332:
0333: Namespace.deleteNamespace(cdefn.namesp);
0334: Util.ReleaseData(cdefn);
0335: }
0336:
0337: /*
0338: * ------------------------------------------------------------------------
0339: * ItclDestroyClassNamesp -> Class.DestroyClassNamesp
0340: *
0341: * Invoked whenever the namespace associated with a class is destroyed.
0342: * Destroys all objects associated with this class and all derived
0343: * classes. Disconnects this class from the "derived" class lists
0344: * of its base classes, and removes the class access command. Releases
0345: * any claim to the class definition data. If this is the last use
0346: * of that data, the class will completely vanish at this point.
0347: * ------------------------------------------------------------------------
0348: */
0349:
0350: static void DestroyClassNamesp(ItclClass cdefn) {
0351: ItclObject contextObj;
0352: Itcl_ListElem elem, belem;
0353: ItclClass cd, base, derived;
0354:
0355: // Destroy all derived classes, since these lose their meaning
0356: // when the base class goes away.
0357: //
0358: // TRICKY NOTE: When a derived class is destroyed, it
0359: // automatically deletes itself from the "derived" list.
0360:
0361: elem = Util.FirstListElem(cdefn.derived);
0362: while (elem != null) {
0363: cd = (ItclClass) Util.GetListValue(elem);
0364: Namespace.deleteNamespace(cd.namesp);
0365:
0366: // As the first namespace is now destroyed we have to get the
0367: // new first element of the hash table. We cannot go to the
0368: // next element from the current one, because the current one
0369: // is deleted. itcl Patch #593112, for Bug #577719.
0370:
0371: elem = Util.FirstListElem(cdefn.derived);
0372: }
0373:
0374: // Scan through and find all objects that belong to this class.
0375: // Destroy them quietly by deleting their access command.
0376:
0377: for (Iterator iter = cdefn.info.objects.entrySet().iterator(); iter
0378: .hasNext();) {
0379: Map.Entry entry = (Map.Entry) iter.next();
0380: contextObj = (ItclObject) entry.getValue();
0381:
0382: if (contextObj.classDefn == cdefn) {
0383: cdefn.interp
0384: .deleteCommandFromToken(contextObj.w_accessCmd);
0385:
0386: // Fix 227804: Whenever an object to delete was found we
0387: // have to reset the search to the beginning as the
0388: // current entry in the search was deleted and accessing it
0389: // is therefore not allowed anymore.
0390:
0391: iter = cdefn.info.objects.entrySet().iterator();
0392: }
0393: }
0394:
0395: // Next, remove this class from the "derived" list in
0396: // all base classes.
0397:
0398: belem = Util.FirstListElem(cdefn.bases);
0399: while (belem != null) {
0400: base = (ItclClass) Util.GetListValue(belem);
0401:
0402: elem = Util.FirstListElem(base.derived);
0403: while (elem != null) {
0404: derived = (ItclClass) Util.GetListValue(elem);
0405: if (derived == cdefn) {
0406: Util.ReleaseData((ItclClass) Util
0407: .GetListValue(elem));
0408: elem = Util.DeleteListElem(elem);
0409: } else {
0410: elem = Util.NextListElem(elem);
0411: }
0412: }
0413: belem = Util.NextListElem(belem);
0414: }
0415:
0416: // Next, destroy the access command associated with the class.
0417:
0418: if (cdefn.accessCmd != null) {
0419: HandleClassCmd hcc = (HandleClassCmd) cdefn.accessCmd;
0420:
0421: // Set flag in HandleClassCmd instance so that
0422: // Util.ReleaseData() will be invoked
0423: // at command destroy time instead of DestroyClass().
0424: hcc.release = true;
0425:
0426: cdefn.interp.deleteCommandFromToken(cdefn.w_accessCmd);
0427: }
0428:
0429: // Release the namespace's claim on the class definition.
0430:
0431: Util.ReleaseData(cdefn);
0432: }
0433:
0434: // Helper class that implements namespace delete callback.
0435: // Pass as the deleteproc argument to createNamespace.
0436:
0437: static class DestroyClassNamespImpl implements Namespace.DeleteProc {
0438: ItclClass cdefn;
0439:
0440: DestroyClassNamespImpl(ItclClass cdefn) {
0441: this .cdefn = cdefn;
0442: }
0443:
0444: public void delete() {
0445: DestroyClassNamesp(cdefn);
0446: }
0447:
0448: } // end class DestroyClassNamesp
0449:
0450: /*
0451: * ------------------------------------------------------------------------
0452: * ItclFreeClass -> Class.FreeClass
0453: *
0454: * Frees all memory associated with a class definition. This is
0455: * usually invoked automatically by Itcl_ReleaseData(), when class
0456: * data is no longer being used.
0457: * ------------------------------------------------------------------------
0458: */
0459:
0460: static void FreeClass(ItclClass cdefn) // class definition to be destroyed
0461: {
0462: Itcl_ListElem elem;
0463: ItclVarDefn vdefn;
0464: ItclVarLookup vlookup;
0465: Var var;
0466: HashMap varTable;
0467:
0468: // Tear down the list of derived classes. This list should
0469: // really be empty if everything is working properly, but
0470: // release it here just in case.
0471:
0472: elem = Util.FirstListElem(cdefn.derived);
0473: while (elem != null) {
0474: Util.ReleaseData((ItclClass) Util.GetListValue(elem));
0475: elem = Util.NextListElem(elem);
0476: }
0477: Util.DeleteList(cdefn.derived);
0478: cdefn.derived = null;
0479:
0480: // Tear down the variable resolution table. Some records
0481: // appear multiple times in the table (for x, foo::x, etc.)
0482: // so each one has a reference count.
0483:
0484: varTable = new HashMap();
0485:
0486: for (Iterator iter = cdefn.resolveVars.entrySet().iterator(); iter
0487: .hasNext();) {
0488: Map.Entry entry = (Map.Entry) iter.next();
0489: vlookup = (ItclVarLookup) entry.getValue();
0490:
0491: if (--vlookup.usage == 0) {
0492: // If this is a common variable owned by this class,
0493: // then release the class's hold on it. If it's no
0494: // longer being used, move it into a variable table
0495: // for destruction.
0496:
0497: if ((vlookup.vdefn.member.flags & ItclInt.COMMON) != 0
0498: && vlookup.vdefn.member.classDefn == cdefn) {
0499: var = (Var) vlookup.common;
0500: if (ItclAccess.decrVarRefCount(var) == 0) {
0501: varTable
0502: .put(vlookup.vdefn.member.fullname, var);
0503: }
0504: }
0505: }
0506: }
0507: ItclAccess.deleteVars(cdefn.interp, varTable);
0508: cdefn.resolveVars = null;
0509:
0510: // Tear down the virtual method table...
0511:
0512: cdefn.resolveCmds.clear();
0513: cdefn.resolveCmds = null;
0514:
0515: // Delete all variable definitions.
0516:
0517: for (Iterator iter = cdefn.variables.entrySet().iterator(); iter
0518: .hasNext();) {
0519: Map.Entry entry = (Map.Entry) iter.next();
0520: vdefn = (ItclVarDefn) entry.getValue();
0521: DeleteVarDefn(vdefn);
0522: }
0523: cdefn.variables.clear();
0524: cdefn.variables = null;
0525:
0526: // Delete all function definitions.
0527:
0528: for (Iterator iter = cdefn.functions.entrySet().iterator(); iter
0529: .hasNext();) {
0530: Map.Entry entry = (Map.Entry) iter.next();
0531: ItclMemberFunc mfunc = (ItclMemberFunc) entry.getValue();
0532: Util.ReleaseData(mfunc);
0533: }
0534: cdefn.functions.clear();
0535: cdefn.functions = null;
0536:
0537: // Release the claim on all base classes.
0538:
0539: elem = Util.FirstListElem(cdefn.bases);
0540: while (elem != null) {
0541: Util.ReleaseData((ItclClass) Util.GetListValue(elem));
0542: elem = Util.NextListElem(elem);
0543: }
0544: Util.DeleteList(cdefn.bases);
0545: cdefn.bases = null;
0546: cdefn.heritage.clear();
0547: cdefn.heritage = null;
0548:
0549: // Free up the object initialization code.
0550:
0551: if (cdefn.initCode != null) {
0552: cdefn.initCode.release();
0553: }
0554:
0555: Util.ReleaseData(cdefn.info);
0556:
0557: cdefn.name = null;
0558: cdefn.fullname = null;
0559: }
0560:
0561: /*
0562: * ------------------------------------------------------------------------
0563: * Itcl_IsClassNamespace -> Class.IsClassNamespace
0564: *
0565: * Checks to see whether or not the given namespace represents an
0566: * [incr Tcl] class. Returns true if so, and false otherwise.
0567: * ------------------------------------------------------------------------
0568: */
0569:
0570: static boolean IsClassNamespace(Namespace ns) // namespace being tested
0571: {
0572: if (ns != null) {
0573: return (ns.deleteProc instanceof DestroyClassNamespImpl);
0574: }
0575: return false;
0576: }
0577:
0578: /*
0579: * ------------------------------------------------------------------------
0580: * Class.GetClassFromNamespace
0581: *
0582: * Return the ItclClass associated with a given class namespace.
0583: * This function assumes that IsClassNamespace() returns
0584: * true for this namespace.
0585: * ------------------------------------------------------------------------
0586: */
0587:
0588: static ItclClass GetClassFromNamespace(Namespace ns) // namespace being tested
0589: {
0590: if (ns == null
0591: || !(ns.deleteProc instanceof DestroyClassNamespImpl)) {
0592: throw new TclRuntimeError(
0593: "namespace is not a class namespace");
0594: }
0595: return ((Class.DestroyClassNamespImpl) ns.deleteProc).cdefn;
0596: }
0597:
0598: /*
0599: * ------------------------------------------------------------------------
0600: * Itcl_IsClass -> Class.IsClass
0601: *
0602: * Checks the given Tcl command to see if it represents an itcl class.
0603: * Returns true if the command is associated with a class.
0604: * ------------------------------------------------------------------------
0605: */
0606:
0607: static boolean IsClass(WrappedCommand wcmd) // command being tested
0608: {
0609: HandleClassCmd hcc = null;
0610: WrappedCommand origCmd;
0611:
0612: if (wcmd.cmd instanceof HandleClassCmd) {
0613: hcc = (HandleClassCmd) wcmd.cmd;
0614: } else {
0615: // May be an imported command
0616: origCmd = Namespace.getOriginalCommand(wcmd);
0617: if ((origCmd != null)
0618: && (origCmd.cmd instanceof HandleClassCmd)) {
0619: hcc = (HandleClassCmd) origCmd.cmd;
0620: }
0621: }
0622:
0623: if (hcc != null && hcc.release == false) {
0624: return true;
0625: }
0626: return false;
0627: }
0628:
0629: /*
0630: * ------------------------------------------------------------------------
0631: * Itcl_FindClass -> Class.FindClass
0632: *
0633: * Searches for the specified class in the active namespace. If the
0634: * class is found, this procedure returns a pointer to the class
0635: * definition. Otherwise, if the autoload flag is true, an
0636: * attempt will be made to autoload the class definition. If it
0637: * still can't be found, this procedure returns null.
0638: * ------------------------------------------------------------------------
0639: */
0640:
0641: static ItclClass FindClass(Interp interp, // interpreter containing class
0642: String path, // path name for class
0643: boolean autoload) // should class be loaded automatically
0644: {
0645: Namespace classNs;
0646:
0647: // Search for a namespace with the specified name, and if
0648: // one is found, see if it is a class namespace.
0649:
0650: classNs = FindClassNamespace(interp, path);
0651:
0652: if (classNs != null && IsClassNamespace(classNs)) {
0653: return GetClassFromNamespace(classNs);
0654: }
0655:
0656: // If the autoload flag is set, try to autoload the class
0657: // definition.
0658:
0659: if (autoload) {
0660: try {
0661: interp.eval("::auto_load \"" + path + "\"");
0662: } catch (TclException ex) {
0663: interp
0664: .addErrorInfo("\n (while attempting to autoload class \""
0665: + path + "\")");
0666: return null;
0667: }
0668: interp.resetResult();
0669:
0670: classNs = FindClassNamespace(interp, path);
0671: if (classNs != null && IsClassNamespace(classNs)) {
0672: return GetClassFromNamespace(classNs);
0673: }
0674: }
0675:
0676: String result = interp.getResult().toString();
0677: StringBuffer sb = new StringBuffer(64);
0678: sb.append(result);
0679: sb.append("class \"");
0680: sb.append(path);
0681: sb.append("\" not found in context \"");
0682: sb.append(Namespace.getCurrentNamespace(interp).fullName);
0683: sb.append("\"");
0684: interp.setResult(sb.toString());
0685:
0686: return null;
0687: }
0688:
0689: /*
0690: * ------------------------------------------------------------------------
0691: * Itcl_FindClassNamespace -> Class.FindClassNamespace
0692: *
0693: * Searches for the specified class namespace. The normal Tcl procedure
0694: * Tcl_FindNamespace also searches for namespaces, but only in the
0695: * current namespace context. This makes it hard to find one class
0696: * from within another. For example, suppose. you have two namespaces
0697: * Foo and Bar. If you're in the context of Foo and you look for
0698: * Bar, you won't find it with Tcl_FindNamespace. This behavior is
0699: * okay for namespaces, but wrong for classes.
0700: *
0701: * This procedure search for a class namespace. If the name is
0702: * absolute (i.e., starts with "::"), then that one name is checked,
0703: * and the class is either found or not. But if the name is relative,
0704: * it is sought in the current namespace context and in the global
0705: * context, just like the normal command lookup.
0706: *
0707: * This procedure returns a reference to the desired namespace, or
0708: * null if the namespace was not found.
0709: * ------------------------------------------------------------------------
0710: */
0711:
0712: static Namespace FindClassNamespace(Interp interp, // interpreter containing class
0713: String path) // path name for class
0714: {
0715: Namespace contextNs = Namespace.getCurrentNamespace(interp);
0716: Namespace classNs;
0717: StringBuffer buffer;
0718:
0719: // Look up the namespace. If the name is not absolute, then
0720: // see if it's the current namespace, and try the global
0721: // namespace as well.
0722:
0723: classNs = Namespace.findNamespace(interp, path, null, 0);
0724:
0725: if (classNs == null && contextNs.parent != null
0726: && (!path.startsWith("::"))) {
0727:
0728: if (contextNs.name.equals(path)) {
0729: classNs = contextNs;
0730: } else {
0731: buffer = new StringBuffer(64);
0732: buffer.append("::");
0733: buffer.append(path);
0734:
0735: classNs = Namespace.findNamespace(interp, buffer
0736: .toString(), null, 0);
0737: }
0738: }
0739: return classNs;
0740: }
0741:
0742: /*
0743: * ------------------------------------------------------------------------
0744: * Itcl_HandleClass -> Class.HandleClassCmd.cmdProc
0745: *
0746: * Invoked by Tcl whenever the user issues the command associated with
0747: * a class name. Handles the following syntax:
0748: *
0749: * <className> <objName> ?<args>...?
0750: *
0751: * If arguments are specified, then this procedure creates a new
0752: * object named <objName> in the appropriate class. Note that if
0753: * <objName> contains "#auto", that part is automatically replaced
0754: * by a unique string built from the class name.
0755: * ------------------------------------------------------------------------
0756: */
0757:
0758: static class HandleClassCmd implements CommandWithDispose {
0759: ItclClass cdefn;
0760: boolean release = false;
0761:
0762: HandleClassCmd(ItclClass cdefn) {
0763: this .cdefn = cdefn;
0764: }
0765:
0766: public void disposeCmd() {
0767: if (release == false) {
0768: DestroyClass(cdefn);
0769: } else {
0770: Util.ReleaseData(cdefn);
0771: }
0772: }
0773:
0774: public void cmdProc(Interp interp, // Current interp.
0775: TclObject[] objv) // Args passed to the command.
0776: throws TclException {
0777: StringBuffer unique; // buffer used for unique part of object names
0778: StringBuffer buffer; // buffer used to build object names
0779: String token, objName, start;
0780: TclObject cmdline;
0781: TclObject[] cmdlinev;
0782:
0783: ItclObject newObj;
0784: CallFrame frame;
0785:
0786: // If the command is invoked without an object name, then do nothing.
0787: // This used to support autoloading--that the class name could be
0788: // invoked as a command by itself, prompting the autoloader to
0789: // load the class definition. We retain the behavior here for
0790: // backward-compatibility with earlier releases.
0791:
0792: if (objv.length == 1) {
0793: return;
0794: }
0795:
0796: // If the object name is "::", and if this is an old-style class
0797: // definition, then treat the remaining arguments as a command
0798: // in the class namespace. This used to be the way of invoking
0799: // a class proc, but the new syntax is "class::proc" (without
0800: // spaces).
0801:
0802: token = objv[1].toString();
0803: if (token.equals("::") && (objv.length > 2)) {
0804: if ((cdefn.flags & ItclInt.OLD_STYLE) != 0) {
0805:
0806: frame = ItclAccess.newCallFrame(interp);
0807: Namespace.pushCallFrame(interp, frame,
0808: cdefn.namesp, false);
0809:
0810: cmdline = Util.CreateArgs(interp, null, objv, 2);
0811: cmdlinev = TclList.getElements(interp, cmdline);
0812:
0813: try {
0814: Util.EvalArgs(interp, cmdlinev);
0815: return;
0816: } finally {
0817: Namespace.popCallFrame(interp);
0818: }
0819: }
0820:
0821: // If this is not an old-style class, then return an error
0822: // describing the syntax change.
0823:
0824: throw new TclException(
0825: interp,
0826: "syntax \"class :: proc\" is an anachronism\n"
0827: + "[incr Tcl] no longer supports this syntax.\n"
0828: + "Instead, remove the spaces from your procedure invocations:\n"
0829: + " " + objv[0] + "::" + objv[2]
0830: + " ?args?");
0831: }
0832:
0833: // Otherwise, we have a proper object name. Create a new instance
0834: // with that name. If the name contains "#auto", replace this with
0835: // a uniquely generated string based on the class name.
0836:
0837: buffer = new StringBuffer(64);
0838: objName = null;
0839:
0840: start = token;
0841:
0842: if (start.indexOf("#auto") != -1) {
0843: String prefix;
0844: String suffix;
0845:
0846: if (start.equals("#auto")) {
0847: prefix = null;
0848: suffix = null;
0849: } else if (start.startsWith("#auto")) {
0850: prefix = null;
0851: suffix = start.substring(5);
0852: } else if (start.endsWith("#auto")) {
0853: prefix = start.substring(0, start.length() - 5);
0854: suffix = null;
0855: } else {
0856: int index = start.indexOf("#auto");
0857: prefix = start.substring(0, index);
0858: suffix = start.substring(index + 5);
0859: }
0860:
0861: // Substitute a unique part in for "#auto", and keep
0862: // incrementing a counter until a valid name is found.
0863:
0864: unique = new StringBuffer(64);
0865:
0866: while (true) {
0867: String first = cdefn.name.substring(0, 1)
0868: .toLowerCase();
0869: unique.setLength(0);
0870: unique.append(first);
0871: unique.append(cdefn.name.substring(1));
0872: unique.append(cdefn.unique++);
0873:
0874: buffer.setLength(0);
0875: if (prefix != null) {
0876: buffer.append(prefix);
0877: }
0878: buffer.append(unique);
0879: if (suffix != null) {
0880: buffer.append(suffix);
0881: }
0882:
0883: objName = buffer.toString();
0884:
0885: // Check for any commands with the given name, not just objects.
0886:
0887: if (interp.getCommand(objName) == null)
0888: break; // No command with this name, use it
0889: }
0890: }
0891:
0892: // If "#auto" was not found, then just use object name as-is.
0893:
0894: if (objName == null) {
0895: objName = token;
0896: }
0897:
0898: // Try to create a new object. If successful, return the
0899: // object name as the result of this command.
0900:
0901: cmdline = Util.CreateArgs(interp, null, objv, 2);
0902: cmdlinev = TclList.getElements(interp, cmdline);
0903:
0904: newObj = Objects.CreateObject(interp, objName, cdefn,
0905: cmdlinev);
0906: interp.setResult(objName);
0907: }
0908:
0909: } // end class HandleClassCmd
0910:
0911: /*
0912: * ------------------------------------------------------------------------
0913: * Itcl_ClassCmdResolver -> Class.ClassCmdResolver
0914: *
0915: * Used by the class namespaces to handle name resolution for all
0916: * commands. This procedure looks for references to class methods
0917: * and procs, and returns the WrappedCommand if found. If a command
0918: * is private a TclException will be raised and access to the command
0919: * is denied. If a command is not recognized, this procedure returns
0920: * null and the lookup continues via the normal Tcl name resolution
0921: * rules.
0922: * ------------------------------------------------------------------------
0923: */
0924:
0925: static WrappedCommand ClassCmdResolver(Interp interp, // current interpreter
0926: String name, // name of the command being accessed
0927: Namespace context, // namespace performing the resolution
0928: int flags) // TCL.LEAVE_ERR_MSG => leave error messages
0929: // in interp if anything goes wrong
0930: throws TclException {
0931: ItclClass cdefn = GetClassFromNamespace(context);
0932:
0933: ItclMemberFunc mfunc;
0934: WrappedCommand wcmd;
0935:
0936: boolean isCmdDeleted;
0937:
0938: // If the command is a member function, and if it is
0939: // accessible, return its Tcl command handle.
0940:
0941: mfunc = (ItclMemberFunc) cdefn.resolveCmds.get(name);
0942:
0943: if (mfunc == null) {
0944: return null; // Command not resolved
0945: }
0946:
0947: // For protected/private functions, figure out whether or
0948: // not the function is accessible from the current context.
0949: //
0950: // TRICKY NOTE: Use Itcl_GetTrueNamespace to determine
0951: // the current context. If the current call frame is
0952: // "transparent", this handles it properly.
0953:
0954: if (mfunc.member.protection != Itcl.PUBLIC) {
0955: context = Util.GetTrueNamespace(interp, cdefn.info);
0956:
0957: if (!Util.CanAccessFunc(mfunc, context)) {
0958:
0959: // Throw exception even if TCL.LEAVE_ERR_MSG is zero
0960:
0961: throw new TclException(interp, "can't access \"" + name
0962: + "\": "
0963: + Util.ProtectionStr(mfunc.member.protection)
0964: + " variable");
0965:
0966: // FIXME: The above says variable, but it should be command, right?
0967: // this is likely something that is not tested.
0968: }
0969: }
0970:
0971: // Looks like we found an accessible member function.
0972: //
0973: // TRICKY NOTE: Check to make sure that the command handle
0974: // is still valid. If someone has deleted or renamed the
0975: // command, it may not be. This is just the time to catch
0976: // it--as it is being resolved again by the compiler.
0977:
0978: wcmd = mfunc.w_accessCmd;
0979: isCmdDeleted = wcmd.deleted;
0980:
0981: if (isCmdDeleted) {
0982: // disallow access!
0983:
0984: mfunc.accessCmd = null;
0985: mfunc.w_accessCmd = null;
0986:
0987: // Ignored TCL.LEAVE_ERR_MSG
0988:
0989: throw new TclException(
0990: interp,
0991: "can't access \""
0992: + name
0993: + "\": deleted or redefined\n"
0994: + "(use the \"body\" command to redefine methods/procs)");
0995: }
0996:
0997: return mfunc.w_accessCmd;
0998: }
0999:
1000: /*
1001: * ------------------------------------------------------------------------
1002: * Itcl_ClassVarResolver -> Class.ClassVarResolver
1003: *
1004: * Used by the class namespaces to handle name resolution for runtime
1005: * variable accesses. This procedure looks for references to both
1006: * common variables and instance variables at runtime.
1007: *
1008: * If a variable is found, this procedure returns it. If a particular
1009: * variable is private, this procedure raises a TclException and
1010: * access to the variable is denied. If a variable is not recognized,
1011: * this procedure returns null and lookup continues via the normal
1012: * Tcl name resolution rules.
1013: * ------------------------------------------------------------------------
1014: */
1015:
1016: static Var ClassVarResolver(Interp interp, // current interpreter
1017: String name, // name of the variable being accessed
1018: Namespace context, // namespace performing the resolution
1019: int flags) // TCL.LEAVE_ERR_MSG => leave error messages
1020: // in interp if anything goes wrong
1021: throws TclException {
1022: CallFrame varFrame = ItclAccess.getVarFrame(interp);
1023:
1024: ItclClass cdefn;
1025: ItclObject contextObj;
1026: CallFrame frame;
1027: Var var;
1028: ItclVarLookup vlookup;
1029: HashMap vtable;
1030:
1031: Util.Assert(IsClassNamespace(context),
1032: "IsClassNamespace(context)");
1033: cdefn = GetClassFromNamespace(context);
1034:
1035: // If this is a global variable, handle it in the usual
1036: // Tcl manner.
1037:
1038: if ((flags & TCL.GLOBAL_ONLY) != 0) {
1039: return null;
1040: }
1041:
1042: // See if this is a formal parameter in the current proc scope.
1043: // If so, that variable has precedence. Look it up and return
1044: // it here. This duplicates some of the functionality of
1045: // TclLookupVar, but we return it here (instead of returning
1046: // null) to avoid looking it up again later.
1047:
1048: if (varFrame != null && ItclAccess.isProcCallFrame(varFrame)
1049: && name.indexOf("::") == -1) {
1050:
1051: // Skip "compiled locals" search here.
1052:
1053: // Look in the frame's var hash table.
1054:
1055: vtable = ItclAccess.getVarTable(varFrame);
1056: if (vtable != null) {
1057: var = (Var) vtable.get(name);
1058: if (var != null) {
1059: return var;
1060: }
1061: }
1062: }
1063:
1064: // See if the variable is a known data member and accessible.
1065:
1066: vlookup = (ItclVarLookup) cdefn.resolveVars.get(name);
1067: if (vlookup == null) {
1068: return null;
1069: }
1070: if (!vlookup.accessible) {
1071: return null;
1072: }
1073:
1074: // If this is a common data member, then its variable
1075: // is easy to find. Return it directly.
1076:
1077: if ((vlookup.vdefn.member.flags & ItclInt.COMMON) != 0) {
1078: return vlookup.common;
1079: }
1080:
1081: // If this is an instance variable, then we have to
1082: // find the object context, then index into its data
1083: // array to get the actual variable.
1084:
1085: frame = Migrate.GetCallFrame(interp, 0);
1086:
1087: contextObj = (ItclObject) cdefn.info.contextFrames.get(frame);
1088: if (contextObj == null) {
1089: return null;
1090: }
1091:
1092: // TRICKY NOTE: We've resolved the variable in the current
1093: // class context, but we must also be careful to get its
1094: // index from the most-specific class context. Variables
1095: // are arranged differently depending on which class
1096: // constructed the object.
1097:
1098: if (contextObj.classDefn != vlookup.vdefn.member.classDefn) {
1099: ItclVarLookup tmp = (ItclVarLookup) contextObj.classDefn.resolveVars
1100: .get(vlookup.vdefn.member.fullname);
1101: if (tmp != null) {
1102: vlookup = tmp;
1103: }
1104: }
1105: return contextObj.data[vlookup.index];
1106: }
1107:
1108: // Note: Itcl_ClassCompiledVarResolver not ported
1109: // Note: ItclClassRuntimeVarResolver not ported
1110:
1111: // Helper class that implements var and cmd resolver
1112: // for a namespace.
1113:
1114: static class ClassResolverImpl implements Resolver {
1115: public WrappedCommand resolveCmd(Interp interp, // The current interpreter.
1116: String name, // Command name to resolve.
1117: Namespace context, // The namespace to look in.
1118: int flags) // 0 or TCL.LEAVE_ERR_MSG.
1119: throws TclException // Tcl exceptions are thrown for Tcl errors.
1120: {
1121: return Class.ClassCmdResolver(interp, name, context, flags);
1122: }
1123:
1124: public Var resolveVar(Interp interp, // The current interpreter.
1125: String name, // Variable name to resolve.
1126: Namespace context, // The namespace to look in.
1127: int flags) // 0 or TCL.LEAVE_ERR_MSG.
1128: throws TclException // Tcl exceptions are thrown for Tcl errors.
1129: {
1130: return Class.ClassVarResolver(interp, name, context, flags);
1131: }
1132: }
1133:
1134: /*
1135: * ------------------------------------------------------------------------
1136: * Itcl_BuildVirtualTables -> Class.BuildVirtualTables
1137: *
1138: * Invoked whenever the class heritage changes or members are added or
1139: * removed from a class definition to rebuild the member lookup
1140: * tables. There are two tables:
1141: *
1142: * METHODS: resolveCmds
1143: * Used primarily in Itcl_ClassCmdResolver() to resolve all
1144: * command references in a namespace.
1145: *
1146: * DATA MEMBERS: resolveVars
1147: * Used primarily in Itcl_ClassVarResolver() to quickly resolve
1148: * variable references in each class scope.
1149: *
1150: * These tables store every possible name for each command/variable
1151: * (member, class::member, namesp::class::member, etc.). Members
1152: * in a derived class may shadow members with the same name in a
1153: * base class. In that case, the simple name in the resolution
1154: * table will point to the most-specific member.
1155: * ------------------------------------------------------------------------
1156: */
1157:
1158: static void BuildVirtualTables(ItclClass cdefn) // class definition being updated
1159: {
1160: ItclVarLookup vlookup;
1161: ItclVarDefn vdefn;
1162: ItclMemberFunc mfunc;
1163: ItclHierIter hier;
1164: ItclClass cd;
1165: Namespace ns;
1166: StringBuffer buffer, buffer2;
1167: boolean newEntry;
1168: String key;
1169:
1170: buffer = new StringBuffer(64);
1171: buffer2 = new StringBuffer(64);
1172:
1173: // Clear the variable resolution table.
1174:
1175: for (Iterator iter = cdefn.resolveVars.entrySet().iterator(); iter
1176: .hasNext();) {
1177: Map.Entry entry = (Map.Entry) iter.next();
1178: vlookup = (ItclVarLookup) entry.getValue();
1179: if (--vlookup.usage == 0) {
1180: // ckfree(vlookup);
1181: }
1182: }
1183:
1184: cdefn.resolveVars.clear();
1185: cdefn.resolveVars = new HashMap();
1186: cdefn.numInstanceVars = 0;
1187:
1188: // Set aside the first object-specific slot for the built-in
1189: // "this" variable. Only allocate one of these, even though
1190: // there is a definition for "this" in each class scope.
1191:
1192: cdefn.numInstanceVars++;
1193:
1194: // Scan through all classes in the hierarchy, from most to
1195: // least specific. Add a lookup entry for each variable
1196: // into the table.
1197:
1198: hier = new ItclHierIter();
1199: Class.InitHierIter(hier, cdefn);
1200: cd = Class.AdvanceHierIter(hier);
1201: while (cd != null) {
1202: for (Iterator iter = cd.variables.entrySet().iterator(); iter
1203: .hasNext();) {
1204: Map.Entry entry = (Map.Entry) iter.next();
1205: key = (String) entry.getKey();
1206: vdefn = (ItclVarDefn) entry.getValue();
1207:
1208: vlookup = new ItclVarLookup();
1209: vlookup.vdefn = vdefn;
1210: vlookup.usage = 0;
1211: vlookup.leastQualName = null;
1212:
1213: // If this variable is PRIVATE to another class scope,
1214: // then mark it as "inaccessible".
1215:
1216: vlookup.accessible = (vdefn.member.protection != Itcl.PRIVATE || vdefn.member.classDefn == cdefn);
1217:
1218: // If this is a common variable, then keep a reference to
1219: // the variable directly. Otherwise, keep an index into
1220: // the object's variable table.
1221:
1222: if ((vdefn.member.flags & ItclInt.COMMON) != 0) {
1223: ns = cd.namesp;
1224: vlookup.common = (Var) ns.varTable
1225: .get(vdefn.member.name);
1226: Util.Assert(vlookup.common != null,
1227: "vlookup.common != null");
1228: } else {
1229: // If this is a reference to the built-in "this"
1230: // variable, then its index is "0". Otherwise,
1231: // add another slot to the end of the table.
1232:
1233: if ((vdefn.member.flags & ItclInt.THIS_VAR) != 0) {
1234: vlookup.index = 0;
1235: } else {
1236: vlookup.index = cdefn.numInstanceVars++;
1237: }
1238: }
1239:
1240: // Create all possible names for this variable and enter
1241: // them into the variable resolution table:
1242: // var
1243: // class::var
1244: // namesp1::class::var
1245: // namesp2::namesp1::class::var
1246: // ...
1247:
1248: buffer.setLength(0);
1249: buffer.append(vdefn.member.name);
1250: ns = cd.namesp;
1251:
1252: while (true) {
1253: key = buffer.toString();
1254: newEntry = (cdefn.resolveVars.get(key) == null);
1255:
1256: if (newEntry) {
1257: cdefn.resolveVars.put(key, vlookup);
1258: vlookup.usage++;
1259:
1260: if (vlookup.leastQualName == null) {
1261: vlookup.leastQualName = key;
1262: }
1263: }
1264:
1265: if (ns == null) {
1266: break;
1267: }
1268: buffer2.setLength(0);
1269: buffer2.append(key);
1270: buffer.setLength(0);
1271: buffer.append(ns.name);
1272: buffer.append("::");
1273: buffer.append(buffer2.toString());
1274:
1275: ns = ns.parent;
1276: }
1277:
1278: // If this record is not needed, free it now.
1279:
1280: if (vlookup.usage == 0) {
1281: //ckfree(vlookup);
1282: }
1283: }
1284: cd = Class.AdvanceHierIter(hier);
1285: }
1286: Class.DeleteHierIter(hier);
1287:
1288: // Clear the command resolution table.
1289:
1290: cdefn.resolveCmds.clear();
1291: cdefn.resolveCmds = new HashMap();
1292:
1293: // Scan through all classes in the hierarchy, from most to
1294: // least specific. Look for the first (most-specific) definition
1295: // of each member function, and enter it into the table.
1296:
1297: Class.InitHierIter(hier, cdefn);
1298: cd = Class.AdvanceHierIter(hier);
1299: while (cd != null) {
1300: for (Iterator iter = cd.functions.entrySet().iterator(); iter
1301: .hasNext();) {
1302: Map.Entry entry = (Map.Entry) iter.next();
1303: key = (String) entry.getKey();
1304: mfunc = (ItclMemberFunc) entry.getValue();
1305:
1306: // Create all possible names for this function and enter
1307: // them into the command resolution table:
1308: // func
1309: // class::func
1310: // namesp1::class::func
1311: // namesp2::namesp1::class::func
1312: // ...
1313:
1314: buffer.setLength(0);
1315: buffer.append(mfunc.member.name);
1316: ns = cd.namesp;
1317:
1318: while (true) {
1319: key = buffer.toString();
1320: newEntry = (cdefn.resolveCmds.get(key) == null);
1321:
1322: if (newEntry) {
1323: cdefn.resolveCmds.put(key, mfunc);
1324: }
1325:
1326: if (ns == null) {
1327: break;
1328: }
1329: buffer2.setLength(0);
1330: buffer2.append(key);
1331: buffer.setLength(0);
1332: buffer.append(ns.name);
1333: buffer.append("::");
1334: buffer.append(buffer2.toString());
1335:
1336: ns = ns.parent;
1337: }
1338: }
1339: cd = Class.AdvanceHierIter(hier);
1340: }
1341: Class.DeleteHierIter(hier);
1342: }
1343:
1344: /*
1345: * ------------------------------------------------------------------------
1346: * Itcl_CreateVarDefn -> Class.CreateVarDefn
1347: *
1348: * Creates a new class variable definition. If this is a public
1349: * variable, it may have a bit of "config" code that is used to
1350: * update the object whenever the variable is modified via the
1351: * built-in "configure" method.
1352: *
1353: * Raises a TclException if anything goes wrong. Otherwise, returns
1354: * a reference to a new variable definition.
1355: * ------------------------------------------------------------------------
1356: */
1357:
1358: static ItclVarDefn CreateVarDefn(Interp interp, // interpreter managing this transaction
1359: ItclClass cdefn, // class containing this variable
1360: String name, // variable name
1361: String init, // initial value
1362: String config) // code invoked when variable is configured
1363: throws TclException {
1364: boolean newEntry;
1365: ItclVarDefn vdefn;
1366: ItclMemberCode mcode;
1367:
1368: // Add this variable to the variable table for the class.
1369: // Make sure that the variable name does not already exist.
1370:
1371: newEntry = (cdefn.variables.containsKey(name) == false);
1372:
1373: if (!newEntry) {
1374: throw new TclException(interp, "variable name \"" + name
1375: + "\" already defined in class \"" + cdefn.fullname
1376: + "\"");
1377: }
1378:
1379: // If this variable has some "config" code, try to capture
1380: // its implementation.
1381:
1382: if (config != null) {
1383: mcode = Methods.CreateMemberCode(interp, cdefn, null,
1384: config);
1385:
1386: Util.PreserveData(mcode);
1387: //Util.EventuallyFree(mcode, Itcl_DeleteMemberCode);
1388: } else {
1389: mcode = null;
1390: }
1391:
1392: // If everything looks good, create the variable definition.
1393:
1394: vdefn = new ItclVarDefn();
1395: vdefn.member = CreateMember(interp, cdefn, name);
1396: vdefn.member.code = mcode;
1397:
1398: if (vdefn.member.protection == Itcl.DEFAULT_PROTECT) {
1399: vdefn.member.protection = Itcl.PROTECTED;
1400: }
1401:
1402: vdefn.init = init;
1403:
1404: cdefn.variables.put(name, vdefn);
1405:
1406: return vdefn;
1407: }
1408:
1409: /*
1410: * ------------------------------------------------------------------------
1411: * Itcl_DeleteVarDefn -> Class.DeleteVarDefn
1412: *
1413: * Destroys a variable definition created by CreateVarDefn(),
1414: * freeing all resources associated with it.
1415: * ------------------------------------------------------------------------
1416: */
1417:
1418: static void DeleteVarDefn(ItclVarDefn vdefn) // variable definition to be destroyed
1419: {
1420: DeleteMember(vdefn.member);
1421: vdefn.init = null;
1422: }
1423:
1424: /*
1425: * ------------------------------------------------------------------------
1426: * Itcl_GetCommonVar -> Class.GetCommonVar
1427: *
1428: * Returns the current value for a common class variable. The member
1429: * name is interpreted with respect to the given class scope. That
1430: * scope is installed as the current context before querying the
1431: * variable. This by-passes the protection level in case the variable
1432: * is "private".
1433: *
1434: * If successful, this procedure returns a pointer to a string value
1435: * which remains alive until the variable changes it value. If
1436: * anything goes wrong, this returns null.
1437: * ------------------------------------------------------------------------
1438: */
1439:
1440: static String GetCommonVar(Interp interp, // current interpreter
1441: String name, // name of desired instance variable
1442: ItclClass contextClass) // name is interpreted in this scope
1443: {
1444: CallFrame frame;
1445:
1446: // Activate the namespace for the given class. That installs
1447: // the appropriate name resolution rules and by-passes any
1448: // security restrictions.
1449:
1450: frame = ItclAccess.newCallFrame(interp);
1451: Namespace.pushCallFrame(interp, frame, contextClass.namesp,
1452: false);
1453:
1454: try {
1455: TclObject val = interp.getVar(name, 0);
1456: if (val == null) {
1457: return null;
1458: } else {
1459: return val.toString();
1460: }
1461: } catch (TclException ex) {
1462: return null;
1463: } finally {
1464: Namespace.popCallFrame(interp);
1465: }
1466: }
1467:
1468: /*
1469: * ------------------------------------------------------------------------
1470: * Itcl_CreateMember -> Class.CreateMember
1471: *
1472: * Creates the data record representing a class member. This is the
1473: * generic representation for a data member or member function.
1474: * Returns a reference to the new representation.
1475: * ------------------------------------------------------------------------
1476: */
1477:
1478: static ItclMember CreateMember(Interp interp, // interpreter managing this action
1479: ItclClass cdefn, // class definition
1480: String name) // name of new member
1481: {
1482: ItclMember mem;
1483:
1484: // Allocate the memory for a class member and fill in values.
1485:
1486: mem = new ItclMember();
1487: mem.interp = interp;
1488: mem.classDefn = cdefn;
1489: mem.flags = 0;
1490: mem.protection = Util.Protection(interp, 0);
1491: mem.code = null;
1492:
1493: StringBuffer buffer = new StringBuffer(64);
1494: buffer.append(cdefn.fullname);
1495: buffer.append("::");
1496: buffer.append(name);
1497: mem.fullname = buffer.toString();
1498:
1499: mem.name = name;
1500:
1501: return mem;
1502: }
1503:
1504: /*
1505: * ------------------------------------------------------------------------
1506: * Itcl_DeleteMember -> Class.DeleteMember
1507: *
1508: * Destroys all data associated with the given member function definition.
1509: * Usually invoked by the interpreter when a member function is deleted.
1510: * ------------------------------------------------------------------------
1511: */
1512:
1513: static void DeleteMember(ItclMember mem) // pointer to member function definition
1514: {
1515: if (mem != null) {
1516: mem.name = null;
1517: mem.fullname = null;
1518:
1519: if (mem.code != null) {
1520: Util.ReleaseData(mem.code);
1521: }
1522: mem.code = null;
1523: }
1524: }
1525:
1526: /*
1527: * ------------------------------------------------------------------------
1528: * Itcl_InitHierIter -> Class.InitHierIter
1529: *
1530: * Initializes an iterator for traversing the hierarchy of the given
1531: * class. Subsequent calls to Itcl_AdvanceHierIter() will return
1532: * the base classes in order from most-to-least specific.
1533: * ------------------------------------------------------------------------
1534: */
1535:
1536: static void InitHierIter(ItclHierIter iter, // iterator used for traversal
1537: ItclClass cdefn) // class definition for start of traversal
1538: {
1539: iter.stack = new Itcl_Stack();
1540: Util.InitStack(iter.stack);
1541: Util.PushStack(cdefn, iter.stack);
1542: iter.current = cdefn;
1543: }
1544:
1545: /*
1546: * ------------------------------------------------------------------------
1547: * Itcl_DeleteHierIter -> Class.DeleteHierIter
1548: *
1549: * Destroys an iterator for traversing class hierarchies, freeing
1550: * all memory associated with it.
1551: * ------------------------------------------------------------------------
1552: */
1553:
1554: static void DeleteHierIter(ItclHierIter iter) // iterator used for traversal
1555: {
1556: Util.DeleteStack(iter.stack);
1557: iter.current = null;
1558: }
1559:
1560: /*
1561: * ------------------------------------------------------------------------
1562: * Itcl_AdvanceHierIter -> Class.AdvanceHierIter
1563: *
1564: * Moves a class hierarchy iterator forward to the next base class.
1565: * Returns a pointer to the current class definition, or null when
1566: * the end of the hierarchy has been reached.
1567: * ------------------------------------------------------------------------
1568: */
1569:
1570: static ItclClass AdvanceHierIter(ItclHierIter iter) // iterator used for traversal
1571: {
1572: Itcl_ListElem elem;
1573: ItclClass cd;
1574:
1575: iter.current = (ItclClass) Util.PopStack(iter.stack);
1576:
1577: // Push classes onto the stack in reverse order, so that
1578: // they will be popped off in the proper order.
1579:
1580: if (iter.current != null) {
1581: cd = (ItclClass) iter.current;
1582: elem = Util.LastListElem(cd.bases);
1583: while (elem != null) {
1584: Util.PushStack(Util.GetListValue(elem), iter.stack);
1585: elem = Util.PrevListElem(elem);
1586: }
1587: }
1588: return iter.current;
1589: }
1590:
1591: } // end Class Class
|