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 built-in class methods, including the
0016: * "isa" method (to query hierarchy info) and the "info" method
0017: * (to query class/object data).
0018: *
0019: * ========================================================================
0020: * AUTHOR: Michael J. McLennan
0021: * Bell Labs Innovations for Lucent Technologies
0022: * mmclennan@lucent.com
0023: * http://www.tcltk.com/itcl
0024: *
0025: * RCS: $Id: BiCmds.java,v 1.3 2006/01/26 19:49:18 mdejong Exp $
0026: * ========================================================================
0027: * Copyright (c) 1993-1998 Lucent Technologies, Inc.
0028: * ------------------------------------------------------------------------
0029: * See the file "license.itcl" for information on usage and redistribution
0030: * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
0031: */
0032:
0033: package itcl.lang;
0034:
0035: import tcl.lang.*;
0036:
0037: import java.util.*;
0038:
0039: //
0040: // Standard list of built-in methods for all objects.
0041: //
0042: class BiMethod {
0043: String name; // method name
0044: String usage; // string describing usage
0045: String registration; // registration name for Java command
0046: Command proc; // implementation Java command
0047:
0048: BiMethod(String name, String usage, String registration,
0049: Command proc) {
0050: this .name = name;
0051: this .usage = usage;
0052: this .registration = registration;
0053: this .proc = proc;
0054: }
0055: }
0056:
0057: class BiCmds {
0058:
0059: private static BiMethod[] BiMethodList = {
0060: new BiMethod("cget", "-option", "@itcl-builtin-cget",
0061: new BiCgetCmd()),
0062: new BiMethod("configure",
0063: "?-option? ?value -option value...?",
0064: "@itcl-builtin-configure", new BiConfigureCmd()),
0065: new BiMethod("isa", "className", "@itcl-builtin-isa",
0066: new BiIsaCmd()) };
0067:
0068: private static final int BiMethodListLen = BiMethodList.length;
0069:
0070: /*
0071: * ------------------------------------------------------------------------
0072: * Itcl_BiInit -> BiCmds.BiInit
0073: *
0074: * Creates a namespace full of built-in methods/procs for [incr Tcl]
0075: * classes. This includes things like the "isa" method and "info"
0076: * for querying class info. Usually invoked by Itcl_Init() when
0077: * [incr Tcl] is first installed into an interpreter.
0078: *
0079: * Will raise a TclException to indicate failure.
0080: * ------------------------------------------------------------------------
0081: */
0082:
0083: public static void BiInit(Interp interp) // current interpreter
0084: throws TclException {
0085: Namespace itclBiNs;
0086:
0087: // Declare all of the built-in methods as Java procedures.
0088:
0089: for (int i = 0; i < BiMethodListLen; i++) {
0090: Linkage.RegisterObjC(interp, BiMethodList[i].registration
0091: .substring(1), BiMethodList[i].proc);
0092: }
0093:
0094: // Create the "::itcl::builtin" namespace for built-in class
0095: // commands. These commands are imported into each class
0096: // just before the class definition is parsed.
0097:
0098: interp
0099: .createCommand("::itcl::builtin::chain",
0100: new BiChainCmd());
0101:
0102: Ensemble.CreateEnsemble(interp, "::itcl::builtin::info");
0103:
0104: Ensemble.AddEnsemblePart(interp, "::itcl::builtin::info",
0105: "class", "", new BiInfoClassCmd());
0106:
0107: Ensemble.AddEnsemblePart(interp, "::itcl::builtin::info",
0108: "inherit", "", new BiInfoInheritCmd());
0109:
0110: Ensemble.AddEnsemblePart(interp, "::itcl::builtin::info",
0111: "heritage", "", new BiInfoHeritageCmd());
0112:
0113: Ensemble.AddEnsemblePart(interp, "::itcl::builtin::info",
0114: "function",
0115: "?name? ?-protection? ?-type? ?-name? ?-args? ?-body?",
0116: new BiInfoFunctionCmd());
0117:
0118: Ensemble
0119: .AddEnsemblePart(
0120: interp,
0121: "::itcl::builtin::info",
0122: "variable",
0123: "?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config?",
0124: new BiInfoVariableCmd());
0125:
0126: Ensemble.AddEnsemblePart(interp, "::itcl::builtin::info",
0127: "args", "procname", new BiInfoArgsCmd());
0128:
0129: Ensemble.AddEnsemblePart(interp, "::itcl::builtin::info",
0130: "body", "procname", new BiInfoBodyCmd());
0131:
0132: // Add an error handler to support all of the usual inquiries
0133: // for the "info" command in the global namespace.
0134:
0135: Ensemble.AddEnsemblePart(interp, "::itcl::builtin::info",
0136: "@error", "", new DefaultInfoCmd());
0137:
0138: // Export all commands in the built-in namespace so we can
0139: // import them later on.
0140:
0141: itclBiNs = Namespace.findNamespace(interp, "::itcl::builtin",
0142: null, TCL.LEAVE_ERR_MSG);
0143: if (itclBiNs == null) {
0144: throw new TclException(interp, interp.getResult()
0145: .toString());
0146: }
0147:
0148: Namespace.exportList(interp, itclBiNs, "*", true);
0149: }
0150:
0151: /*
0152: * ------------------------------------------------------------------------
0153: * Itcl_InstallBiMethods -> BiCmds.InstallBiMethods
0154: *
0155: * Invoked when a class is first created, just after the class
0156: * definition has been parsed, to add definitions for built-in
0157: * methods to the class. If a method already exists in the class
0158: * with the same name as the built-in, then the built-in is skipped.
0159: * Otherwise, a method definition for the built-in method is added.
0160: *
0161: * Raises a TclException if anything goes wrong.
0162: * ------------------------------------------------------------------------
0163: */
0164:
0165: public static void InstallBiMethods(Interp interp, // current interpreter
0166: ItclClass cdefn) // class definition to be updated
0167: throws TclException {
0168: ItclHierIter hier;
0169: ItclClass cd;
0170: boolean foundMatch = false;
0171:
0172: // Scan through all of the built-in methods and see if
0173: // that method already exists in the class. If not, add
0174: // it in.
0175: //
0176: // TRICKY NOTE: The virtual tables haven't been built yet,
0177: // so look for existing methods the hard way--by scanning
0178: // through all classes.
0179:
0180: for (int i = 0; i < BiMethodListLen; i++) {
0181: hier = new ItclHierIter();
0182: Class.InitHierIter(hier, cdefn);
0183: cd = Class.AdvanceHierIter(hier);
0184: while (cd != null) {
0185: if (cd.functions.containsKey(BiMethodList[i].name)) {
0186: foundMatch = true;
0187: break;
0188: }
0189: cd = Class.AdvanceHierIter(hier);
0190: }
0191: Class.DeleteHierIter(hier);
0192:
0193: if (!foundMatch) {
0194: Methods.CreateMethod(interp, cdefn,
0195: BiMethodList[i].name, BiMethodList[i].usage,
0196: BiMethodList[i].registration);
0197: }
0198: }
0199: }
0200:
0201: /*
0202: * ------------------------------------------------------------------------
0203: * Itcl_BiIsaCmd -> BiCmds.BiIsaCmd.cmdProc
0204: *
0205: * Invoked whenever the user issues the "isa" method for an object.
0206: * Handles the following syntax:
0207: *
0208: * <objName> isa <className>
0209: *
0210: * Checks to see if the object has the given <className> anywhere
0211: * in its heritage. Set the interpreter result to 1 if so,
0212: * and to 0 otherwise.
0213: * ------------------------------------------------------------------------
0214: */
0215:
0216: static class BiIsaCmd implements Command {
0217: public void cmdProc(Interp interp, // Current interp.
0218: TclObject[] objv) // Args passed to the command.
0219: throws TclException {
0220: ItclClass contextClass, cdefn;
0221: ItclObject contextObj;
0222: String token;
0223:
0224: // Make sure that this command is being invoked in the proper
0225: // context.
0226:
0227: Methods.GetContextResult gcr = Methods.GetContext(interp);
0228: contextClass = gcr.cdefn;
0229: contextObj = gcr.odefn;
0230:
0231: if (contextObj == null) {
0232: throw new TclException(interp,
0233: "improper usage: should be \"object isa className\"");
0234: }
0235:
0236: if (objv.length != 2) {
0237: token = objv[0].toString();
0238: throw new TclException(interp,
0239: "wrong # args: should be \"object " + token
0240: + " className\"");
0241: }
0242:
0243: // Look for the requested class. If it is not found, then
0244: // try to autoload it. If it absolutely cannot be found,
0245: // signal an error.
0246:
0247: token = objv[1].toString();
0248: cdefn = Class.FindClass(interp, token, true);
0249: if (cdefn == null) {
0250: throw new TclException(interp, interp.getResult()
0251: .toString());
0252: }
0253:
0254: if (Objects.ObjectIsa(contextObj, cdefn)) {
0255: interp.setResult(true);
0256: } else {
0257: interp.setResult(false);
0258: }
0259: }
0260: } // end class BiIsaCmd
0261:
0262: /*
0263: * ------------------------------------------------------------------------
0264: * Itcl_BiConfigureCmd -> BiCmds.BiConfigureCmd.cmdProc
0265: *
0266: * Invoked whenever the user issues the "configure" method for an object.
0267: * Handles the following syntax:
0268: *
0269: * <objName> configure ?-<option>? ?<value> -<option> <value>...?
0270: *
0271: * Allows access to public variables as if they were configuration
0272: * options. With no arguments, this command returns the current
0273: * list of public variable options. If -<option> is specified,
0274: * this returns the information for just one option:
0275: *
0276: * -<optionName> <initVal> <currentVal>
0277: *
0278: * Otherwise, the list of arguments is parsed, and values are
0279: * assigned to the various public variable options. When each
0280: * option changes, a big of "config" code associated with the option
0281: * is executed, to bring the object up to date.
0282: * ------------------------------------------------------------------------
0283: */
0284:
0285: static class BiConfigureCmd implements Command {
0286: public void cmdProc(Interp interp, // Current interp.
0287: TclObject[] objv) // Args passed to the command.
0288: throws TclException {
0289: ItclClass contextClass;
0290: ItclObject contextObj;
0291:
0292: String lastval;
0293: String token;
0294: ItclClass cd;
0295: ItclVarDefn vdefn;
0296: ItclVarLookup vlookup;
0297: ItclMember member;
0298: ItclMemberCode mcode;
0299: ItclHierIter hier;
0300: TclObject result, obj;
0301: StringBuffer buffer;
0302: ItclContext context;
0303: CallFrame oldFrame, uplevelFrame;
0304:
0305: // Make sure that this command is being invoked in the proper
0306: // context.
0307:
0308: Methods.GetContextResult gcr = Methods.GetContext(interp);
0309: contextClass = gcr.cdefn;
0310: contextObj = gcr.odefn;
0311:
0312: if (contextObj == null) {
0313: throw new TclException(
0314: interp,
0315: "improper usage: should be "
0316: + "\"object configure ?-option? ?value -option value...?\"");
0317: }
0318:
0319: // BE CAREFUL: work in the virtual scope!
0320:
0321: contextClass = contextObj.classDefn;
0322:
0323: // HANDLE: configure
0324:
0325: if (objv.length == 1) {
0326: result = TclList.newInstance();
0327:
0328: hier = new ItclHierIter();
0329: Class.InitHierIter(hier, contextClass);
0330: while ((cd = Class.AdvanceHierIter(hier)) != null) {
0331: for (Iterator iter = cd.variables.entrySet()
0332: .iterator(); iter.hasNext();) {
0333: Map.Entry entry = (Map.Entry) iter.next();
0334: String key = (String) entry.getKey();
0335: vdefn = (ItclVarDefn) entry.getValue();
0336:
0337: if (vdefn.member.protection == Itcl.PUBLIC) {
0338: obj = ReportPublicOpt(interp, vdefn,
0339: contextObj);
0340: TclList.append(interp, result, obj);
0341: }
0342: }
0343: }
0344: Class.DeleteHierIter(hier);
0345:
0346: interp.setResult(result);
0347: return;
0348: }
0349:
0350: // HANDLE: configure -option
0351:
0352: else if (objv.length == 2) {
0353: token = objv[1].toString();
0354: if (token.length() < 2 || token.charAt(0) != '-') {
0355: throw new TclException(
0356: interp,
0357: "improper usage: should be "
0358: + "\"object configure ?-option? ?value -option value...?\"");
0359: }
0360:
0361: vlookup = (ItclVarLookup) contextClass.resolveVars
0362: .get(token.substring(1));
0363: if (vlookup != null) {
0364: if (vlookup.vdefn.member.protection != Itcl.PUBLIC) {
0365: vlookup = null;
0366: }
0367: }
0368:
0369: if (vlookup == null) {
0370: throw new TclException(interp, "unknown option \""
0371: + token + "\"");
0372: }
0373:
0374: result = ReportPublicOpt(interp, vlookup.vdefn,
0375: contextObj);
0376: interp.setResult(result);
0377: return;
0378: }
0379:
0380: // HANDLE: configure -option value -option value...
0381: //
0382: // Be careful to work in the virtual scope. If this "configure"
0383: // method was defined in a base class, the current namespace
0384: // (from Itcl_ExecMethod()) will be that base class. Activate
0385: // the derived class namespace here, so that instance variables
0386: // are accessed properly.
0387:
0388: context = new ItclContext(interp);
0389: Methods.PushContext(interp, null, contextObj.classDefn,
0390: contextObj, context);
0391:
0392: try {
0393:
0394: buffer = new StringBuffer(64);
0395:
0396: for (int i = 1; i < objv.length; i += 2) {
0397: vlookup = null;
0398: token = objv[i].toString();
0399: if (token.length() >= 2 && token.charAt(0) == '-') {
0400: vlookup = (ItclVarLookup) contextClass.resolveVars
0401: .get(token.substring(1));
0402: }
0403:
0404: if (vlookup == null
0405: || vlookup.vdefn.member.protection != Itcl.PUBLIC) {
0406: throw new TclException(interp,
0407: "unknown option \"" + token + "\"");
0408: }
0409: if (i == objv.length - 1) {
0410: throw new TclException(interp, "value for \""
0411: + token + "\" missing");
0412: }
0413:
0414: member = vlookup.vdefn.member;
0415: TclObject tmp = interp.getVar(member.fullname, 0);
0416: buffer.setLength(0);
0417: if (tmp != null) {
0418: lastval = tmp.toString();
0419: buffer.append(lastval);
0420: }
0421:
0422: token = objv[i + 1].toString();
0423:
0424: try {
0425: interp.setVar(member.fullname, TclString
0426: .newInstance(token), 0);
0427: } catch (TclException ex) {
0428: interp
0429: .addErrorInfo("\n (error in configuration of public variable \""
0430: + member.fullname + "\")");
0431: throw ex;
0432: }
0433:
0434: // If this variable has some "config" code, invoke it now.
0435: //
0436: // TRICKY NOTE: Be careful to evaluate the code one level
0437: // up in the call stack, so that it's executed in the
0438: // calling context, and not in the context that we've
0439: // set up for public variable access.
0440:
0441: mcode = member.code;
0442: if (mcode != null
0443: && Methods.IsMemberCodeImplemented(mcode)) {
0444: String body = mcode.body;
0445:
0446: uplevelFrame = Migrate.GetCallFrame(interp, 1);
0447: oldFrame = Migrate.ActivateCallFrame(interp,
0448: uplevelFrame);
0449:
0450: try {
0451: Methods.EvalMemberCode(interp, null,
0452: member, contextObj, null);
0453: interp.resetResult();
0454: } catch (TclException ex) {
0455: String msg = "\n (error in configuration of public variable \""
0456: + member.fullname + "\")";
0457: interp.addErrorInfo(msg);
0458:
0459: interp.setVar(member.fullname, TclString
0460: .newInstance(buffer.toString()), 0);
0461:
0462: throw ex;
0463: } finally {
0464: Migrate.ActivateCallFrame(interp, oldFrame);
0465: }
0466: }
0467: }
0468:
0469: } finally {
0470: Methods.PopContext(interp, context);
0471: }
0472: }
0473: } // end class BiConfigureCmd
0474:
0475: /*
0476: * ------------------------------------------------------------------------
0477: * Itcl_BiCgetCmd -> BiCmds.BiCgetCmd.cmdProc
0478: *
0479: * Invoked whenever the user issues the "cget" method for an object.
0480: * Handles the following syntax:
0481: *
0482: * <objName> cget -<option>
0483: *
0484: * Allows access to public variables as if they were configuration
0485: * options. Mimics the behavior of the usual "cget" method for
0486: * Tk widgets. Returns the current value of the public variable
0487: * with name <option>.
0488: * ------------------------------------------------------------------------
0489: */
0490:
0491: static class BiCgetCmd implements Command {
0492: public void cmdProc(Interp interp, // Current interp.
0493: TclObject[] objv) // Args passed to the command.
0494: throws TclException {
0495: ItclClass contextClass;
0496: ItclObject contextObj;
0497:
0498: String name, val;
0499: ItclVarLookup vlookup;
0500:
0501: // Make sure that this command is being invoked in the proper
0502: // context.
0503:
0504: Methods.GetContextResult gcr = Methods.GetContext(interp);
0505: contextClass = gcr.cdefn;
0506: contextObj = gcr.odefn;
0507:
0508: if (contextObj == null || objv.length != 2) {
0509: throw new TclException(interp,
0510: "improper usage: should be \"object cget -option\"");
0511: }
0512:
0513: // BE CAREFUL: work in the virtual scope!
0514:
0515: contextClass = contextObj.classDefn;
0516:
0517: name = objv[1].toString();
0518:
0519: vlookup = null;
0520: vlookup = (ItclVarLookup) contextClass.resolveVars.get(name
0521: .substring(1));
0522:
0523: if (vlookup == null
0524: || vlookup.vdefn.member.protection != Itcl.PUBLIC) {
0525: throw new TclException(interp, "unknown option \""
0526: + name + "\"");
0527: }
0528:
0529: val = Objects.GetInstanceVar(interp,
0530: vlookup.vdefn.member.fullname, contextObj,
0531: contextObj.classDefn);
0532:
0533: if (val != null) {
0534: interp.setResult(val);
0535: } else {
0536: interp.setResult("<undefined>");
0537: }
0538: }
0539: } // end class BiCgetCmd
0540:
0541: /*
0542: * ------------------------------------------------------------------------
0543: * ItclReportPublicOpt -> BiCmds.ReportPublicOpt
0544: *
0545: * Returns information about a public variable formatted as a
0546: * configuration option:
0547: *
0548: * -<varName> <initVal> <currentVal>
0549: *
0550: * Used by Itcl_BiConfigureCmd() to report configuration options.
0551: * Returns a TclObject containing the information.
0552: * ------------------------------------------------------------------------
0553: */
0554:
0555: private static TclObject ReportPublicOpt(Interp interp, // interpreter containing the object
0556: ItclVarDefn vdefn, // public variable to be reported
0557: ItclObject contextObj) // object containing this variable
0558: {
0559: String val;
0560: ItclClass cdefn;
0561: ItclVarLookup vlookup;
0562: StringBuffer optName;
0563: TclObject list, obj;
0564:
0565: list = TclList.newInstance();
0566:
0567: // Determine how the option name should be reported.
0568: // If the simple name can be used to find it in the virtual
0569: // data table, then use the simple name. Otherwise, this
0570: // is a shadowed variable; use the full name.
0571:
0572: optName = new StringBuffer(64);
0573: optName.append("-");
0574:
0575: cdefn = contextObj.classDefn;
0576: vlookup = (ItclVarLookup) cdefn.resolveVars
0577: .get(vdefn.member.fullname);
0578: Util.Assert(vlookup != null, "vlookup != null");
0579: optName.append(vlookup.leastQualName);
0580:
0581: obj = TclString.newInstance(optName.toString());
0582: try {
0583: TclList.append(interp, list, obj);
0584: } catch (TclException ex) {
0585: throw new TclRuntimeError("unexpected TclException "
0586: + ex.getMessage());
0587: }
0588: optName = null;
0589:
0590: if (vdefn.init != null) {
0591: obj = TclString.newInstance(vdefn.init);
0592: } else {
0593: obj = TclString.newInstance("<undefined>");
0594: }
0595: try {
0596: TclList.append(interp, list, obj);
0597: } catch (TclException ex) {
0598: throw new TclRuntimeError("unexpected TclException "
0599: + ex.getMessage());
0600: }
0601:
0602: val = Objects.GetInstanceVar(interp, vdefn.member.fullname,
0603: contextObj, contextObj.classDefn);
0604:
0605: if (val != null) {
0606: obj = TclString.newInstance(val);
0607: } else {
0608: obj = TclString.newInstance("<undefined>");
0609: }
0610: try {
0611: TclList.append(interp, list, obj);
0612: } catch (TclException ex) {
0613: throw new TclRuntimeError("unexpected TclException "
0614: + ex.getMessage());
0615: }
0616: return list;
0617: }
0618:
0619: /*
0620: * ------------------------------------------------------------------------
0621: * Itcl_BiChainCmd -> BiCmds.BiChainCmd.cmdProc
0622: *
0623: * Invoked to handle the "chain" command, to access the version of
0624: * a method or proc that exists in a base class. Handles the
0625: * following syntax:
0626: *
0627: * chain ?<arg> <arg>...?
0628: *
0629: * Looks up the inheritance hierarchy for another implementation
0630: * of the method/proc that is currently executing. If another
0631: * implementation is found, it is invoked with the specified
0632: * <arg> arguments. If it is not found, this command does nothing.
0633: * This allows a base class method to be called out in a generic way,
0634: * so the code will not have to change if the base class changes.
0635: * ------------------------------------------------------------------------
0636: */
0637:
0638: static class BiChainCmd implements Command {
0639: public void cmdProc(Interp interp, // Current interp.
0640: TclObject[] objv) // Args passed to the command.
0641: throws TclException {
0642: ItclClass contextClass;
0643: ItclObject contextObj;
0644:
0645: String cmd, head;
0646: ItclClass cdefn;
0647: ItclHierIter hier;
0648: ItclMemberFunc mfunc;
0649: CallFrame frame;
0650: TclObject cmdline;
0651: TclObject[] newobjv;
0652: TclObject[] fobjv;
0653:
0654: // If this command is not invoked within a class namespace,
0655: // signal an error.
0656:
0657: Methods.GetContextResult gcr;
0658:
0659: try {
0660: gcr = Methods.GetContext(interp);
0661: contextClass = gcr.cdefn;
0662: contextObj = gcr.odefn;
0663: } catch (TclException ex) {
0664: interp.resetResult();
0665: throw new TclException(interp,
0666: "cannot chain functions outside of a class context");
0667: }
0668:
0669: // Try to get the command name from the current call frame.
0670: // If it cannot be determined, do nothing. Otherwise, trim
0671: // off any leading path names.
0672:
0673: frame = Migrate.GetCallFrame(interp, 0);
0674: fobjv = ItclAccess.getCallFrameObjv(frame);
0675: if (frame == null || fobjv == null) {
0676: return;
0677: }
0678: cmd = fobjv[0].toString();
0679: Util.ParseNamespPathResult res = Util.ParseNamespPath(cmd);
0680: head = res.head;
0681: cmd = res.tail;
0682:
0683: // Look for the specified command in one of the base classes.
0684: // If we have an object context, then start from the most-specific
0685: // class and walk up the hierarchy to the current context. If
0686: // there is multiple inheritance, having the entire inheritance
0687: // hierarchy will allow us to jump over to another branch of
0688: // the inheritance tree.
0689: //
0690: // If there is no object context, just start with the current
0691: // class context.
0692:
0693: if (contextObj != null) {
0694: hier = new ItclHierIter();
0695: Class.InitHierIter(hier, contextObj.classDefn);
0696: while ((cdefn = Class.AdvanceHierIter(hier)) != null) {
0697: if (cdefn == contextClass) {
0698: break;
0699: }
0700: }
0701: } else {
0702: hier = new ItclHierIter();
0703: Class.InitHierIter(hier, contextClass);
0704: Class.AdvanceHierIter(hier); // skip the current class
0705: }
0706:
0707: // Now search up the class hierarchy for the next implementation.
0708: // If found, execute it. Otherwise, do nothing.
0709:
0710: while ((cdefn = Class.AdvanceHierIter(hier)) != null) {
0711: mfunc = (ItclMemberFunc) cdefn.functions.get(cmd);
0712: if (mfunc != null) {
0713: // NOTE: Avoid the usual "virtual" behavior of
0714: // methods by passing the full name as
0715: // the command argument.
0716:
0717: cmdline = Util.CreateArgs(interp,
0718: mfunc.member.fullname, objv, 1);
0719:
0720: try {
0721: newobjv = TclList.getElements(interp, cmdline);
0722: } catch (TclException ex) {
0723: throw new TclRuntimeError(
0724: "unexpected TclException "
0725: + ex.getMessage());
0726: }
0727:
0728: Util.EvalArgs(interp, newobjv);
0729: break;
0730: }
0731: }
0732:
0733: Class.DeleteHierIter(hier);
0734: }
0735: } // end class BiChainCmd
0736:
0737: /*
0738: * ------------------------------------------------------------------------
0739: * Itcl_BiInfoClassCmd -> BiCmds.BiInfoClassCmd.cmdProc
0740: *
0741: * Returns information regarding the class for an object. This command
0742: * can be invoked with or without an object context:
0743: *
0744: * <objName> info class <= returns most-specific class name
0745: * info class <= returns active namespace name
0746: *
0747: * Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
0748: * ------------------------------------------------------------------------
0749: */
0750:
0751: static class BiInfoClassCmd implements Command {
0752: public void cmdProc(Interp interp, // Current interp.
0753: TclObject[] objv) // Args passed to the command.
0754: throws TclException {
0755: Namespace activeNs = Namespace.getCurrentNamespace(interp), contextNs = null;
0756:
0757: ItclClass contextClass;
0758: ItclObject contextObj;
0759:
0760: String name;
0761:
0762: if (objv.length != 1) {
0763: throw new TclNumArgsException(interp, 1, objv, "");
0764: }
0765:
0766: // If this command is not invoked within a class namespace,
0767: // signal an error.
0768:
0769: Methods.GetContextResult gcr;
0770:
0771: try {
0772: gcr = Methods.GetContext(interp);
0773: contextClass = gcr.cdefn;
0774: contextObj = gcr.odefn;
0775: } catch (TclException ex) {
0776: throw new TclException(
0777: interp,
0778: "\nget info like this instead: "
0779: + "\n namespace eval className { info "
0780: + objv[0] + "... }");
0781: }
0782:
0783: // If there is an object context, then return the most-specific
0784: // class for the object. Otherwise, return the class namespace
0785: // name. Use normal class names when possible.
0786:
0787: if (contextObj != null) {
0788: contextNs = contextObj.classDefn.namesp;
0789: } else {
0790: Util.Assert(contextClass != null,
0791: "contextClass != null");
0792: Util.Assert(contextClass.namesp != null,
0793: "contextClass.namesp != null");
0794: contextNs = contextClass.namesp;
0795: }
0796:
0797: if (contextNs == null) {
0798: name = activeNs.fullName;
0799: } else if (contextNs.parent == activeNs) {
0800: name = contextNs.name;
0801: } else {
0802: name = contextNs.fullName;
0803: }
0804:
0805: interp.setResult(name);
0806: }
0807: } // end class BiInfoClassCmd
0808:
0809: /*
0810: * ------------------------------------------------------------------------
0811: * Itcl_BiInfoInheritCmd -> BiCmds.BiInfoInheritCmd.cmdProc
0812: *
0813: * Returns the list of base classes for the current class context.
0814: * Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
0815: * ------------------------------------------------------------------------
0816: */
0817:
0818: static class BiInfoInheritCmd implements Command {
0819: public void cmdProc(Interp interp, // Current interp.
0820: TclObject[] objv) // Args passed to the command.
0821: throws TclException {
0822: Namespace activeNs = Namespace.getCurrentNamespace(interp);
0823:
0824: ItclClass contextClass;
0825: ItclObject contextObj;
0826:
0827: ItclClass cdefn;
0828: Itcl_ListElem elem;
0829: TclObject list, obj;
0830:
0831: if (objv.length != 1) {
0832: throw new TclNumArgsException(interp, 1, objv, "");
0833: }
0834:
0835: // If this command is not invoked within a class namespace,
0836: // signal an error.
0837:
0838: Methods.GetContextResult gcr;
0839:
0840: try {
0841: gcr = Methods.GetContext(interp);
0842: contextClass = gcr.cdefn;
0843: contextObj = gcr.odefn;
0844: } catch (TclException ex) {
0845: String name = objv[0].toString();
0846: throw new TclException(
0847: interp,
0848: "\nget info like this instead: "
0849: + "\n namespace eval className { info "
0850: + name + "... }");
0851: }
0852:
0853: // Return the list of base classes.
0854:
0855: list = TclList.newInstance();
0856:
0857: elem = Util.FirstListElem(contextClass.bases);
0858: while (elem != null) {
0859: cdefn = (ItclClass) Util.GetListValue(elem);
0860: if (cdefn.namesp.parent == activeNs) {
0861: obj = TclString.newInstance(cdefn.namesp.name);
0862: } else {
0863: obj = TclString.newInstance(cdefn.namesp.fullName);
0864: }
0865: TclList.append(interp, list, obj);
0866: elem = Util.NextListElem(elem);
0867: }
0868:
0869: interp.setResult(list);
0870: }
0871: } // end class BiInfoInheritCmd
0872:
0873: /*
0874: * ------------------------------------------------------------------------
0875: * Itcl_BiInfoHeritageCmd -> BiCmds.BiInfoHeritageCmd.cmdProc
0876: *
0877: * Returns the entire derivation hierarchy for this class, presented
0878: * in the order that classes are traversed for finding data members
0879: * and member functions.
0880: *
0881: * Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
0882: * ------------------------------------------------------------------------
0883: */
0884:
0885: static class BiInfoHeritageCmd implements Command {
0886: public void cmdProc(Interp interp, // Current interp.
0887: TclObject[] objv) // Args passed to the command.
0888: throws TclException {
0889: Namespace activeNs = Namespace.getCurrentNamespace(interp);
0890:
0891: ItclClass contextClass;
0892: ItclObject contextObj;
0893:
0894: ItclHierIter hier;
0895: TclObject list, obj;
0896: ItclClass cdefn;
0897:
0898: if (objv.length != 1) {
0899: throw new TclNumArgsException(interp, 1, objv, "");
0900: }
0901:
0902: // If this command is not invoked within a class namespace,
0903: // signal an error.
0904:
0905: Methods.GetContextResult gcr;
0906:
0907: try {
0908: gcr = Methods.GetContext(interp);
0909: contextClass = gcr.cdefn;
0910: contextObj = gcr.odefn;
0911: } catch (TclException ex) {
0912: String name = objv[0].toString();
0913: throw new TclException(
0914: interp,
0915: "\nget info like this instead: "
0916: + "\n namespace eval className { info "
0917: + name + "... }");
0918: }
0919:
0920: // Traverse through the derivation hierarchy and return
0921: // base class names.
0922:
0923: list = TclList.newInstance();
0924:
0925: hier = new ItclHierIter();
0926: Class.InitHierIter(hier, contextClass);
0927: while ((cdefn = Class.AdvanceHierIter(hier)) != null) {
0928: if (cdefn.namesp.parent == activeNs) {
0929: obj = TclString.newInstance(cdefn.namesp.name);
0930: } else {
0931: obj = TclString.newInstance(cdefn.namesp.fullName);
0932: }
0933: TclList.append(interp, list, obj);
0934: }
0935: Class.DeleteHierIter(hier);
0936:
0937: interp.setResult(list);
0938: }
0939: } // end class BiInfoHeritageCmd
0940:
0941: /*
0942: * ------------------------------------------------------------------------
0943: * Itcl_BiInfoFunctionCmd -> BiCmds.BiInfoFunctionCmd.cmdProc
0944: *
0945: * Returns information regarding class member functions (methods/procs).
0946: * Handles the following syntax:
0947: *
0948: * info function ?cmdName? ?-protection? ?-type? ?-name? ?-args? ?-body?
0949: *
0950: * If the ?cmdName? is not specified, then a list of all known
0951: * command members is returned. Otherwise, the information for
0952: * a specific command is returned. Raises a TclException if
0953: * anything goes wrong.
0954: * ------------------------------------------------------------------------
0955: */
0956:
0957: static class BiInfoFunctionCmd implements Command {
0958: static String[] options = { "-args", "-body", "-name",
0959: "-protection", "-type", };
0960:
0961: static final private int BIfArgsIdx = 0;
0962: static final private int BIfBodyIdx = 1;
0963: static final private int BIfNameIdx = 2;
0964: static final private int BIfProtectIdx = 3;
0965: static final private int BIfTypeIdx = 4;
0966:
0967: static int[] DefInfoFunction = { BIfProtectIdx, BIfTypeIdx,
0968: BIfNameIdx, BIfArgsIdx, BIfBodyIdx };
0969:
0970: public void cmdProc(Interp interp, // Current interp.
0971: TclObject[] objv) // Args passed to the command.
0972: throws TclException {
0973: String cmdName = null;
0974: TclObject result = null;
0975: TclObject obj = null;
0976:
0977: ItclClass contextClass, cdefn;
0978: ItclObject contextObj;
0979:
0980: int[] iflist;
0981: int[] iflistStorage = new int[5];
0982:
0983: String name, val;
0984: ItclMemberFunc mfunc;
0985: ItclMemberCode mcode;
0986: ItclHierIter hier;
0987: int objc, skip;
0988:
0989: // If this command is not invoked within a class namespace,
0990: // signal an error.
0991:
0992: Methods.GetContextResult gcr;
0993:
0994: try {
0995: gcr = Methods.GetContext(interp);
0996: contextClass = gcr.cdefn;
0997: contextObj = gcr.odefn;
0998: } catch (TclException ex) {
0999: name = objv[0].toString();
1000: interp.resetResult();
1001: throw new TclException(
1002: interp,
1003: "\nget info like this instead: "
1004: + "\n namespace eval className { info "
1005: + name + "... }");
1006: }
1007:
1008: // Process args:
1009: // ?cmdName? ?-protection? ?-type? ?-name? ?-args? ?-body?
1010:
1011: objc = objv.length;
1012: skip = 0;
1013:
1014: skip++; // skip over command name
1015: objc--;
1016:
1017: if (objc > 0) {
1018: cmdName = objv[skip].toString();
1019: objc--;
1020: skip++;
1021: }
1022:
1023: // Return info for a specific command.
1024:
1025: if (cmdName != null) {
1026: mfunc = (ItclMemberFunc) contextClass.resolveCmds
1027: .get(cmdName);
1028:
1029: if (mfunc == null) {
1030: throw new TclException(interp, "\"" + cmdName
1031: + "\" isn't a member function in class \""
1032: + contextClass.namesp.fullName + "\"");
1033: }
1034: mcode = mfunc.member.code;
1035:
1036: // By default, return everything.
1037:
1038: if (objc == 0) {
1039: objc = 5;
1040: iflist = DefInfoFunction;
1041: }
1042:
1043: // Otherwise, scan through all remaining flags and
1044: // figure out what to return.
1045:
1046: else {
1047: iflist = iflistStorage;
1048: for (int i = 0; i < objc; i++) {
1049: iflist[i] = TclIndex.get(interp,
1050: objv[i + skip], options, "option", 0);
1051: }
1052: }
1053:
1054: if (objc > 1) {
1055: result = TclList.newInstance();
1056: }
1057:
1058: for (int i = 0; i < objc; i++) {
1059: switch (iflist[i]) {
1060: case BIfArgsIdx:
1061: if (mcode != null && mcode.arglist != null) {
1062: obj = Methods.ArgList(mcode.argcount,
1063: mcode.arglist);
1064: } else if ((mfunc.member.flags & ItclInt.ARG_SPEC) != 0) {
1065: obj = Methods.ArgList(mfunc.argcount,
1066: mfunc.arglist);
1067: } else {
1068: obj = TclString.newInstance("<undefined>");
1069: }
1070: break;
1071:
1072: case BIfBodyIdx:
1073: if (mcode != null
1074: && Methods
1075: .IsMemberCodeImplemented(mcode)) {
1076: obj = TclString.newInstance(mcode.body);
1077: } else {
1078: obj = TclString.newInstance("<undefined>");
1079: }
1080: break;
1081:
1082: case BIfNameIdx:
1083: obj = TclString
1084: .newInstance(mfunc.member.fullname);
1085: break;
1086:
1087: case BIfProtectIdx:
1088: val = Util
1089: .ProtectionStr(mfunc.member.protection);
1090: obj = TclString.newInstance(val);
1091: break;
1092:
1093: case BIfTypeIdx:
1094: val = ((mfunc.member.flags & ItclInt.COMMON) != 0) ? "proc"
1095: : "method";
1096: obj = TclString.newInstance(val);
1097: break;
1098: }
1099:
1100: if (objc == 1) {
1101: result = obj;
1102: } else {
1103: TclList.append(interp, result, obj);
1104: }
1105: }
1106: interp.setResult(result);
1107: }
1108:
1109: // Return the list of available commands.
1110:
1111: else {
1112: result = TclList.newInstance();
1113:
1114: hier = new ItclHierIter();
1115: Class.InitHierIter(hier, contextClass);
1116: while ((cdefn = Class.AdvanceHierIter(hier)) != null) {
1117: for (Iterator iter = cdefn.functions.entrySet()
1118: .iterator(); iter.hasNext();) {
1119: Map.Entry entry = (Map.Entry) iter.next();
1120: String key = (String) entry.getKey();
1121: mfunc = (ItclMemberFunc) entry.getValue();
1122: obj = TclString
1123: .newInstance(mfunc.member.fullname);
1124: TclList.append(interp, result, obj);
1125: }
1126: }
1127: Class.DeleteHierIter(hier);
1128: interp.setResult(result);
1129: }
1130: }
1131: } // end class BiInfoFunctionCmd
1132:
1133: /*
1134: * ------------------------------------------------------------------------
1135: * Itcl_BiInfoVariableCmd -> BiCmds.BiInfoVariableCmd.cmdProc
1136: *
1137: * Returns information regarding class data members (variables and
1138: * commons). Handles the following syntax:
1139: *
1140: * info variable ?varName? ?-protection? ?-type? ?-name?
1141: * ?-init? ?-config? ?-value?
1142: *
1143: * If the ?varName? is not specified, then a list of all known
1144: * data members is returned. Otherwise, the information for a
1145: * specific member is returned. Raises a TclException if
1146: * anything goes wrong.
1147: * ------------------------------------------------------------------------
1148: */
1149:
1150: static class BiInfoVariableCmd implements Command {
1151: static String[] options = { "-config", "-init", "-name",
1152: "-protection", "-type", "-value" };
1153:
1154: static final private int BIvConfigIdx = 0;
1155: static final private int BIvInitIdx = 1;
1156: static final private int BIvNameIdx = 2;
1157: static final private int BIvProtectIdx = 3;
1158: static final private int BIvTypeIdx = 4;
1159: static final private int BIvValueIdx = 5;
1160:
1161: static int[] DefInfoVariable = { BIvProtectIdx, BIvTypeIdx,
1162: BIvNameIdx, BIvInitIdx, BIvValueIdx };
1163:
1164: static int[] DefInfoPubVariable = { BIvProtectIdx, BIvTypeIdx,
1165: BIvNameIdx, BIvInitIdx, BIvConfigIdx, BIvValueIdx };
1166:
1167: public void cmdProc(Interp interp, // Current interp.
1168: TclObject[] objv) // Args passed to the command.
1169: throws TclException {
1170: String varName = null;
1171: TclObject result = null;
1172: TclObject obj = null;
1173:
1174: int[] ivlist;
1175: int[] ivlistStorage = new int[6];
1176:
1177: ItclClass contextClass;
1178: ItclObject contextObj;
1179:
1180: String val, name;
1181: ItclClass cdefn;
1182: ItclVarDefn vdefn;
1183: ItclVarLookup vlookup;
1184: ItclMember member;
1185: ItclHierIter hier;
1186: int objc, skip;
1187:
1188: // If this command is not invoked within a class namespace,
1189: // signal an error.
1190:
1191: Methods.GetContextResult gcr;
1192:
1193: try {
1194: gcr = Methods.GetContext(interp);
1195: contextClass = gcr.cdefn;
1196: contextObj = gcr.odefn;
1197: } catch (TclException ex) {
1198: name = objv[0].toString();
1199: interp.resetResult();
1200: throw new TclException(
1201: interp,
1202: "\nget info like this instead: "
1203: + "\n namespace eval className { info "
1204: + name + "... }");
1205: }
1206:
1207: // Process args:
1208: // ?varName? ?-protection? ?-type? ?-name? ?-init? ?-config? ?-value?
1209:
1210: objc = objv.length;
1211: skip = 0;
1212:
1213: skip++; // skip over command name
1214: objc--;
1215:
1216: if (objc > 0) {
1217: varName = objv[skip].toString();
1218: objc--;
1219: skip++;
1220: }
1221:
1222: // Return info for a specific variable.
1223:
1224: if (varName != null) {
1225: vlookup = (ItclVarLookup) contextClass.resolveVars
1226: .get(varName);
1227: if (vlookup == null) {
1228: throw new TclException(interp, "\"" + varName
1229: + "\" isn't a variable in class \""
1230: + contextClass.namesp.fullName + "\"");
1231: }
1232: member = vlookup.vdefn.member;
1233:
1234: // By default, return everything.
1235:
1236: if (objc == 0) {
1237: if (member.protection == Itcl.PUBLIC
1238: && ((member.flags & ItclInt.COMMON) == 0)) {
1239: ivlist = DefInfoPubVariable;
1240: objc = 6;
1241: } else {
1242: ivlist = DefInfoVariable;
1243: objc = 5;
1244: }
1245: }
1246:
1247: // Otherwise, scan through all remaining flags and
1248: // figure out what to return.
1249:
1250: else {
1251: ivlist = ivlistStorage;
1252: for (int i = 0; i < objc; i++) {
1253: ivlist[i] = TclIndex.get(interp,
1254: objv[i + skip], options, "option", 0);
1255: }
1256: }
1257:
1258: if (objc > 1) {
1259: result = TclList.newInstance();
1260: }
1261:
1262: for (int i = 0; i < objc; i++) {
1263: switch (ivlist[i]) {
1264: case BIvConfigIdx:
1265: if (member.code != null
1266: && Methods
1267: .IsMemberCodeImplemented(member.code)) {
1268: obj = TclString
1269: .newInstance(member.code.body);
1270: } else {
1271: obj = TclString.newInstance("");
1272: }
1273: break;
1274:
1275: case BIvInitIdx:
1276: // If this is the built-in "this" variable, then
1277: // report the object name as its initialization string.
1278:
1279: if ((member.flags & ItclInt.THIS_VAR) != 0) {
1280: if (contextObj != null
1281: && contextObj.accessCmd != null) {
1282: name = contextObj.classDefn.interp
1283: .getCommandFullName(contextObj.w_accessCmd);
1284: obj = TclString.newInstance(name);
1285: } else {
1286: obj = TclString
1287: .newInstance("<objectName>");
1288: }
1289: } else if (vlookup.vdefn.init != null) {
1290: obj = TclString
1291: .newInstance(vlookup.vdefn.init);
1292: } else {
1293: obj = TclString.newInstance("<undefined>");
1294: }
1295: break;
1296:
1297: case BIvNameIdx:
1298: obj = TclString.newInstance(member.fullname);
1299: break;
1300:
1301: case BIvProtectIdx:
1302: val = Util.ProtectionStr(member.protection);
1303: obj = TclString.newInstance(val);
1304: break;
1305:
1306: case BIvTypeIdx:
1307: val = ((member.flags & ItclInt.COMMON) != 0) ? "common"
1308: : "variable";
1309: obj = TclString.newInstance(val);
1310: break;
1311:
1312: case BIvValueIdx:
1313: if ((member.flags & ItclInt.COMMON) != 0) {
1314: val = Class.GetCommonVar(interp,
1315: member.fullname, member.classDefn);
1316: } else if (contextObj == null) {
1317: interp.resetResult();
1318: throw new TclException(
1319: interp,
1320: "cannot access object-specific info "
1321: + "without an object context");
1322: } else {
1323: val = Objects.GetInstanceVar(interp,
1324: member.fullname, contextObj,
1325: member.classDefn);
1326: }
1327:
1328: if (val == null) {
1329: val = "<undefined>";
1330: }
1331: obj = TclString.newInstance(val);
1332: break;
1333: }
1334:
1335: if (objc == 1) {
1336: result = obj;
1337: } else {
1338: TclList.append(interp, result, obj);
1339: }
1340: }
1341: interp.setResult(result);
1342: }
1343:
1344: // Return the list of available variables. Report the built-in
1345: // "this" variable only once, for the most-specific class.
1346:
1347: else {
1348: result = TclList.newInstance();
1349:
1350: hier = new ItclHierIter();
1351: Class.InitHierIter(hier, contextClass);
1352: while ((cdefn = Class.AdvanceHierIter(hier)) != null) {
1353: for (Iterator iter = cdefn.variables.entrySet()
1354: .iterator(); iter.hasNext();) {
1355: Map.Entry entry = (Map.Entry) iter.next();
1356: String key = (String) entry.getKey();
1357: vdefn = (ItclVarDefn) entry.getValue();
1358:
1359: if ((vdefn.member.flags & ItclInt.THIS_VAR) != 0) {
1360: if (cdefn == contextClass) {
1361: obj = TclString
1362: .newInstance(vdefn.member.fullname);
1363: TclList.append(interp, result, obj);
1364: }
1365: } else {
1366: obj = TclString
1367: .newInstance(vdefn.member.fullname);
1368: TclList.append(interp, result, obj);
1369: }
1370: }
1371: }
1372: Class.DeleteHierIter(hier);
1373:
1374: interp.setResult(result);
1375: }
1376: }
1377: } // end class BiInfoVariableCmd
1378:
1379: /*
1380: * ------------------------------------------------------------------------
1381: * Itcl_BiInfoBodyCmd -> BiCmds.BiInfoBodyCmd.cmdProc
1382: *
1383: * Handles the usual "info body" request, returning the body for a
1384: * specific proc. Included here for backward compatibility, since
1385: * otherwise Tcl would complain that class procs are not real "procs".
1386: * Raises a TclException if anything goes wrong.
1387: * ------------------------------------------------------------------------
1388: */
1389:
1390: static class BiInfoBodyCmd implements Command {
1391: public void cmdProc(Interp interp, // Current interp.
1392: TclObject[] objv) // Args passed to the command.
1393: throws TclException {
1394: String name;
1395: ItclClass contextClass;
1396: ItclObject contextObj;
1397: ItclMemberFunc mfunc;
1398: ItclMemberCode mcode;
1399: TclObject obj;
1400:
1401: if (objv.length != 2) {
1402: throw new TclNumArgsException(interp, 1, objv,
1403: "function");
1404: }
1405:
1406: // If this command is not invoked within a class namespace,
1407: // then treat the procedure name as a normal Tcl procedure.
1408:
1409: if (!Class.IsClassNamespace(Namespace
1410: .getCurrentNamespace(interp))) {
1411: name = objv[1].toString();
1412: interp.eval("::info body {" + name + "}");
1413: return;
1414: }
1415:
1416: // Otherwise, treat the name as a class method/proc.
1417:
1418: Methods.GetContextResult gcr;
1419:
1420: try {
1421: gcr = Methods.GetContext(interp);
1422: contextClass = gcr.cdefn;
1423: contextObj = gcr.odefn;
1424: } catch (TclException ex) {
1425: name = objv[0].toString();
1426: interp.resetResult();
1427: throw new TclException(
1428: interp,
1429: "\nget info like this instead: "
1430: + "\n namespace eval className { info "
1431: + name + "... }");
1432: }
1433:
1434: name = objv[1].toString();
1435: mfunc = (ItclMemberFunc) contextClass.resolveCmds.get(name);
1436: if (mfunc == null) {
1437: throw new TclException(interp, "\"" + name
1438: + "\" isn't a procedure");
1439: }
1440: mcode = mfunc.member.code;
1441:
1442: // Return a string describing the implementation.
1443:
1444: if (mcode != null && Methods.IsMemberCodeImplemented(mcode)) {
1445: obj = TclString.newInstance(mcode.body);
1446: } else {
1447: obj = TclString.newInstance("<undefined>");
1448: }
1449: interp.setResult(obj);
1450: }
1451: } // end class BiInfoBodyCmd
1452:
1453: /*
1454: * ------------------------------------------------------------------------
1455: * Itcl_BiInfoArgsCmd -> BiCmds.BiInfoArgsCmd.cmdProc
1456: *
1457: * Handles the usual "info args" request, returning the argument list
1458: * for a specific proc. Included here for backward compatibility, since
1459: * otherwise Tcl would complain that class procs are not real "procs".
1460: * Raises a TclException if anything goes wrong.
1461: * ------------------------------------------------------------------------
1462: */
1463:
1464: static class BiInfoArgsCmd implements Command {
1465: public void cmdProc(Interp interp, // Current interp.
1466: TclObject[] objv) // Args passed to the command.
1467: throws TclException {
1468: String name;
1469: ItclClass contextClass;
1470: ItclObject contextObj;
1471: ItclMemberFunc mfunc;
1472: ItclMemberCode mcode;
1473: TclObject obj;
1474:
1475: if (objv.length != 2) {
1476: throw new TclNumArgsException(interp, 1, objv,
1477: "function");
1478: }
1479:
1480: name = objv[1].toString();
1481:
1482: // If this command is not invoked within a class namespace,
1483: // then treat the procedure name as a normal Tcl procedure.
1484:
1485: if (!Class.IsClassNamespace(Namespace
1486: .getCurrentNamespace(interp))) {
1487: name = objv[1].toString();
1488: interp.eval("::info args {" + name + "}");
1489: return;
1490: }
1491:
1492: // Otherwise, treat the name as a class method/proc.
1493:
1494: Methods.GetContextResult gcr;
1495:
1496: try {
1497: gcr = Methods.GetContext(interp);
1498: contextClass = gcr.cdefn;
1499: contextObj = gcr.odefn;
1500: } catch (TclException ex) {
1501: name = objv[0].toString();
1502: interp.resetResult();
1503: throw new TclException(
1504: interp,
1505: "\nget info like this instead: "
1506: + "\n namespace eval className { info "
1507: + name + "... }");
1508: }
1509:
1510: mfunc = (ItclMemberFunc) contextClass.resolveCmds.get(name);
1511: if (mfunc == null) {
1512: throw new TclException(interp, "\"" + name
1513: + "\" isn't a procedure");
1514: }
1515: mcode = mfunc.member.code;
1516:
1517: // Return a string describing the argument list.
1518:
1519: if (mcode != null && mcode.arglist != null) {
1520: obj = Methods.ArgList(mcode.argcount, mcode.arglist);
1521: } else if ((mfunc.member.flags & ItclInt.ARG_SPEC) != 0) {
1522: obj = Methods.ArgList(mfunc.argcount, mfunc.arglist);
1523: } else {
1524: obj = TclString.newInstance("<undefined>");
1525: }
1526: interp.setResult(obj);
1527: }
1528: } // end class BiInfoArgsCmd
1529:
1530: /*
1531: * ------------------------------------------------------------------------
1532: * Itcl_DefaultInfoCmd -> BiCmds.DefaultInfoCmd.cmdProc
1533: *
1534: * Handles any unknown options for the "itcl::builtin::info" command
1535: * by passing requests on to the usual "::info" command. If the
1536: * option is recognized, then it is handled. Otherwise, if it is
1537: * still unknown, then an error message is returned with the list
1538: * of possible options.
1539: *
1540: * Raises a TclException if anything goes wrong.
1541: * ------------------------------------------------------------------------
1542: */
1543:
1544: static class DefaultInfoCmd implements Command {
1545: public void cmdProc(Interp interp, // Current interp.
1546: TclObject[] objv) // Args passed to the command.
1547: throws TclException {
1548: String name;
1549: WrappedCommand wcmd;
1550: Command cmd;
1551: StringBuffer result;
1552:
1553: // Look for the usual "::info" command, and use it to
1554: // evaluate the unknown option.
1555:
1556: wcmd = Namespace.findCommand(interp, "::info", null, 0);
1557: if (wcmd == null) {
1558: name = objv[0].toString();
1559: interp.resetResult();
1560:
1561: result = new StringBuffer(64);
1562: result.append("bad option \"" + name
1563: + "\" should be one of...\n");
1564: Ensemble
1565: .GetEnsembleUsageForObj(interp, objv[0], result);
1566:
1567: throw new TclException(interp, result.toString());
1568: }
1569:
1570: cmd = wcmd.cmd;
1571:
1572: try {
1573: cmd.cmdProc(interp, objv);
1574: } catch (TclException ex) {
1575: // If the option was not recognized by the usual "info" command,
1576: // then we got a "bad option" error message. Add the options
1577: // for the current ensemble to the error message.
1578:
1579: String ires = interp.getResult().toString();
1580: if (ires.startsWith("bad option")) {
1581: result = new StringBuffer(64);
1582: result.append(ires);
1583: result.append("\nor");
1584: Ensemble.GetEnsembleUsageForObj(interp, objv[0],
1585: result);
1586: throw new TclException(interp, result.toString());
1587: }
1588: }
1589: }
1590: } // end class DefaultInfoCmd
1591:
1592: } // end class BiCmds
|