/trunk/managed/csharp-sqlite/TCL/src/commands/NamespaceCmd.cs
C# | 3658 lines | 1632 code | 560 blank | 1466 comment | 432 complexity | 12fb30405e0ed62db687a6b89fe50b51 MD5 | raw file
Possible License(s): Apache-2.0, BSD-2-Clause, MIT, LGPL-2.1, LGPL-3.0, GPL-2.0, CC-BY-SA-3.0, GPL-3.0, BSD-3-Clause
- #undef DEBUG
- /*
- * NamespaceCmd.java
- *
- * Copyright (c) 1993-1997 Lucent Technologies.
- * Copyright (c) 1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
- * Copyright (c) 1999 Moses DeJong
- *
- * Originally implemented by
- * Michael J. McLennan
- * Bell Labs Innovations for Lucent Technologies
- * mmclennan@lucent.com
- *
- * See the file "license.terms" for information on usage and
- * redistribution of this file, and for a DISCLAIMER OF ALL
- * WARRANTIES.
- *
- * Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
- * $Header$
- * RCS @(#) $Id: NamespaceCmd.java,v 1.12 2001/05/05 22:38:13 mdejong Exp $
- */
- using System;
- using System.Collections;
- namespace tcl.lang
- {
-
- /// <summary> This class implements the built-in "namespace" command in Tcl.
- /// See the user documentation for details on what it does.
- /// </summary>
-
-
- public class NamespaceCmd : InternalRep, Command
- {
-
- // Flag passed to getNamespaceForQualName to indicate that it should
- // search for a namespace rather than a command or variable inside a
- // namespace. Note that this flag's value must not conflict with the values
- // of TCL.VarFlag.GLOBAL_ONLY, TCL.VarFlag.NAMESPACE_ONLY, or TCL.VarFlag.CREATE_NS_IF_UNKNOWN.
-
-
- // Initial size of stack allocated space for tail list - used when resetting
- // shadowed command references in the functin: TclResetShadowedCmdRefs.
-
- //private static final int NUM_TRAIL_ELEMS = 5;
-
- // Count of the number of namespaces created. This value is used as a
- // unique id for each namespace.
-
- private static long numNsCreated = 0;
- private static Object nsMutex;
-
- //
- // Flags used to represent the status of a namespace:
- //
- // NS_DYING - 1 means deleteNamespace has been called to delete the
- // namespace but there are still active call frames on the Tcl
- // stack that refer to the namespace. When the last call frame
- // referring to it has been popped, it's variables and command
- // will be destroyed and it will be marked "dead" (NS_DEAD).
- // The namespace can no longer be looked up by name.
- // NS_DEAD - 1 means deleteNamespace has been called to delete the
- // namespace and no call frames still refer to it. Its
- // variables and command have already been destroyed. This bit
- // allows the namespace resolution code to recognize that the
- // namespace is "deleted". When the last namespaceName object
- // in any byte code code unit that refers to the namespace has
- // been freed (i.e., when the namespace's refCount is 0), the
- // namespace's storage will be freed.
-
- internal const int NS_DYING = 0x01;
- internal const int NS_DEAD = 0x02;
-
-
- // Flag passed to getNamespaceForQualName to have it create all namespace
- // components of a namespace-qualified name that cannot be found. The new
- // namespaces are created within their specified parent. Note that this
- // flag's value must not conflict with the values of the flags
- // TCL.VarFlag.GLOBAL_ONLY, TCL.VarFlag.NAMESPACE_ONLY, and TCL.VarFlag.FIND_ONLY_NS
-
- // internal const int TCL.VarFlag.CREATE_NS_IF_UNKNOWN = 0x800;
-
-
- // This value corresponds to the Tcl_Obj.otherValuePtr pointer used
- // in the C version of Tcl 8.1. Use it to keep track of a ResolvedNsName.
-
- private ResolvedNsName otherValue = null;
-
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetCurrentNamespace -> getCurrentNamespace
- *
- * Returns a reference to an interpreter's currently active namespace.
- *
- * Results:
- * Returns a reference to the interpreter's current namespace.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- internal static Namespace getCurrentNamespace(Interp interp)
- {
- if (interp.varFrame != null)
- {
- return interp.varFrame.ns;
- }
- else
- {
- return interp.globalNs;
- }
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetGlobalNamespace -> getGlobalNamespace
- *
- * Returns a reference to an interpreter's global :: namespace.
- *
- * Results:
- * Returns a reference to the specified interpreter's global namespace.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- internal static Namespace getGlobalNamespace(Interp interp)
- {
- return interp.globalNs;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_PushCallFrame -> pushCallFrame
- *
- * Pushes a new call frame onto the interpreter's Tcl call stack.
- * Called when executing a Tcl procedure or a "namespace eval" or
- * "namespace inscope" command.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Modifies the interpreter's Tcl call stack.
- *
- *----------------------------------------------------------------------
- */
-
- internal static void pushCallFrame(Interp interp, CallFrame frame, Namespace namespace_Renamed, bool isProcCallFrame)
- // If true, the frame represents a
- // called Tcl procedure and may have local
- // vars. Vars will ordinarily be looked up
- // in the frame. If new variables are
- // created, they will be created in the
- // frame. If false, the frame is for a
- // "namespace eval" or "namespace inscope"
- // command and var references are treated
- // as references to namespace variables.
- {
- Namespace ns;
-
- if (namespace_Renamed == null)
- {
- ns = getCurrentNamespace(interp);
- }
- else
- {
- ns = namespace_Renamed;
- if ((ns.flags & NS_DEAD) != 0)
- {
- throw new TclRuntimeError("Trying to push call frame for dead namespace");
- }
- }
-
- ns.activationCount++;
- frame.ns = ns;
- frame.isProcCallFrame = isProcCallFrame;
- frame.objv = null;
-
- frame.caller = interp.frame;
- frame.callerVar = interp.varFrame;
-
- if (interp.varFrame != null)
- {
- frame.level = (interp.varFrame.level + 1);
- }
- else
- {
- frame.level = 1;
- }
-
- // FIXME : does Jacl need a procPtr in the CallFrame class?
- //frame.procPtr = null; // no called procedure
-
- frame.varTable = null; // and no local variables
-
- // Compiled locals are not part of Jacl's CallFrame
-
- // Push the new call frame onto the interpreter's stack of procedure
- // call frames making it the current frame.
-
- interp.frame = frame;
- interp.varFrame = frame;
- }
-
-
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_PopCallFrame -> popCallFrame
- *
- * Removes a call frame from the Tcl call stack for the interpreter.
- * Called to remove a frame previously pushed by Tcl_PushCallFrame.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Modifies the call stack of the interpreter. Resets various fields of
- * the popped call frame. If a namespace has been deleted and
- * has no more activations on the call stack, the namespace is
- * destroyed.
- *
- *----------------------------------------------------------------------
- */
-
- internal static void popCallFrame(Interp interp)
- {
- CallFrame frame = interp.frame;
- int saveErrFlag;
- Namespace ns;
-
- // It's important to remove the call frame from the interpreter's stack
- // of call frames before deleting local variables, so that traces
- // invoked by the variable deletion don't see the partially-deleted
- // frame.
-
- interp.frame = frame.caller;
- interp.varFrame = frame.callerVar;
-
- // Delete the local variables. As a hack, we save then restore the
- // ERR_IN_PROGRESS flag in the interpreter. The problem is that there
- // could be unset traces on the variables, which cause scripts to be
- // evaluated. This will clear the ERR_IN_PROGRESS flag, losing stack
- // trace information if the procedure was exiting with an error. The
- // code below preserves the flag. Unfortunately, that isn't really
- // enough: we really should preserve the errorInfo variable too
- // (otherwise a nested error in the trace script will trash errorInfo).
- // What's really needed is a general-purpose mechanism for saving and
- // restoring interpreter state.
-
- saveErrFlag = (interp.flags & Parser.ERR_IN_PROGRESS);
-
- if (frame.varTable != null)
- {
- Var.deleteVars(interp, frame.varTable);
- frame.varTable = null;
- }
-
- interp.flags |= saveErrFlag;
-
- // Decrement the namespace's count of active call frames. If the
- // namespace is "dying" and there are no more active call frames,
- // call Tcl_DeleteNamespace to destroy it.
-
- ns = frame.ns;
- ns.activationCount--;
- if (((ns.flags & NS_DYING) != 0) && (ns.activationCount == 0))
- {
- deleteNamespace(ns);
- }
- frame.ns = null;
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateNamespace --
- *
- * Creates a new namespace with the given name. If there is no
- * active namespace (i.e., the interpreter is being initialized),
- * the global :: namespace is created and returned.
- *
- * Results:
- * Returns a reference to the new namespace if successful. If the
- * namespace already exists or if another error occurs, this routine
- * returns null, along with an error message in the interpreter's
- * result object.
- *
- * Side effects:
- * If the name contains "::" qualifiers and a parent namespace does
- * not already exist, it is automatically created.
- *
- *----------------------------------------------------------------------
- */
-
- internal static Namespace createNamespace(Interp interp, string name, DeleteProc deleteProc)
- {
- Namespace ns, ancestor;
- Namespace parent;
- Namespace globalNs = getGlobalNamespace(interp);
- string simpleName;
- System.Text.StringBuilder buffer1, buffer2;
-
- // If there is no active namespace, the interpreter is being
- // initialized.
-
- if ((globalNs == null) && (interp.varFrame == null))
- {
- // Treat this namespace as the global namespace, and avoid
- // looking for a parent.
-
- parent = null;
- simpleName = "";
- }
- else if (name.Length == 0)
- {
- /*
- TclObject tobj = interp.getResult();
- // FIXME : is there a test case to check this error result?
- TclString.append(tobj,
- "can't create namespace \"\": only global namespace can have empty name");
- */
-
- // FIXME : is there a test case to check this error result?
- interp.setResult("can't create namespace \"\": only global namespace can have empty name");
- return null;
- }
- else
- {
- // Find the parent for the new namespace.
-
- // Java does not support passing an address so we pass
- // an array of size 1 and then assign arr[0] to the value
- Namespace[] parentArr = new Namespace[1];
- Namespace[] dummyArr = new Namespace[1];
- string[] simpleArr = new string[1];
-
- getNamespaceForQualName(interp, name, null, (TCL.VarFlag.CREATE_NS_IF_UNKNOWN | TCL.VarFlag.LEAVE_ERR_MSG), parentArr, dummyArr, dummyArr, simpleArr);
-
- // Get the values out of the arrays!
- parent = parentArr[0];
- simpleName = simpleArr[0];
-
-
- // If the unqualified name at the end is empty, there were trailing
- // "::"s after the namespace's name which we ignore. The new
- // namespace was already (recursively) created and is referenced
- // by parent.
-
- if (simpleName.Length == 0)
- {
- return parent;
- }
-
- // Check for a bad namespace name and make sure that the name
- // does not already exist in the parent namespace.
-
- if (parent.childTable[simpleName] != null)
- {
- /*
- TclObject tobj = interp.getResult();
- // FIXME : is there a test case to check this error result?
- TclString.append(tobj,
- "can't create namespace \"" + name + "\": already exists");
- */
-
- // FIXME : is there a test case to check this error result?
- interp.setResult("can't create namespace \"" + name + "\": already exists");
- return null;
- }
- }
-
- // Create the new namespace and root it in its parent. Increment the
- // count of namespaces created.
-
- ns = new Namespace();
- ns.name = simpleName;
- ns.fullName = null; // set below
- //ns.clientData = clientData;
- ns.deleteProc = deleteProc;
- ns.parent = parent;
- ns.childTable = new Hashtable();
- lock (nsMutex)
- {
- numNsCreated++;
- ns.nsId = numNsCreated;
- }
- ns.interp = interp;
- ns.flags = 0;
- ns.activationCount = 0;
- // FIXME : there was a problem with the refcount because
- // when the namespace was deleted the refocount was 0.
- // We avoid this by just using a refcount of 1 for now.
- // We can do ignore the refCount because GC will reclaim mem.
- //ns.refCount = 0;
- ns.refCount = 1;
- ns.cmdTable = new Hashtable();
- ns.varTable = new Hashtable();
- ns.exportArray = null;
- ns.numExportPatterns = 0;
- ns.maxExportPatterns = 0;
-
- // Jacl does not use these tcl compiler specific members
- //ns.cmdRefEpoch = 0;
- //ns.resolverEpoch = 0;
-
- ns.resolver = null;
-
- if (parent != null)
- {
- SupportClass.PutElement(parent.childTable, simpleName, ns);
- }
-
- // Build the fully qualified name for this namespace.
-
- buffer1 = new System.Text.StringBuilder();
- buffer2 = new System.Text.StringBuilder();
- for (ancestor = ns; ancestor != null; ancestor = ancestor.parent)
- {
- if (ancestor != globalNs)
- {
- buffer1.Append("::");
- buffer1.Append(ancestor.name);
- }
- buffer1.Append(buffer2);
-
- buffer2.Length = 0;
- buffer2.Append(buffer1);
- buffer1.Length = 0;
- }
-
- name = buffer2.ToString();
- ns.fullName = name;
-
- // Return a reference to the new namespace.
-
- return ns;
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_DeleteNamespace -> deleteNamespace
- *
- * Deletes a namespace and all of the commands, variables, and other
- * namespaces within it.
- *
- * Results:
- * None.
- *
- * Side effects:
- * When a namespace is deleted, it is automatically removed as a
- * child of its parent namespace. Also, all its commands, variables
- * and child namespaces are deleted.
- *
- *----------------------------------------------------------------------
- */
-
- internal static void deleteNamespace(Namespace namespace_Renamed)
- {
- Namespace ns = namespace_Renamed;
- Interp interp = ns.interp;
- Namespace globalNs = getGlobalNamespace(interp);
-
- // If the namespace is on the call frame stack, it is marked as "dying"
- // (NS_DYING is OR'd into its flags): the namespace can't be looked up
- // by name but its commands and variables are still usable by those
- // active call frames. When all active call frames referring to the
- // namespace have been popped from the Tcl stack, popCallFrame will
- // call this procedure again to delete everything in the namespace.
- // If no nsName objects refer to the namespace (i.e., if its refCount
- // is zero), its commands and variables are deleted and the storage for
- // its namespace structure is freed. Otherwise, if its refCount is
- // nonzero, the namespace's commands and variables are deleted but the
- // structure isn't freed. Instead, NS_DEAD is OR'd into the structure's
- // flags to allow the namespace resolution code to recognize that the
- // namespace is "deleted".
-
- if (ns.activationCount > 0)
- {
- ns.flags |= NS_DYING;
- if (ns.parent != null)
- {
- ns.parent.childTable.Remove(ns.name);
- }
- ns.parent = null;
- }
- else
- {
- // Delete the namespace and everything in it. If this is the global
- // namespace, then clear it but don't free its storage unless the
- // interpreter is being torn down.
-
- teardownNamespace(ns);
-
- if ((ns != globalNs) || ((interp.flags & Parser.DELETED) != 0))
- {
- // If this is the global namespace, then it may have residual
- // "errorInfo" and "errorCode" variables for errors that
- // occurred while it was being torn down. Try to clear the
- // variable list one last time.
-
- Var.deleteVars(ns.interp, ns.varTable);
-
- ns.childTable.Clear();
- ns.cmdTable.Clear();
-
- // If the reference count is 0, then discard the namespace.
- // Otherwise, mark it as "dead" so that it can't be used.
-
- if (ns.refCount == 0)
- {
- free(ns);
- }
- else
- {
- ns.flags |= NS_DEAD;
- }
- }
- }
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * TclTeardownNamespace -> teardownNamespace
- *
- * Used internally to dismantle and unlink a namespace when it is
- * deleted. Divorces the namespace from its parent, and deletes all
- * commands, variables, and child namespaces.
- *
- * This is kept separate from Tcl_DeleteNamespace so that the global
- * namespace can be handled specially. Global variables like
- * "errorInfo" and "errorCode" need to remain intact while other
- * namespaces and commands are torn down, in case any errors occur.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Removes this namespace from its parent's child namespace hashtable.
- * Deletes all commands, variables and namespaces in this namespace.
- * If this is the global namespace, the "errorInfo" and "errorCode"
- * variables are left alone and deleted later.
- *
- *----------------------------------------------------------------------
- */
-
- internal static void teardownNamespace(Namespace ns)
- {
- Interp interp = ns.interp;
- IEnumerator search;
- Namespace globalNs = getGlobalNamespace(interp);
- int i;
-
- // Start by destroying the namespace's variable table,
- // since variables might trigger traces.
-
- if (ns == globalNs)
- {
- // This is the global namespace, so be careful to preserve the
- // "errorInfo" and "errorCode" variables. These might be needed
- // later on if errors occur while deleting commands. We are careful
- // to destroy and recreate the "errorInfo" and "errorCode"
- // variables, in case they had any traces on them.
-
- string errorInfoStr, errorCodeStr;
-
- try
- {
-
- errorInfoStr = interp.getVar("errorInfo", TCL.VarFlag.GLOBAL_ONLY).ToString();
- }
- catch (TclException e)
- {
- errorInfoStr = null;
- }
-
- try
- {
-
- errorCodeStr = interp.getVar("errorCode", TCL.VarFlag.GLOBAL_ONLY).ToString();
- }
- catch (TclException e)
- {
- errorCodeStr = null;
- }
-
- Var.deleteVars(interp, ns.varTable);
-
- if ((System.Object) errorInfoStr != null)
- {
- try
- {
- interp.setVar("errorInfo", errorInfoStr, TCL.VarFlag.GLOBAL_ONLY);
- }
- catch (TclException e)
- {
- // ignore an exception while setting this var
- }
- }
- if ((System.Object) errorCodeStr != null)
- {
- try
- {
- interp.setVar("errorCode", errorCodeStr, TCL.VarFlag.GLOBAL_ONLY);
- }
- catch (TclException e)
- {
- // ignore an exception while setting this var
- }
- }
- }
- else
- {
- // Variable table should be cleared.
- Var.deleteVars(interp, ns.varTable);
- }
-
- // Remove the namespace from its parent's child hashtable.
-
- if (ns.parent != null)
- {
- ns.parent.childTable.Remove(ns.name);
- }
- ns.parent = null;
-
- // Delete all the child namespaces.
- //
- // BE CAREFUL: When each child is deleted, it will divorce
- // itself from its parent. You can't traverse a hash table
- // properly if its elements are being deleted. We use only
- // the Tcl_FirstHashEntry function to be safe.
-
- foreach (Namespace childNs in new ArrayList(ns.childTable.Values))
- {
- deleteNamespace(childNs);
- }
-
- // Delete all commands in this namespace. Be careful when traversing the
- // hash table: when each command is deleted, it removes itself from the
- // command table.
-
- // FIXME : double check that using an enumeration for a hashtable
- // that changes is ok in Java! Also call deleteCommand... correctly!
- foreach(WrappedCommand cmd in new ArrayList(ns.cmdTable.Values))
- {
- interp.deleteCommandFromToken(cmd);
- }
-
- ns.cmdTable.Clear();
-
- // Free the namespace's export pattern array.
-
- if (ns.exportArray != null)
- {
- ns.exportArray = null;
- ns.numExportPatterns = 0;
- ns.maxExportPatterns = 0;
- }
-
- // Callback invoked when namespace is deleted
-
- if (ns.deleteProc != null)
- {
- ns.deleteProc.delete();
- }
- ns.deleteProc = null;
-
- // Reset the namespace's id field to ensure that this namespace won't
- // be interpreted as valid by, e.g., the cache validation code for
- // cached command references in Tcl_GetCommandFromObj.
-
- ns.nsId = 0;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceFree -> free
- *
- * Called after a namespace has been deleted, when its
- * reference count reaches 0. Frees the data structure
- * representing the namespace.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- internal static void free(Namespace ns)
- {
- // Most of the namespace's contents are freed when the namespace is
- // deleted by Tcl_DeleteNamespace. All that remains is to free its names
- // (for error messages), and the structure itself.
-
- ns.name = null;
- ns.fullName = null;
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_Export -> exportList
- *
- * Makes all the commands matching a pattern available to later be
- * imported from the namespace specified by namespace (or the
- * current namespace if namespace is null). The specified pattern is
- * appended onto the namespace's export pattern list, which is
- * optionally cleared beforehand.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Appends the export pattern onto the namespace's export list.
- * Optionally reset the namespace's export pattern list.
- *
- *----------------------------------------------------------------------
- */
-
- internal static void exportList(Interp interp, Namespace namespace_Renamed, string pattern, bool resetListFirst)
- {
- int INIT_EXPORT_PATTERNS = 5;
- Namespace ns, exportNs;
- Namespace currNs = getCurrentNamespace(interp);
- string simplePattern, patternCpy;
- int neededElems, len, i;
-
- // If the specified namespace is null, use the current namespace.
-
- if (namespace_Renamed == null)
- {
- ns = currNs;
- }
- else
- {
- ns = namespace_Renamed;
- }
-
- // If resetListFirst is true (nonzero), clear the namespace's export
- // pattern list.
-
- if (resetListFirst)
- {
- if (ns.exportArray != null)
- {
- for (i = 0; i < ns.numExportPatterns; i++)
- {
- ns.exportArray[i] = null;
- }
- ns.exportArray = null;
- ns.numExportPatterns = 0;
- ns.maxExportPatterns = 0;
- }
- }
-
- // Check that the pattern doesn't have namespace qualifiers.
-
- // Java does not support passing an address so we pass
- // an array of size 1 and then assign arr[0] to the value
- Namespace[] exportNsArr = new Namespace[1];
- Namespace[] dummyArr = new Namespace[1];
- string[] simplePatternArr = new string[1];
-
- getNamespaceForQualName(interp, pattern, ns, TCL.VarFlag.LEAVE_ERR_MSG, exportNsArr, dummyArr, dummyArr, simplePatternArr);
-
- // get the values out of the arrays
-
- exportNs = exportNsArr[0];
- simplePattern = simplePatternArr[0];
-
- if ((exportNs != ns) || (pattern.CompareTo(simplePattern) != 0))
- {
- throw new TclException(interp, "invalid export pattern \"" + pattern + "\": pattern can't specify a namespace");
- }
-
- // Make sure there is room in the namespace's pattern array for the
- // new pattern.
-
- neededElems = ns.numExportPatterns + 1;
- if (ns.exportArray == null)
- {
- ns.exportArray = new string[INIT_EXPORT_PATTERNS];
- ns.numExportPatterns = 0;
- ns.maxExportPatterns = INIT_EXPORT_PATTERNS;
- }
- else if (neededElems > ns.maxExportPatterns)
- {
- int numNewElems = 2 * ns.maxExportPatterns;
- string[] newArray = new string[numNewElems];
- Array.Copy((System.Array) ns.exportArray, 0, (System.Array) newArray, 0, ns.numExportPatterns);
- ns.exportArray = newArray;
- ns.maxExportPatterns = numNewElems;
- }
-
- // Add the pattern to the namespace's array of export patterns.
-
- ns.exportArray[ns.numExportPatterns] = pattern;
- ns.numExportPatterns++;
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_AppendExportList -> appendExportList
- *
- * Appends onto the argument object the list of export patterns for the
- * specified namespace.
- *
- * Results:
- * The method will return when successful; in this case the object
- * referenced by obj has each export pattern appended to it. If an
- * error occurs, an exception and the interpreter's result
- * holds an error message.
- *
- * Side effects:
- * If necessary, the object referenced by obj is converted into
- * a list object.
- *
- *----------------------------------------------------------------------
- */
-
- internal static void appendExportList(Interp interp, Namespace namespace_Renamed, TclObject obj)
- {
- Namespace ns;
- int i;
-
- // If the specified namespace is null, use the current namespace.
-
- if (namespace_Renamed == null)
- {
- ns = getCurrentNamespace(interp);
- }
- else
- {
- ns = namespace_Renamed;
- }
-
- // Append the export pattern list onto objPtr.
-
- for (i = 0; i < ns.numExportPatterns; i++)
- {
- TclList.append(interp, obj, TclString.newInstance(ns.exportArray[i]));
- }
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_Import -> importList
- *
- * Imports all of the commands matching a pattern into the namespace
- * specified by namespace (or the current namespace if namespace
- * is null). This is done by creating a new command (the "imported
- * command") that points to the real command in its original namespace.
- *
- * If matching commands are on the autoload path but haven't been
- * loaded yet, this command forces them to be loaded, then creates
- * the links to them.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Creates new commands in the importing namespace. These indirect
- * calls back to the real command and are deleted if the real commands
- * are deleted.
- *
- *----------------------------------------------------------------------
- */
-
- internal static void importList(Interp interp, Namespace namespace_Renamed, string pattern, bool allowOverwrite)
- {
- Namespace ns, importNs;
- Namespace currNs = getCurrentNamespace(interp);
- string simplePattern, cmdName;
- IEnumerator search;
- WrappedCommand cmd, realCmd;
- ImportRef ref_Renamed;
- WrappedCommand autoCmd, importedCmd;
- ImportedCmdData data;
- bool wasExported;
- int i, result;
-
- // If the specified namespace is null, use the current namespace.
-
- if (namespace_Renamed == null)
- {
- ns = currNs;
- }
- else
- {
- ns = namespace_Renamed;
- }
-
- // First, invoke the "auto_import" command with the pattern
- // being imported. This command is part of the Tcl library.
- // It looks for imported commands in autoloaded libraries and
- // loads them in. That way, they will be found when we try
- // to create links below.
-
- autoCmd = findCommand(interp, "auto_import", null, TCL.VarFlag.GLOBAL_ONLY);
-
- if (autoCmd != null)
- {
- TclObject[] objv = new TclObject[2];
-
- objv[0] = TclString.newInstance("auto_import");
- objv[0].preserve();
- objv[1] = TclString.newInstance(pattern);
- objv[1].preserve();
-
- cmd = autoCmd;
- try
- {
- // Invoke the command with the arguments
- cmd.cmd.cmdProc(interp, objv);
- }
- finally
- {
- objv[0].release();
- objv[1].release();
- }
-
- interp.resetResult();
- }
-
- // From the pattern, find the namespace from which we are importing
- // and get the simple pattern (no namespace qualifiers or ::'s) at
- // the end.
-
- if (pattern.Length == 0)
- {
- throw new TclException(interp, "empty import pattern");
- }
-
- // Java does not support passing an address so we pass
- // an array of size 1 and then assign arr[0] to the value
- Namespace[] importNsArr = new Namespace[1];
- Namespace[] dummyArr = new Namespace[1];
- string[] simplePatternArr = new string[1];
-
- getNamespaceForQualName(interp, pattern, ns, TCL.VarFlag.LEAVE_ERR_MSG, importNsArr, dummyArr, dummyArr, simplePatternArr);
-
- importNs = importNsArr[0];
- simplePattern = simplePatternArr[0];
-
- if (importNs == null)
- {
- throw new TclException(interp, "unknown namespace in import pattern \"" + pattern + "\"");
- }
- if (importNs == ns)
- {
- if ((System.Object) pattern == (System.Object) simplePattern)
- {
- throw new TclException(interp, "no namespace specified in import pattern \"" + pattern + "\"");
- }
- else
- {
- throw new TclException(interp, "import pattern \"" + pattern + "\" tries to import from namespace \"" + importNs.name + "\" into itself");
- }
- }
-
- // Scan through the command table in the source namespace and look for
- // exported commands that match the string pattern. Create an "imported
- // command" in the current namespace for each imported command; these
- // commands redirect their invocations to the "real" command.
-
-
- for (search = importNs.cmdTable.Keys.GetEnumerator(); search.MoveNext(); )
- {
-
- cmdName = ((string) search.Current);
- if (Util.stringMatch(cmdName, simplePattern))
- {
- // The command cmdName in the source namespace matches the
- // pattern. Check whether it was exported. If it wasn't,
- // we ignore it.
-
- wasExported = false;
- for (i = 0; i < importNs.numExportPatterns; i++)
- {
- if (Util.stringMatch(cmdName, importNs.exportArray[i]))
- {
- wasExported = true;
- break;
- }
- }
- if (!wasExported)
- {
- continue;
- }
-
- // Unless there is a name clash, create an imported command
- // in the current namespace that refers to cmdPtr.
-
- if ((ns.cmdTable[cmdName] == null) || allowOverwrite)
- {
- // Create the imported command and its client data.
- // To create the new command in the current namespace,
- // generate a fully qualified name for it.
-
- System.Text.StringBuilder ds;
-
- ds = new System.Text.StringBuilder();
- ds.Append(ns.fullName);
- if (ns != interp.globalNs)
- {
- ds.Append("::");
- }
- ds.Append(cmdName);
-
- // Check whether creating the new imported command in the
- // current namespace would create a cycle of imported->real
- // command references that also would destroy an existing
- // "real" command already in the current namespace.
-
- cmd = (WrappedCommand) importNs.cmdTable[cmdName];
-
- if (cmd.cmd is ImportedCmdData)
- {
- // This is actually an imported command, find
- // the real command it references
- realCmd = getOriginalCommand(cmd);
- if ((realCmd != null) && (realCmd.ns == currNs) && (currNs.cmdTable[cmdName] != null))
- {
- throw new TclException(interp, "import pattern \"" + pattern + "\" would create a loop containing command \"" + ds.ToString() + "\"");
- }
- }
-
- data = new ImportedCmdData();
-
- // Create the imported command inside the interp
- interp.createCommand(ds.ToString(), data);
-
- // Lookup in the namespace for the new WrappedCommand
- importedCmd = findCommand(interp, ds.ToString(), ns, (TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.LEAVE_ERR_MSG));
-
- data.realCmd = cmd;
- data.self = importedCmd;
-
- // Create an ImportRef structure describing this new import
- // command and add it to the import ref list in the "real"
- // command.
-
- ref_Renamed = new ImportRef();
- ref_Renamed.importedCmd = importedCmd;
- ref_Renamed.next = cmd.importRef;
- cmd.importRef = ref_Renamed;
- }
- else
- {
- throw new TclException(interp, "can't import command \"" + cmdName + "\": already exists");
- }
- }
- }
- return ;
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_ForgetImport -> forgetImport
- *
- * Deletes previously imported commands. Given a pattern that may
- * include the name of an exporting namespace, this procedure first
- * finds all matching exported commands. It then looks in the namespace
- * specified by namespace for any corresponding previously imported
- * commands, which it deletes. If namespace is null, commands are
- * deleted from the current namespace.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * May delete commands.
- *
- *----------------------------------------------------------------------
- */
-
- internal static void forgetImport(Interp interp, Namespace namespace_Renamed, string pattern)
- {
- Namespace ns, importNs, actualCtx;
- string simplePattern, cmdName;
- IEnumerator search;
- WrappedCommand cmd;
-
- // If the specified namespace is null, use the current namespace.
-
- if (namespace_Renamed == null)
- {
- ns = getCurrentNamespace(interp);
- }
- else
- {
- ns = namespace_Renamed;
- }
-
- // From the pattern, find the namespace from which we are importing
- // and get the simple pattern (no namespace qualifiers or ::'s) at
- // the end.
-
- // Java does not support passing an address so we pass
- // an array of size 1 and then assign arr[0] to the value
- Namespace[] importNsArr = new Namespace[1];
- Namespace[] dummyArr = new Namespace[1];
- Namespace[] actualCtxArr = new Namespace[1];
- string[] simplePatternArr = new string[1];
-
- getNamespaceForQualName(interp, pattern, ns, TCL.VarFlag.LEAVE_ERR_MSG, importNsArr, dummyArr, actualCtxArr, simplePatternArr);
-
- // get the values out of the arrays
- importNs = importNsArr[0];
- actualCtx = actualCtxArr[0];
- simplePattern = simplePatternArr[0];
-
- // FIXME : the above call passes TCL.VarFlag.LEAVE_ERR_MSG, but
- // it seems like this will be a problem when exception is raised!
- if (importNs == null)
- {
- throw new TclException(interp, "unknown namespace in namespace forget pattern \"" + pattern + "\"");
- }
-
- // Scan through the command table in the source namespace and look for
- // exported commands that match the string pattern. If the current
- // namespace has an imported command that refers to one of those real
- // commands, delete it.
-
-
- for (search = importNs.cmdTable.Keys.GetEnumerator(); search.MoveNext(); )
- {
-
- cmdName = ((string) search.Current);
- if (Util.stringMatch(cmdName, simplePattern))
- {
- cmd = (WrappedCommand) ns.cmdTable[cmdName];
- if (cmd != null)
- {
- // cmd of same name in current namespace
- if (cmd.cmd is ImportedCmdData)
- {
- interp.deleteCommandFromToken(cmd);
- }
- }
- }
- }
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * TclGetOriginalCommand -> getOriginalCommand
- *
- * An imported command is created in a namespace when a "real" command
- * is imported from another namespace. If the specified command is an
- * imported command, this procedure returns the original command it
- * refers to.
- *
- * Results:
- * If the command was imported into a sequence of namespaces a, b,...,n
- * where each successive namespace just imports the command from the
- * previous namespace, this procedure returns the Tcl_Command token in
- * the first namespace, a. Otherwise, if the specified command is not
- * an imported command, the procedure returns null.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- internal static WrappedCommand getOriginalCommand(WrappedCommand command)
- {
- WrappedCommand cmd = command;
- ImportedCmdData data;
-
- if (!(cmd.cmd is ImportedCmdData))
- {
- return null;
- }
-
- while (cmd.cmd is ImportedCmdData)
- {
- data = (ImportedCmdData) cmd.cmd;
- cmd = data.realCmd;
- }
- return cmd;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * InvokeImportedCmd -> invokeImportedCmd
- *
- * Invoked by Tcl whenever the user calls an imported command that
- * was created by Tcl_Import. Finds the "real" command (in another
- * namespace), and passes control to it.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Returns a result in the interpreter's result object. If anything
- * goes wrong, the result object is set to an error message.
- *
- *----------------------------------------------------------------------
- */
-
- internal static void invokeImportedCmd(Interp interp, ImportedCmdData data, TclObject[] objv)
- {
- WrappedCommand realCmd = data.realCmd;
- realCmd.cmd.cmdProc(interp, objv);
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * DeleteImportedCmd -> deleteImportedCmd
- *
- * Invoked by Tcl whenever an imported command is deleted. The "real"
- * command keeps a list of all the imported commands that refer to it,
- * so those imported commands can be deleted when the real command is
- * deleted. This procedure removes the imported command reference from
- * the real command's list, and frees up the memory associated with
- * the imported command.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Removes the imported command from the real command's import list.
- *
- *----------------------------------------------------------------------
- */
-
- internal static void deleteImportedCmd(ImportedCmdData data)
- // The data object for this imported command
- {
- WrappedCommand realCmd = data.realCmd;
- WrappedCommand self = data.self;
- ImportRef ref_Renamed, prev;
-
- prev = null;
- for (ref_Renamed = realCmd.importRef; ref_Renamed != null; ref_Renamed = ref_Renamed.next)
- {
- if (ref_Renamed.importedCmd == self)
- {
- // Remove ref from real command's list of imported commands
- // that refer to it.
-
- if (prev == null)
- {
- // ref is first in list
- realCmd.importRef = ref_Renamed.next;
- }
- else
- {
- prev.next = ref_Renamed.next;
- }
- ref_Renamed = null;
- data = null;
- return ;
- }
- prev = ref_Renamed;
- }
-
- throw new TclRuntimeError("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * TclGetNamespaceForQualName -> getNamespaceForQualName
- *
- * Given a qualified name specifying a command, variable, or namespace,
- * and a namespace in which to resolve the name, this procedure returns
- * a pointer to the namespace that contains the item. A qualified name
- * consists of the "simple" name of an item qualified by the names of
- * an arbitrary number of containing namespace separated by "::"s. If
- * the qualified name starts with "::", it is interpreted absolutely
- * from the global namespace. Otherwise, it is interpreted relative to
- * the namespace specified by cxtNsPtr if it is non-null. If cxtNsPtr
- * is null, the name is interpreted relative to the current namespace.
- *
- * A relative name like "foo::bar::x" can be found starting in either
- * the current namespace or in the global namespace. So each search
- * usually follows two tracks, and two possible namespaces are
- * returned. If the procedure sets either nsPtrPtr[0] or altNsPtrPtr[0] to
- * null, then that path failed.
- *
- * If "flags" contains TCL.VarFlag.GLOBAL_ONLY, the relative qualified name is
- * sought only in the global :: namespace. The alternate search
- * (also) starting from the global namespace is ignored and
- * altNsPtrPtr[0] is set null.
- *
- * If "flags" contains TCL.VarFlag.NAMESPACE_ONLY, the relative qualified
- * name is sought only in the namespace specified by cxtNsPtr. The
- * alternate search starting from the global namespace is ignored and
- * altNsPtrPtr[0] is set null. If both TCL.VarFlag.GLOBAL_ONLY and
- * TCL.VarFlag.NAMESPACE_ONLY are specified, TCL.VarFlag.GLOBAL_ONLY is ignored and
- * the search starts from the namespace specified by cxtNsPtr.
- *
- * If "flags" contains TCL.VarFlag.CREATE_NS_IF_UNKNOWN, all namespace
- * components of the qualified name that cannot be found are
- * automatically created within their specified parent. This makes sure
- * that functions like Tcl_CreateCommand always succeed. There is no
- * alternate search path, so altNsPtrPtr[0] is set null.
- *
- * If "flags" contains TCL.VarFlag.FIND_ONLY_NS, the qualified name is treated as a
- * reference to a namespace, and the entire qualified name is
- * followed. If the name is relative, the namespace is looked up only
- * in the current namespace. A pointer to the namespace is stored in
- * nsPtrPtr[0] and null is stored in simpleNamePtr[0]. Otherwise, if
- * TCL.VarFlag.FIND_ONLY_NS is not specified, only the leading components are
- * treated as namespace names, and a pointer to the simple name of the
- * final component is stored in simpleNamePtr[0].
- *
- * Results:
- * It sets nsPtrPtr[0] and altNsPtrPtr[0] to point to the two possible
- * namespaces which represent the last (containing) namespace in the
- * qualified name. If the procedure sets either nsPtrPtr[0] or altNsPtrPtr[0]
- * to null, then the search along that path failed. The procedure also
- * stores a pointer to the simple name of the final component in
- * simpleNamePtr[0]. If the qualified name is "::" or was treated as a
- * namespace reference (TCL.VarFlag.FIND_ONLY_NS), the procedure stores a pointer
- * to the namespace in nsPtrPtr[0], null in altNsPtrPtr[0], and sets
- * simpleNamePtr[0] to an empty string.
- *
- * If there is an error, this procedure returns TCL_ERROR. If "flags"
- * contains TCL_LEAVE_ERR_MSG, an error message is returned in the
- * interpreter's result object. Otherwise, the interpreter's result
- * object is left unchanged.
- *
- * actualCxtPtrPtr[0] is set to the actual context namespace. It is
- * set to the input context namespace pointer in cxtNsPtr. If cxtNsPtr
- * is null, it is set to the current namespace context.
- *
- * Side effects:
- * If "flags" contains TCL.VarFlag.CREATE_NS_IF_UNKNOWN, new namespaces may be
- * created.
- *
- *----------------------------------------------------------------------
- */
-
- internal static void getNamespaceForQualName(Interp interp, string qualName, Namespace cxtNsPtr, TCL.VarFlag flags, Namespace[] nsPtrPtr, Namespace[] altNsPtrPtr, Namespace[] actualCxtPtrPtr, string[] simpleNamePtr)
- {
-
-
- // FIXME : remove extra method call checks when we are sure this works!
-
- if (true)
- {
- // check invariants
- if ((nsPtrPtr == null) || (nsPtrPtr.Length != 1))
- {
-
- throw new System.SystemException("nsPtrPtr " + nsPtrPtr);
- }
- if ((altNsPtrPtr == null) || (altNsPtrPtr.Length != 1))
- {
-
- throw new System.SystemException("altNsPtrPtr " + altNsPtrPtr);
- }
- if ((actualCxtPtrPtr == null) || (actualCxtPtrPtr.Length != 1))
- {
-
- throw new System.SystemException("actualCxtPtrPtr " + actualCxtPtrPtr);
- }
- if ((simpleNamePtr == null) || (simpleNamePtr.Length != 1))
- {
-
- throw new System.SystemException("simpleNamePtr " + simpleNamePtr);
- }
- }
-
-
-
-
- Namespace ns = cxtNsPtr;
- Namespace altNs;
- Namespace globalNs = getGlobalNamespace(interp);
- Namespace entryNs;
- string start, end;
- string nsName;
- int len;
- int start_ind, end_ind, name_len;
-
- // Determine the context namespace ns in which to start the primary
- // search. If TCL.VarFlag.NAMESPACE_ONLY or TCL.VarFlag.FIND_ONLY_NS was specified, search
- // from the current namespace. If the qualName name starts with a "::"
- // or TCL.VarFlag.GLOBAL_ONLY was specified, search from the global
- // namespace. Otherwise, use the given namespace given in cxtNsPtr, or
- // if that is null, use the current namespace context. Note that we
- // always treat two or more adjacent ":"s as a namespace separator.
-
- if ((flags & (TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.FIND_ONLY_NS)) != 0)
- {
- ns = getCurrentNamespace(interp);
- }
- else if ((flags & TCL.VarFlag.GLOBAL_ONLY) != 0)
- {
- ns = globalNs;
- }
- else if (ns == null)
- {
- if (interp.varFrame != null)
- {
- ns = interp.varFrame.ns;
- }
- else
- {
- ns = interp.globalNs;
- }
- }
-
-
-
- start_ind = 0;
- name_len = qualName.Length;
-
- if ((name_len >= 2) && (qualName[0] == ':') && (qualName[1] == ':'))
- {
- start_ind = 2; // skip over the initial ::
-
- while ((start_ind < name_len) && (qualName[start_ind] == ':'))
- {
- start_ind++; // skip over a subsequent :
- }
-
- ns = globalNs;
- if (start_ind >= name_len)
- {
- // qualName is just two or more ":"s
- nsPtrPtr[0] = globalNs;
- altNsPtrPtr[0] = null;
- actualCxtPtrPtr[0] = globalNs;
- simpleNamePtr[0] = ""; // points to empty string
- return ;
- }
- }
- actualCxtPtrPtr[0] = ns;
-
-
- // Start an alternate search path starting with the global namespace.
- // However, if the starting context is the global namespace, or if the
- // flag is set to search only the namespace cxtNs, ignore the
- // alternate search path.
-
-
- altNs = globalNs;
- if ((ns == globalNs) || ((flags & (TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.FIND_ONLY_NS)) != 0))
- {
- altNs = null;
- }
-
-
- // Loop to resolve each namespace qualifier in qualName.
-
- end_ind = start_ind;
-
- while (start_ind < name_len)
- {
- // Find the next namespace qualifier (i.e., a name ending in "::")
- // or the end of the qualified name (i.e., a name ending in "\0").
- // Set len to the number of characters, starting from start,
- // in the name; set end to point after the "::"s or at the "\0".
-
- len = 0;
- for (end_ind = start_ind; end_ind < name_len; end_ind++)
- {
- if (((name_len - end_ind) > 1) && (qualName[end_ind] == ':') && (qualName[end_ind + 1] == ':'))
- {
- end_ind += 2; // skip over the initial ::
- while ((end_ind < name_len) && (qualName[end_ind] == ':'))
- {
- end_ind++; // skip over a subsequent :
- }
- break;
- }
- len++;
- }
-
-
- if ((end_ind == name_len) && !((end_ind - start_ind >= 2) && ((qualName[end_ind - 1] == ':') && (qualName[end_ind - 2] == ':'))))
- {
-
- // qualName ended with a simple name at start. If TCL.VarFlag.FIND_ONLY_NS
- // was specified, look this up as a namespace. Otherwise,
- // start is the name of a cmd or var and we are done.
-
- if ((flags & TCL.VarFlag.FIND_ONLY_NS) != 0)
- {
- // assign the string from start_ind to the end of the name string
- nsName = qualName.Substring(start_ind);
- }
- else
- {
- nsPtrPtr[0] = ns;
- altNsPtrPtr[0] = altNs;
- simpleNamePtr[0] = qualName.Substring(start_ind);
- return ;
- }
- }
- else
- {
- // start points to the beginning of a namespace qualifier ending
- // in "::". Create new string with the namespace qualifier.
-
- nsName = qualName.Substring(start_ind, (start_ind + len) - (start_ind));
- }
-
-
-
- // Look up the namespace qualifier nsName in the current namespace
- // context. If it isn't found but TCL.VarFlag.CREATE_NS_IF_UNKNOWN is set,
- // create that qualifying namespace. This is needed for procedures
- // like Tcl_CreateCommand that cannot fail.
-
- if (ns != null)
- {
- entryNs = (Namespace) ns.childTable[nsName];
- if (entryNs != null)
- {
- ns = entryNs;
- }
- else if ((flags & TCL.VarFlag.CREATE_NS_IF_UNKNOWN) != 0)
- {
- CallFrame frame = interp.newCallFrame();
-
- pushCallFrame(interp, frame, ns, false);
- ns = createNamespace(interp, nsName, null);
-
- popCallFrame(interp);
- if (ns == null)
- {
- throw new System.SystemException("Could not create namespace " + nsName);
- }
- }
- else
- {
- ns = null; // namespace not found and wasn't created
- }
- }
-
-
- // Look up the namespace qualifier in the alternate search path too.
-
- if (altNs != null)
- {
- altNs = (Namespace) altNs.childTable[nsName];
- }
-
- // If both search paths have failed, return null results.
-
- if ((ns == null) && (altNs == null))
- {
- nsPtrPtr[0] = null;
- altNsPtrPtr[0] = null;
- simpleNamePtr[0] = null;
- return ;
- }
-
- start_ind = end_ind;
- }
-
-
- // We ignore trailing "::"s in a namespace name, but in a command or
- // variable name, trailing "::"s refer to the cmd or var named {}.
-
- if (((flags & TCL.VarFlag.FIND_ONLY_NS) != 0) || ((end_ind > start_ind) && (qualName[end_ind - 1] != ':')))
- {
- simpleNamePtr[0] = null; // found namespace name
- }
- else
- {
- // FIXME : make sure this does not throw exception when end_ind is at the end of the string
- simpleNamePtr[0] = qualName.Substring(end_ind); // found cmd/var: points to empty string
- }
-
-
- // As a special case, if we are looking for a namespace and qualName
- // is "" and the current active namespace (ns) is not the global
- // namespace, return null (no namespace was found). This is because
- // namespaces can not have empty names except for the global namespace.
-
- if (((flags & TCL.VarFlag.FIND_ONLY_NS) != 0) && (name_len == 0) && (ns != globalNs))
- {
- ns = null;
- }
-
- nsPtrPtr[0] = ns;
- altNsPtrPtr[0] = altNs;
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_FindNamespace -> findNamespace
- *
- * Searches for a namespace.
- *
- * Results:T
- * Returns a reference to the namespace if it is found. Otherwise,
- * returns null and leaves an error message in the interpreter's
- * result object if "flags" contains TCL.VarFlag.LEAVE_ERR_MSG.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- internal static Namespace findNamespace(Interp interp, string name, Namespace contextNs, TCL.VarFlag flags)
- {
- Namespace ns;
-
- // Java does not support passing an address so we pass
- // an array of size 1 and then assign arr[0] to the value
- Namespace[] nsArr = new Namespace[1];
- Namespace[] dummy1Arr = new Namespace[1];
- string[] dummy2Arr = new string[1];
-
- // Find the namespace(s) that contain the specified namespace name.
- // Add the TCL.VarFlag.FIND_ONLY_NS flag to resolve the name all the way down
- // to its last component, a namespace.
-
- getNamespaceForQualName(interp, name, contextNs, (flags | TCL.VarFlag.FIND_ONLY_NS), nsArr, dummy1Arr, dummy1Arr, dummy2Arr);
-
-
- // Get the values out of the arrays!
- ns = nsArr[0];
-
- if (ns != null)
- {
- return ns;
- }
- else if ((flags & TCL.VarFlag.LEAVE_ERR_MSG) != 0)
- {
- /*
- interp.resetResult();
- TclString.append(interp.getResult(), "unknown namespace \"" + name + "\"");
- */
-
- // FIXME : is there a test case for this error?
- interp.setResult("unknown namespace \"" + name + "\"");
- }
- return null;
- }
-
-
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_FindCommand -> findCommand
- *
- * Searches for a command.
- *
- * Results:
- * Returns a token for the command if it is found. Otherwise, if it
- * can't be found or there is an error, returns null and leaves an
- * error message in the interpreter's result object if "flags"
- * contains TCL.VarFlag.LEAVE_ERR_MSG.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- internal static WrappedCommand findCommand(Interp interp, string name, Namespace contextNs, TCL.VarFlag flags)
- {
- Interp.ResolverScheme res;
- Namespace cxtNs;
- Namespace[] ns = new Namespace[2];
- string simpleName;
- int search;
- //int result;
- WrappedCommand cmd;
-
- // If this namespace has a command resolver, then give it first
- // crack at the command resolution. If the interpreter has any
- // command resolvers, consult them next. The command resolver
- // procedures may return a Tcl_Command value, they may signal
- // to continue onward, or they may signal an error.
-
- if ((flags & TCL.VarFlag.GLOBAL_ONLY) != 0)
- {
- cxtNs = getGlobalNamespace(interp);
- }
- else if (contextNs != null)
- {
- cxtNs = contextNs;
- }
- else
- {
- cxtNs = getCurrentNamespace(interp);
- }
-
- if (cxtNs.resolver != null || interp.resolvers != null)
- {
- try
- {
- if (cxtNs.resolver != null)
- {
- cmd = cxtNs.resolver.resolveCmd(interp, name, cxtNs, flags);
- }
- else
- {
- cmd = null;
- }
-
- if (cmd == null && interp.resolvers != null)
- {
- IEnumerator enum_Renamed = interp.resolvers.GetEnumerator();
- while (cmd == null && enum_Renamed.MoveNext())
- {
- res = (Interp.ResolverScheme) enum_Renamed.Current;
- cmd = res.resolver.resolveCmd(interp, name, cxtNs, flags);
- }
- }
-
- if (cmd != null)
- {
- return cmd;
- }
- }
- catch (TclException e)
- {
- return null;
- }
- }
-
- // Java does not support passing an address so we pass
- // an array of size 1 and then assign arr[0] to the value
- Namespace[] ns0Arr = new Namespace[1];
- Namespace[] ns1Arr = new Namespace[1];
- Namespace[] cxtNsArr = new Namespace[1];
- string[] simpleNameArr = new string[1];
-
-
- // Find the namespace(s) that contain the command.
-
- getNamespaceForQualName(interp, name, contextNs, flags, ns0Arr, ns1Arr, cxtNsArr, simpleNameArr);
-
- // Get the values out of the arrays!
- ns[0] = ns0Arr[0];
- ns[1] = ns1Arr[0];
- cxtNs = cxtNsArr[0];
- simpleName = simpleNameArr[0];
-
-
-
- // Look for the command in the command table of its namespace.
- // Be sure to check both possible search paths: from the specified
- // namespace context and from the global namespace.
-
- cmd = null;
- for (search = 0; (search < 2) && (cmd == null); search++)
- {
- if ((ns[search] != null) && ((System.Object) simpleName != null))
- {
- cmd = (WrappedCommand) ns[search].cmdTable[simpleName];
- }
- }
- if (cmd != null)
- {
- return cmd;
- }
- else if ((flags & TCL.VarFlag.LEAVE_ERR_MSG) != 0)
- {
- throw new TclException(interp, "unknown command \"" + name + "\"");
- }
-
- return null;
- }
-
-
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_FindNamespaceVar -> findNamespaceVar
- *
- * Searches for a namespace variable, a variable not local to a
- * procedure. The variable can be either a scalar or an array, but
- * may not be an element of an array.
- *
- * Results:
- * Returns a token for the variable if it is found. Otherwise, if it
- * can't be found or there is an error, returns null and leaves an
- * error message in the interpreter's result object if "flags"
- * contains TCL.VarFlag.LEAVE_ERR_MSG.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- internal static Var findNamespaceVar(Interp interp, string name, Namespace contextNs,TCL.VarFlag flags)
- {
- Interp.ResolverScheme res;
- Namespace cxtNs;
- Namespace[] ns = new Namespace[2];
- string simpleName;
- int search;
- //int result;
- Var var;
-
- // If this namespace has a variable resolver, then give it first
- // crack at the variable resolution. It may return a Tcl_Var
- // value, it may signal to continue onward, or it may signal
- // an error.
-
- if ((flags & TCL.VarFlag.GLOBAL_ONLY) != 0)
- {
- cxtNs = getGlobalNamespace(interp);
- }
- else if (contextNs != null)
- {
- cxtNs = contextNs;
- }
- else
- {
- cxtNs = getCurrentNamespace(interp);
- }
-
- if (cxtNs.resolver != null || interp.resolvers != null)
- {
- try
- {
- if (cxtNs.resolver != null)
- {
- var = cxtNs.resolver.resolveVar(interp, name, cxtNs, flags);
- }
- else
- {
- var = null;
- }
-
- if (var == null && interp.resolvers != null)
- {
- IEnumerator enum_Renamed = interp.resolvers.GetEnumerator();
- while (var == null && enum_Renamed.MoveNext())
- {
- res = (Interp.ResolverScheme) enum_Renamed.Current;
- var = res.resolver.resolveVar(interp, name, cxtNs, flags);
- }
- }
-
- if (var != null)
- {
- return var;
- }
- }
- catch (TclException e)
- {
- return null;
- }
- }
-
- // Java does not support passing an address so we pass
- // an array of size 1 and then assign arr[0] to the value
- Namespace[] ns0Arr = new Namespace[1];
- Namespace[] ns1Arr = new Namespace[1];
- Namespace[] cxtNsArr = new Namespace[1];
- string[] simpleNameArr = new string[1];
-
-
- // Find the namespace(s) that contain the variable.
-
- getNamespaceForQualName(interp, name, contextNs, flags, ns0Arr, ns1Arr, cxtNsArr, simpleNameArr);
-
- // Get the values out of the arrays!
- ns[0] = ns0Arr[0];
- ns[1] = ns1Arr[0];
- cxtNs = cxtNsArr[0];
- simpleName = simpleNameArr[0];
-
-
- // Look for the variable in the variable table of its namespace.
- // Be sure to check both possible search paths: from the specified
- // namespace context and from the global namespace.
-
- var = null;
- for (search = 0; (search < 2) && (var == null); search++)
- {
- if ((ns[search] != null) && ((System.Object) simpleName != null))
- {
- var = (Var) ns[search].varTable[simpleName];
- }
- }
- if (var != null)
- {
- return var;
- }
- else if ((flags & TCL.VarFlag.LEAVE_ERR_MSG) != 0)
- {
- /*
- interp.resetResult();
- TclString.append(interp.getResult(), "unknown variable \"" + name + "\"");
- */
-
- // FIXME : is there a test case for this error?
- interp.setResult("unknown variable \"" + name + "\"");
- }
- return null;
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * GetNamespaceFromObj -> getNamespaceFromObj
- *
- * Returns the namespace specified by the name in a TclObject.
- *
- * Results:
- * This method will return the Namespace object whose name
- * is stored in the obj argument. If the namespace can't be found,
- * a TclException is raised.
- *
- * Side effects:
- * May update the internal representation for the object, caching the
- * namespace reference. The next time this procedure is called, the
- * namespace value can be found quickly.
- *
- * If anything goes wrong, an error message is left in the
- * interpreter's result object.
- *
- *----------------------------------------------------------------------
- */
-
- internal static Namespace getNamespaceFromObj(Interp interp, TclObject obj)
- {
- ResolvedNsName resName;
- Namespace ns;
- Namespace currNs = getCurrentNamespace(interp);
- int result;
-
- // Get the internal representation, converting to a namespace type if
- // needed. The internal representation is a ResolvedNsName that points
- // to the actual namespace.
-
- // FIXME : if NamespaceCmd is not the internal rep this needs to be changed!
- if (!(obj.InternalRep is NamespaceCmd))
- {
- setNsNameFromAny(interp, obj);
- }
- resName = ((NamespaceCmd) obj.InternalRep).otherValue;
-
- // Check the context namespace of the resolved symbol to make sure that
- // it is fresh. If not, then force another conversion to the namespace
- // type, to discard the old rep and create a new one. Note that we
- // verify that the namespace id of the cached namespace is the same as
- // the id when we cached it; this insures that the namespace wasn't
- // deleted and a new one created at the same address.
-
- ns = null;
- if ((resName != null) && (resName.refNs == currNs) && (resName.nsId == resName.ns.nsId))
- {
- ns = resName.ns;
- if ((ns.flags & NS_DEAD) != 0)
- {
- ns = null;
- }
- }
- if (ns == null)
- {
- // try again
- setNsNameFromAny(interp, obj);
- resName = ((NamespaceCmd) obj.InternalRep).otherValue;
- if (resName != null)
- {
- ns = resName.ns;
- if ((ns.flags & NS_DEAD) != 0)
- {
- ns = null;
- }
- }
- }
- return ns;
- }
-
- /// <summary>----------------------------------------------------------------------
- ///
- /// Tcl_SetNamespaceResolvers -> setNamespaceResolver
- ///
- /// Sets the command/variable resolution object for a namespace,
- /// thereby changing the way that command/variable names are
- /// interpreted. This allows extension writers to support different
- /// name resolution schemes, such as those for object-oriented
- /// packages.
- ///
- /// Command resolution is handled by the following method:
- ///
- /// resolveCmd (Interp interp, String name,
- /// NamespaceCmd.Namespace context, int flags)
- /// throws TclException;
- ///
- /// Whenever a command is executed or NamespaceCmd.findCommand is invoked
- /// within the namespace, this method is called to resolve the
- /// command name. If this method is able to resolve the name,
- /// it should return the corresponding WrappedCommand. Otherwise,
- /// the procedure can return null, and the command will
- /// be treated under the usual name resolution rules. Or, it can
- /// throw a TclException, and the command will be considered invalid.
- ///
- /// Variable resolution is handled by the following method:
- ///
- /// resolveVar (Interp interp, String name,
- /// NamespaceCmd.Namespace context, int flags)
- /// throws TclException;
- ///
- /// If this method is able to resolve the name, it should return
- /// the variable as Var object. The method may also
- /// return null, and the variable will be treated under the usual
- /// name resolution rules. Or, it can throw a TclException,
- /// and the variable will be considered invalid.
- ///
- /// Results:
- /// See above.
- ///
- /// Side effects:
- /// None.
- ///
- /// ----------------------------------------------------------------------
- /// </summary>
-
- internal static void setNamespaceResolver(Namespace namespace_Renamed, Resolver resolver)
- // command and variable resolution
- {
- // Plug in the new command resolver.
-
- namespace_Renamed.resolver = resolver;
- }
-
- /// <summary>----------------------------------------------------------------------
- ///
- /// Tcl_GetNamespaceResolvers -> getNamespaceResolver
- ///
- /// Returns the current command/variable resolution object
- /// for a namespace. By default, these objects are null.
- /// New objects can be installed by calling setNamespaceResolver,
- /// to provide new name resolution rules.
- ///
- /// Results:
- /// Returns the esolver object assigned to this namespace.
- /// Returns null otherwise.
- ///
- /// Side effects:
- /// None.
- ///
- /// ----------------------------------------------------------------------
- /// </summary>
-
- internal static Resolver getNamespaceResolver(Namespace namespace_Renamed)
- // Namespace whose resolution rules
- // are being queried.
- {
- return namespace_Renamed.resolver;
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_NamespaceObjCmd -> cmdProc
- *
- * Invoked to implement the "namespace" command that creates, deletes,
- * or manipulates Tcl namespaces. Handles the following syntax:
- *
- * namespace children ?name? ?pattern?
- * namespace code arg
- * namespace current
- * namespace delete ?name name...?
- * namespace eval name arg ?arg...?
- * namespace export ?-clear? ?pattern pattern...?
- * namespace forget ?pattern pattern...?
- * namespace import ?-force? ?pattern pattern...?
- * namespace inscope name arg ?arg...?
- * namespace origin name
- * namespace parent ?name?
- * namespace qualifiers string
- * namespace tail string
- * namespace which ?-command? ?-variable? name
- *
- * Results:
- * Returns if the command is successful. Raises Exception if
- * anything goes wrong.
- *
- * Side effects:
- * Based on the subcommand name (e.g., "import"), this procedure
- * dispatches to a corresponding member commands in this class.
- * This method's side effects depend on whatever that subcommand does.
- *----------------------------------------------------------------------
- */
-
- private static readonly string[] validCmds = new string[]{"children", "code", "current", "delete", "eval", "export", "forget", "import", "inscope", "origin", "parent", "qualifiers", "tail", "which"};
-
- private const int OPT_CHILDREN = 0;
- private const int OPT_CODE = 1;
- private const int OPT_CURRENT = 2;
- private const int OPT_DELETE = 3;
- private const int OPT_EVAL = 4;
- private const int OPT_EXPORT = 5;
- private const int OPT_FORGET = 6;
- private const int OPT_IMPORT = 7;
- private const int OPT_INSCOPE = 8;
- private const int OPT_ORIGIN = 9;
- private const int OPT_PARENT = 10;
- private const int OPT_QUALIFIERS = 11;
- private const int OPT_TAIL = 12;
- private const int OPT_WHICH = 13;
-
-
- public TCL.CompletionCode cmdProc(Interp interp, TclObject[] objv)
- {
-
- int i, opt;
-
- if (objv.Length < 2)
- {
- throw new TclNumArgsException(interp, 1, objv, "subcommand ?arg ...?");
- }
-
- opt = TclIndex.get(interp, objv[1], validCmds, "option", 0);
-
- switch (opt)
- {
-
- case OPT_CHILDREN: {
- childrenCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_CODE: {
- codeCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_CURRENT: {
- currentCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_DELETE: {
- deleteCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_EVAL: {
- evalCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_EXPORT: {
- exportCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_FORGET: {
- forgetCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_IMPORT: {
- importCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_INSCOPE: {
- inscopeCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_ORIGIN: {
- originCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_PARENT: {
- parentCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_QUALIFIERS: {
- qualifiersCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_TAIL: {
- tailCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
-
- case OPT_WHICH: {
- whichCmd(interp, objv);
- return TCL.CompletionCode.RETURN;
- }
- } // end switch(opt)
- return TCL.CompletionCode.RETURN;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceChildrenCmd -> childrenCmd
- *
- * Invoked to implement the "namespace children" command that returns a
- * list containing the fully-qualified names of the child namespaces of
- * a given namespace. Handles the following syntax:
- *
- * namespace children ?name? ?pattern?
- *
- * Results:
- * Nothing.
- *
- * Side effects:
- * Returns a result in the interpreter's result object. If anything
- * goes wrong, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
- private static void childrenCmd(Interp interp, TclObject[] objv)
- {
- Namespace namespace_Renamed;
- Namespace ns;
- Namespace globalNs = getGlobalNamespace(interp);
- string pattern = null;
- System.Text.StringBuilder buffer;
- IEnumerator search;
- TclObject list, elem;
-
- // Get a pointer to the specified namespace, or the current namespace.
-
- if (objv.Length == 2)
- {
- ns = getCurrentNamespace(interp);
- }
- else if ((objv.Length == 3) || (objv.Length == 4))
- {
- ns = getNamespaceFromObj(interp, objv[2]);
- if (ns == null)
- {
-
- throw new TclException(interp, "unknown namespace \"" + objv[2].ToString() + "\" in namespace children command");
- }
- }
- else
- {
- throw new TclNumArgsException(interp, 2, objv, "?name? ?pattern?");
- }
-
- // Get the glob-style pattern, if any, used to narrow the search.
-
- buffer = new System.Text.StringBuilder();
- if (objv.Length == 4)
- {
-
- string name = objv[3].ToString();
-
- if (name.StartsWith("::"))
- {
- pattern = name;
- }
- else
- {
- buffer.Append(ns.fullName);
- if (ns != globalNs)
- {
- buffer.Append("::");
- }
- buffer.Append(name);
- pattern = buffer.ToString();
- }
- }
-
- // Create a list containing the full names of all child namespaces
- // whose names match the specified pattern, if any.
-
- list = TclList.newInstance();
- foreach (Namespace childNs in ns.childTable.Values) {
- if (((System.Object) pattern == null) || Util.stringMatch(childNs.fullName, pattern))
- {
- elem = TclString.newInstance(childNs.fullName);
- TclList.append(interp, list, elem);
- }
- }
- interp.setResult(list);
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceCodeCmd -> codeCmd
- *
- * Invoked to implement the "namespace code" command to capture the
- * namespace context of a command. Handles the following syntax:
- *
- * namespace code arg
- *
- * Here "arg" can be a list. "namespace code arg" produces a result
- * equivalent to that produced by the command
- *
- * list namespace inscope [namespace current] $arg
- *
- * However, if "arg" is itself a scoped value starting with
- * "namespace inscope", then the result is just "arg".
- *
- * Results:
- * Nothing.
- *
- * Side effects:
- * If anything goes wrong, this procedure returns an error
- * message as the result in the interpreter's result object.
- *
- *----------------------------------------------------------------------
- */
-
-
- private static void codeCmd(Interp interp, TclObject[] objv)
- {
- Namespace currNs;
- TclObject list, obj;
- string arg, p;
- int length;
- int p_ind;
-
- if (objv.Length != 3)
- {
- throw new TclNumArgsException(interp, 2, objv, "arg");
- }
-
- // If "arg" is already a scoped value, then return it directly.
-
-
- arg = objv[2].ToString();
- length = arg.Length;
-
- // FIXME : we need a test for this inscope code if there is not one already!
- if ((length > 17) && (arg[0] == 'n') && arg.StartsWith("namespace"))
- {
- for (p_ind = 9; (p_ind < length) && (arg[p_ind] == ' '); p_ind++)
- {
- // empty body: skip over spaces
- }
- if (((length - p_ind) >= 7) && (arg[p_ind] == 'i') && arg.Substring(p_ind).StartsWith("inscope"))
- {
- interp.setResult(objv[2]);
- return ;
- }
- }
-
- // Otherwise, construct a scoped command by building a list with
- // "namespace inscope", the full name of the current namespace, and
- // the argument "arg". By constructing a list, we ensure that scoped
- // commands are interpreted properly when they are executed later,
- // by the "namespace inscope" command.
-
- list = TclList.newInstance();
- TclList.append(interp, list, TclString.newInstance("namespace"));
- TclList.append(interp, list, TclString.newInstance("inscope"));
-
- currNs = getCurrentNamespace(interp);
- if (currNs == getGlobalNamespace(interp))
- {
- obj = TclString.newInstance("::");
- }
- else
- {
- obj = TclString.newInstance(currNs.fullName);
- }
-
- TclList.append(interp, list, obj);
- TclList.append(interp, list, objv[2]);
-
- interp.setResult(list);
- return ;
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceCurrentCmd -> currentCmd
- *
- * Invoked to implement the "namespace current" command which returns
- * the fully-qualified name of the current namespace. Handles the
- * following syntax:
- *
- * namespace current
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Returns a result in the interpreter's result object. If anything
- * goes wrong, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
- private static void currentCmd(Interp interp, TclObject[] objv)
- {
-
- Namespace currNs;
-
- if (objv.Length != 2)
- {
- throw new TclNumArgsException(interp, 2, objv, null);
- }
-
- // The "real" name of the global namespace ("::") is the null string,
- // but we return "::" for it as a convenience to programmers. Note that
- // "" and "::" are treated as synonyms by the namespace code so that it
- // is still easy to do things like:
- //
- // namespace [namespace current]::bar { ... }
-
- currNs = getCurrentNamespace(interp);
-
- if (currNs == getGlobalNamespace(interp))
- {
- // FIXME : appending to te result really screws everything up!
- // need to figure out how to disallow this!
- //TclString.append(interp.getResult(), "::");
- interp.setResult("::");
- }
- else
- {
- //TclString.append(interp.getResult(), currNs.fullName);
- interp.setResult(currNs.fullName);
- }
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceDeleteCmd -> deleteCmd
- *
- * Invoked to implement the "namespace delete" command to delete
- * namespace(s). Handles the following syntax:
- *
- * namespace delete ?name name...?
- *
- * Each name identifies a namespace. It may include a sequence of
- * namespace qualifiers separated by "::"s. If a namespace is found, it
- * is deleted: all variables and procedures contained in that namespace
- * are deleted. If that namespace is being used on the call stack, it
- * is kept alive (but logically deleted) until it is removed from the
- * call stack: that is, it can no longer be referenced by name but any
- * currently executing procedure that refers to it is allowed to do so
- * until the procedure returns. If the namespace can't be found, this
- * procedure returns an error. If no namespaces are specified, this
- * command does nothing.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Deletes the specified namespaces. If anything goes wrong, this
- * procedure returns an error message in the interpreter's
- * result object.
- *
- *----------------------------------------------------------------------
- */
-
- private static void deleteCmd(Interp interp, TclObject[] objv)
- {
- Namespace namespace_Renamed;
- string name;
- int i;
-
- if (objv.Length < 2)
- {
- throw new TclNumArgsException(interp, 2, objv, "?name name...?");
- }
-
- // Destroying one namespace may cause another to be destroyed. Break
- // this into two passes: first check to make sure that all namespaces on
- // the command line are valid, and report any errors.
-
- for (i = 2; i < objv.Length; i++)
- {
-
- name = objv[i].ToString();
- namespace_Renamed = findNamespace(interp, name, null, 0);
-
- if (namespace_Renamed == null)
- {
-
- throw new TclException(interp, "unknown namespace \"" + objv[i].ToString() + "\" in namespace delete command");
- }
- }
-
- // Okay, now delete each namespace.
-
- for (i = 2; i < objv.Length; i++)
- {
-
- name = objv[i].ToString();
- namespace_Renamed = findNamespace(interp, name, null, 0);
-
- if (namespace_Renamed != null)
- {
- deleteNamespace(namespace_Renamed);
- }
- }
- }
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceEvalCmd -> evalCmd
- *
- * Invoked to implement the "namespace eval" command. Executes
- * commands in a namespace. If the namespace does not already exist,
- * it is created. Handles the following syntax:
- *
- * namespace eval name arg ?arg...?
- *
- * If more than one arg argument is specified, the command that is
- * executed is the result of concatenating the arguments together with
- * a space between each argument.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Returns the result of the command in the interpreter's result
- * object. If anything goes wrong, this procedure returns an error
- * message as the result.
- *
- *----------------------------------------------------------------------
- */
-
- private static void evalCmd(Interp interp, TclObject[] objv)
- {
- Namespace namespace_Renamed;
- CallFrame frame;
- string cmd;
- string name;
- int length;
-
- if (objv.Length < 4)
- {
- throw new TclNumArgsException(interp, 2, objv, "name arg ?arg...?");
- }
-
- // Try to resolve the namespace reference, caching the result in the
- // namespace object along the way.
-
- namespace_Renamed = getNamespaceFromObj(interp, objv[2]);
-
- // If the namespace wasn't found, try to create it.
-
- if (namespace_Renamed == null)
- {
-
- name = objv[2].ToString();
- namespace_Renamed = createNamespace(interp, name, null);
- if (namespace_Renamed == null)
- {
- // FIXME : result hack, we get the interp result and throw it!
-
- throw new TclException(interp, interp.getResult().ToString());
- }
- }
-
- // Make the specified namespace the current namespace and evaluate
- // the command(s).
-
- frame = interp.newCallFrame();
- pushCallFrame(interp, frame, namespace_Renamed, false);
-
- try
- {
- if (objv.Length == 4)
- {
- interp.eval(objv[3], 0);
- }
- else
- {
- cmd = Util.concat(3, objv.Length, objv);
-
- // eval() will delete the object when it decrements its
- // refcount after eval'ing it.
-
- interp.eval(cmd); // do not pass TCL_EVAL_DIRECT, for compiler only
- }
- }
- catch (TclException ex)
- {
- if (ex.getCompletionCode() == TCL.CompletionCode.ERROR)
- {
- interp.addErrorInfo("\n (in namespace eval \"" + namespace_Renamed.fullName + "\" script line " + interp.errorLine + ")");
- }
- throw ex;
- }
- finally
- {
- popCallFrame(interp);
- }
-
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceExportCmd -> exportCmd
- *
- * Invoked to implement the "namespace export" command that specifies
- * which commands are exported from a namespace. The exported commands
- * are those that can be imported into another namespace using
- * "namespace import". Both commands defined in a namespace and
- * commands the namespace has imported can be exported by a
- * namespace. This command has the following syntax:
- *
- * namespace export ?-clear? ?pattern pattern...?
- *
- * Each pattern may contain "string match"-style pattern matching
- * special characters, but the pattern may not include any namespace
- * qualifiers: that is, the pattern must specify commands in the
- * current (exporting) namespace. The specified patterns are appended
- * onto the namespace's list of export patterns.
- *
- * To reset the namespace's export pattern list, specify the "-clear"
- * flag.
- *
- * If there are no export patterns and the "-clear" flag isn't given,
- * this command returns the namespace's current export list.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Returns a result in the interpreter's result object. If anything
- * goes wrong, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-
- private static void exportCmd(Interp interp, TclObject[] objv)
- {
- Namespace currNs = getCurrentNamespace(interp);
- string pattern, inString;
- bool resetListFirst = false;
- int firstArg, patternCt, i;
-
- if (objv.Length < 2)
- {
- throw new TclNumArgsException(interp, 2, objv, "?-clear? ?pattern pattern...?");
- }
-
- // Process the optional "-clear" argument.
-
- firstArg = 2;
- if (firstArg < objv.Length)
- {
-
- inString = objv[firstArg].ToString();
- if (inString.Equals("-clear"))
- {
- resetListFirst = true;
- firstArg++;
- }
- }
-
- // If no pattern arguments are given, and "-clear" isn't specified,
- // return the namespace's current export pattern list.
-
- patternCt = (objv.Length - firstArg);
- if (patternCt == 0)
- {
- if (firstArg > 2)
- {
- return ;
- }
- else
- {
- // create list with export patterns
- TclObject list = TclList.newInstance();
- appendExportList(interp, currNs, list);
- interp.setResult(list);
- return ;
- }
- }
-
- // Add each pattern to the namespace's export pattern list.
-
- for (i = firstArg; i < objv.Length; i++)
- {
-
- pattern = objv[i].ToString();
- exportList(interp, currNs, pattern, ((i == firstArg)?resetListFirst:false));
- }
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceForgetCmd -> forgetCmd
- *
- * Invoked to implement the "namespace forget" command to remove
- * imported commands from a namespace. Handles the following syntax:
- *
- * namespace forget ?pattern pattern...?
- *
- * Each pattern is a name like "foo::*" or "a::b::x*". That is, the
- * pattern may include the special pattern matching characters
- * recognized by the "string match" command, but only in the command
- * name at the end of the qualified name; the special pattern
- * characters may not appear in a namespace name. All of the commands
- * that match that pattern are checked to see if they have an imported
- * command in the current namespace that refers to the matched
- * command. If there is an alias, it is removed.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Imported commands are removed from the current namespace. If
- * anything goes wrong, this procedure returns an error message in the
- * interpreter's result object.
- *
- *----------------------------------------------------------------------
- */
-
-
- private static void forgetCmd(Interp interp, TclObject[] objv)
- {
-
- string pattern;
- int i;
-
- if (objv.Length < 2)
- {
- throw new TclNumArgsException(interp, 2, objv, "?pattern pattern...?");
- }
-
- for (i = 2; i < objv.Length; i++)
- {
-
- pattern = objv[i].ToString();
- forgetImport(interp, null, pattern);
- }
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceImportCmd -> importCmd
- *
- * Invoked to implement the "namespace import" command that imports
- * commands into a namespace. Handles the following syntax:
- *
- * namespace import ?-force? ?pattern pattern...?
- *
- * Each pattern is a namespace-qualified name like "foo::*",
- * "a::b::x*", or "bar::p". That is, the pattern may include the
- * special pattern matching characters recognized by the "string match"
- * command, but only in the command name at the end of the qualified
- * name; the special pattern characters may not appear in a namespace
- * name. All of the commands that match the pattern and which are
- * exported from their namespace are made accessible from the current
- * namespace context. This is done by creating a new "imported command"
- * in the current namespace that points to the real command in its
- * original namespace; when the imported command is called, it invokes
- * the real command.
- *
- * If an imported command conflicts with an existing command, it is
- * treated as an error. But if the "-force" option is included, then
- * existing commands are overwritten by the imported commands.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Adds imported commands to the current namespace. If anything goes
- * wrong, this procedure returns an error message in the interpreter's
- * result object.
- *
- *----------------------------------------------------------------------
- */
-
-
- private static void importCmd(Interp interp, TclObject[] objv)
- {
-
- bool allowOverwrite = false;
- string inString, pattern;
- int i;
- int firstArg;
-
- if (objv.Length < 2)
- {
- throw new TclNumArgsException(interp, 2, objv, "?-force? ?pattern pattern...?");
- }
-
- // Skip over the optional "-force" as the first argument.
-
- firstArg = 2;
- if (firstArg < objv.Length)
- {
-
- inString = objv[firstArg].ToString();
- if (inString.Equals("-force"))
- {
- allowOverwrite = true;
- firstArg++;
- }
- }
-
- // Handle the imports for each of the patterns.
-
- for (i = firstArg; i < objv.Length; i++)
- {
-
- pattern = objv[i].ToString();
- importList(interp, null, pattern, allowOverwrite);
- }
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceInscopeCmd -> inscopeCmd
- *
- * Invoked to implement the "namespace inscope" command that executes a
- * script in the context of a particular namespace. This command is not
- * expected to be used directly by programmers; calls to it are
- * generated implicitly when programs use "namespace code" commands
- * to register callback scripts. Handles the following syntax:
- *
- * namespace inscope name arg ?arg...?
- *
- * The "namespace inscope" command is much like the "namespace eval"
- * command except that it has lappend semantics and the namespace must
- * already exist. It treats the first argument as a list, and appends
- * any arguments after the first onto the end as proper list elements.
- * For example,
- *
- * namespace inscope ::foo a b c d
- *
- * is equivalent to
- *
- * namespace eval ::foo [concat a [list b c d]]
- *
- * This lappend semantics is important because many callback scripts
- * are actually prefixes.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Returns a result in the Tcl interpreter's result object.
- *
- *----------------------------------------------------------------------
- */
-
- private static void inscopeCmd(Interp interp, TclObject[] objv)
- {
- Namespace namespace_Renamed;
- CallFrame frame;
- int i, result;
-
- if (objv.Length < 4)
- {
- throw new TclNumArgsException(interp, 2, objv, "name arg ?arg...?");
- }
-
- // Resolve the namespace reference.
-
- namespace_Renamed = getNamespaceFromObj(interp, objv[2]);
- if (namespace_Renamed == null)
- {
-
- throw new TclException(interp, "unknown namespace \"" + objv[2].ToString() + "\" in inscope namespace command");
- }
-
- // Make the specified namespace the current namespace.
-
- frame = interp.newCallFrame();
- pushCallFrame(interp, frame, namespace_Renamed, false);
-
-
- // Execute the command. If there is just one argument, just treat it as
- // a script and evaluate it. Otherwise, create a list from the arguments
- // after the first one, then concatenate the first argument and the list
- // of extra arguments to form the command to evaluate.
-
- try
- {
- if (objv.Length == 4)
- {
- interp.eval(objv[3], 0);
- }
- else
- {
- TclObject[] concatObjv = new TclObject[2];
- TclObject list;
- string cmd;
-
- list = TclList.newInstance();
- for (i = 4; i < objv.Length; i++)
- {
- try
- {
- TclList.append(interp, list, objv[i]);
- }
- catch (TclException ex)
- {
- list.release(); // free unneeded obj
- throw ex;
- }
- }
-
- concatObjv[0] = objv[3];
- concatObjv[1] = list;
- cmd = Util.concat(0, 1, concatObjv);
- interp.eval(cmd); // do not pass TCL_EVAL_DIRECT, for compiler only
- list.release(); // we're done with the list object
- }
- }
- catch (TclException ex)
- {
- if (ex.getCompletionCode() == TCL.CompletionCode.ERROR)
- {
- interp.addErrorInfo("\n (in namespace inscope \"" + namespace_Renamed.fullName + "\" script line " + interp.errorLine + ")");
- }
- throw ex;
- }
- finally
- {
- popCallFrame(interp);
- }
-
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceOriginCmd -> originCmd
- *
- * Invoked to implement the "namespace origin" command to return the
- * fully-qualified name of the "real" command to which the specified
- * "imported command" refers. Handles the following syntax:
- *
- * namespace origin name
- *
- * Results:
- * An imported command is created in an namespace when that namespace
- * imports a command from another namespace. If a command is imported
- * into a sequence of namespaces a, b,...,n where each successive
- * namespace just imports the command from the previous namespace, this
- * command returns the fully-qualified name of the original command in
- * the first namespace, a. If "name" does not refer to an alias, its
- * fully-qualified name is returned. The returned name is stored in the
- * interpreter's result object. This procedure returns TCL_OK if
- * successful, and TCL_ERROR if anything goes wrong.
- *
- * Side effects:
- * If anything goes wrong, this procedure returns an error message in
- * the interpreter's result object.
- *
- *----------------------------------------------------------------------
- */
-
- private static void originCmd(Interp interp, TclObject[] objv)
- {
- WrappedCommand command, origCommand;
-
- if (objv.Length != 3)
- {
- throw new TclNumArgsException(interp, 2, objv, "name");
- }
-
- // FIXME : is this the right way to search for a command?
-
- //command = Tcl_GetCommandFromObj(interp, objv[2]);
-
- command = NamespaceCmd.findCommand(interp, objv[2].ToString(), null, 0);
-
- if (command == null)
- {
-
- throw new TclException(interp, "invalid command name \"" + objv[2].ToString() + "\"");
- }
-
- origCommand = getOriginalCommand(command);
- if (origCommand == null)
- {
- // The specified command isn't an imported command. Return the
- // command's name qualified by the full name of the namespace it
- // was defined in.
-
- interp.setResult(interp.getCommandFullName(command));
- }
- else
- {
- interp.setResult(interp.getCommandFullName(origCommand));
- }
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceParentCmd -> parentCmd
- *
- * Invoked to implement the "namespace parent" command that returns the
- * fully-qualified name of the parent namespace for a specified
- * namespace. Handles the following syntax:
- *
- * namespace parent ?name?
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Returns a result in the interpreter's result object. If anything
- * goes wrong, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
- private static void parentCmd(Interp interp, TclObject[] objv)
- {
- Namespace ns;
-
- if (objv.Length == 2)
- {
- ns = getCurrentNamespace(interp);
- }
- else if (objv.Length == 3)
- {
- ns = getNamespaceFromObj(interp, objv[2]);
- if (ns == null)
- {
-
- throw new TclException(interp, "unknown namespace \"" + objv[2].ToString() + "\" in namespace parent command");
- }
- }
- else
- {
- throw new TclNumArgsException(interp, 2, objv, "?name?");
- }
-
- // Report the parent of the specified namespace.
-
- if (ns.parent != null)
- {
- interp.setResult(ns.parent.fullName);
- }
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceQualifiersCmd -> qualifiersCmd
- *
- * Invoked to implement the "namespace qualifiers" command that returns
- * any leading namespace qualifiers in a string. These qualifiers are
- * namespace names separated by "::"s. For example, for "::foo::p" this
- * command returns "::foo", and for "::" it returns "". This command
- * is the complement of the "namespace tail" command. Note that this
- * command does not check whether the "namespace" names are, in fact,
- * the names of currently defined namespaces. Handles the following
- * syntax:
- *
- * namespace qualifiers string
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Returns a result in the interpreter's result object. If anything
- * goes wrong, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
- private static void qualifiersCmd(Interp interp, TclObject[] objv)
- {
- string name;
- int p;
-
- if (objv.Length != 3)
- {
- throw new TclNumArgsException(interp, 2, objv, "string");
- }
-
- // Find the end of the string, then work backward and find
- // the start of the last "::" qualifier.
-
-
- name = objv[2].ToString();
- p = name.Length;
-
- while (--p >= 0)
- {
- if ((name[p] == ':') && (p > 0) && (name[p - 1] == ':'))
- {
- p -= 2; // back up over the ::
- while ((p >= 0) && (name[p] == ':'))
- {
- p--; // back up over the preceeding :
- }
- break;
- }
- }
-
- if (p >= 0)
- {
- interp.setResult(name.Substring(0, (p + 1) - (0)));
- }
- // When no result is set the empty string is the result
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceTailCmd -> tailCmd
- *
- * Invoked to implement the "namespace tail" command that returns the
- * trailing name at the end of a string with "::" namespace
- * qualifiers. These qualifiers are namespace names separated by
- * "::"s. For example, for "::foo::p" this command returns "p", and for
- * "::" it returns "". This command is the complement of the "namespace
- * qualifiers" command. Note that this command does not check whether
- * the "namespace" names are, in fact, the names of currently defined
- * namespaces. Handles the following syntax:
- *
- * namespace tail string
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Returns a result in the interpreter's result object. If anything
- * goes wrong, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-
- private static void tailCmd(Interp interp, TclObject[] objv)
- {
- string name;
- int p;
-
- if (objv.Length != 3)
- {
- throw new TclNumArgsException(interp, 2, objv, "string");
- }
-
- // Find the end of the string, then work backward and find the
- // last "::" qualifier.
-
-
- name = objv[2].ToString();
- p = name.Length;
-
- while (--p > 0)
- {
- if ((name[p] == ':') && (name[p - 1] == ':'))
- {
- p++; // just after the last "::"
- break;
- }
- }
-
- if (p >= 0)
- {
- interp.setResult(name.Substring(p));
- }
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceWhichCmd -> whichCmd
- *
- * Invoked to implement the "namespace which" command that returns the
- * fully-qualified name of a command or variable. If the specified
- * command or variable does not exist, it returns "". Handles the
- * following syntax:
- *
- * namespace which ?-command? ?-variable? name
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Returns a result in the interpreter's result object. If anything
- * goes wrong, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-
- private static void whichCmd(Interp interp, TclObject[] objv)
- {
- string arg;
- WrappedCommand cmd;
- Var variable;
- int argIndex, lookup;
-
- if (objv.Length < 3)
- {
- throw new TclNumArgsException(interp, 2, objv, "?-command? ?-variable? name");
- }
-
- // Look for a flag controlling the lookup.
-
- argIndex = 2;
- lookup = 0; // assume command lookup by default
-
- arg = objv[2].ToString();
- if ((arg.Length > 1) && (arg[0] == '-'))
- {
- if (arg.Equals("-command"))
- {
- lookup = 0;
- }
- else if (arg.Equals("-variable"))
- {
- lookup = 1;
- }
- else
- {
- throw new TclNumArgsException(interp, 2, objv, "?-command? ?-variable? name");
- }
- argIndex = 3;
- }
- if (objv.Length != (argIndex + 1))
- {
- throw new TclNumArgsException(interp, 2, objv, "?-command? ?-variable? name");
- }
-
- // FIXME : check that this implementation works!
-
- switch (lookup)
- {
-
- case 0:
-
- arg = objv[argIndex].ToString();
-
- // FIXME : is this the right way to lookup a Command token?
- //cmd = Tcl_GetCommandFromObj(interp, objv[argIndex]);
- cmd = NamespaceCmd.findCommand(interp, arg, null, 0);
-
- if (cmd == null)
- {
- return ; // cmd not found, just return (no error)
- }
- interp.setResult(interp.getCommandFullName(cmd));
- return ;
-
-
- case 1:
-
- arg = objv[argIndex].ToString();
- variable = NamespaceCmd.findNamespaceVar(interp, arg, null, 0);
- if (variable != null)
- {
- interp.setResult(Var.getVariableFullName(interp, variable));
- }
- return ;
- }
-
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * FreeNsNameInternalRep -> dispose
- *
- * Frees the resources associated with a object's internal
- * representation. See src/tcljava/tcl/lang/InternalRep.java
- *
- * Results:
- * None.
- *
- * Side effects:
- * Decrements the ref count of any Namespace structure pointed
- * to by the nsName's internal representation. If there are no more
- * references to the namespace, it's structure will be freed.
- *
- *----------------------------------------------------------------------
- */
-
- public void dispose()
- {
- bool debug;
- System.Diagnostics.Debug.WriteLine("dispose() called for namespace object " + (otherValue == null?null:otherValue.ns));
-
- ResolvedNsName resName = otherValue;
- Namespace ns;
-
- // Decrement the reference count of the namespace. If there are no
- // more references, free it up.
-
- if (resName != null)
- {
- resName.refCount--;
- if (resName.refCount == 0)
- {
-
- // Decrement the reference count for the cached namespace. If
- // the namespace is dead, and there are no more references to
- // it, free it.
-
- ns = resName.ns;
- ns.refCount--;
- if ((ns.refCount == 0) && ((ns.flags & NS_DEAD) != 0))
- {
- free(ns);
- }
- otherValue = null;
- }
- }
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * DupNsNameInternalRep -> duplicate
- *
- * Get a copy of this Object for copy-on-write
- * operations. We just increment its useCount and return the same
- * ReflectObject because ReflectObject's cannot be modified, so
- * they don't need copy-on-write protections.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- public InternalRep duplicate()
- {
- System.Diagnostics.Debug.WriteLine("duplicate() called for namespace object " + (otherValue == null?null:otherValue.ns));
-
- ResolvedNsName resName = otherValue;
-
- if (resName != null)
- {
- resName.refCount++;
- }
-
- return this;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * SetNsNameFromAny -> setNsNameFromAny
- *
- * Attempt to generate a nsName internal representation for a
- * TclObject.
- *
- * Results:
- * Returns if the value could be converted to a proper
- * namespace reference. Otherwise, raises TclException.
- *
- * Side effects:
- * If successful, the object is made a nsName object. Its internal rep
- * is set to point to a ResolvedNsName, which contains a cached pointer
- * to the Namespace. Reference counts are kept on both the
- * ResolvedNsName and the Namespace, so we can keep track of their
- * usage and free them when appropriate.
- *
- *----------------------------------------------------------------------
- */
-
- private static void setNsNameFromAny(Interp interp, TclObject tobj)
- {
- string name;
- Namespace ns;
- ResolvedNsName resName;
-
- // Java does not support passing an address so we pass
- // an array of size 1 and then assign arr[0] to the value
- Namespace[] nsArr = new Namespace[1];
- Namespace[] dummy1Arr = new Namespace[1];
- string[] dummy2Arr = new string[1];
-
- // Get the string representation.
-
- name = tobj.ToString();
-
- // Look for the namespace "name" in the current namespace. If there is
- // an error parsing the (possibly qualified) name, return an error.
- // If the namespace isn't found, we convert the object to an nsName
- // object with a null ResolvedNsName internal rep.
-
- getNamespaceForQualName(interp, name, null, TCL.VarFlag.FIND_ONLY_NS, nsArr, dummy1Arr, dummy1Arr, dummy2Arr);
-
-
- // Get the values out of the arrays!
- ns = nsArr[0];
-
- // If we found a namespace, then create a new ResolvedNsName structure
- // that holds a reference to it.
-
- if (ns != null)
- {
- Namespace currNs = getCurrentNamespace(interp);
-
- ns.refCount++;
- resName = new ResolvedNsName();
- resName.ns = ns;
- resName.nsId = ns.nsId;
- resName.refNs = currNs;
- resName.refCount = 1;
- }
- else
- {
- resName = null;
- }
-
- // By setting the new internal rep we free up the old one.
-
- // FIXME : should a NamespaceCmd wrap a ResolvedNsName?
- // this is confusing because it seems like the C code uses
- // a ResolvedNsName like it is the InternalRep.
-
- NamespaceCmd wrap = new NamespaceCmd();
- wrap.otherValue = resName;
- tobj.InternalRep = wrap;
-
- return ;
- }
-
-
- /*
- *----------------------------------------------------------------------
- *
- * UpdateStringOfNsName -> toString
- *
- * Return the string representation for a nsName object.
- * This method is called only by TclObject.toString()
- * when TclObject.stringRep is null.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- public override string ToString()
- {
- bool debug;
-
- System.Diagnostics.Debug.WriteLine("toString() called for namespace object " + (otherValue == null?null:otherValue.ns));
-
- ResolvedNsName resName = otherValue;
- Namespace ns;
- string name = "";
-
- if ((resName != null) && (resName.nsId == resName.ns.nsId))
- {
- ns = resName.ns;
- if ((ns.flags & NS_DEAD) != 0)
- {
- ns = null;
- }
- if (ns != null)
- {
- name = ns.fullName;
- }
- }
-
- return name;
- }
-
-
- // This interface is used to provide a callback when a namespace is deleted
- // (ported Tcl_NamespaceDeleteProc to NamespaceCmd.DeleteProc)
-
- internal interface DeleteProc
- {
- void delete();
- }
-
-
- // This structure contains a cached pointer to a namespace that is the
- // result of resolving the namespace's name in some other namespace. It is
- // the internal representation for a nsName object. It contains the
- // pointer along with some information that is used to check the cached
- // pointer's validity. (ported Tcl_Namespace to NamespaceCmd.Namespace)
-
- public class Namespace
- {
- internal string name; // The namespace's simple (unqualified)
- // name. This contains no ::'s. The name of
- // the global namespace is "" although "::"
- // is an synonym.
-
- internal string fullName; // The namespace's fully qualified name.
- // This starts with ::.
-
- internal DeleteProc deleteProc; // method to invoke when namespace is deleted
-
- internal Namespace parent; // reference to the namespace that contains
- // this one. null is this is the global namespace.
-
- internal Hashtable childTable; // Contains any child namespaces. Indexed
- // by strings; values are references to
- // Namespace objects
-
- internal long nsId; // Unique id for the namespace.
- internal Interp interp; // The interpreter containing this namespace.
-
- internal int flags; // OR-ed combination of the namespace
- // status flags NS_DYING and NS_DEAD (listed below)
-
- internal int activationCount; // Number of "activations" or active call
- // frames for this namespace that are on
- // the Tcl call stack. The namespace won't
- // be freed until activationCount becomes zero.
-
- internal int refCount; // Count of references by nsName
- // objects. The namespace can't be freed
- // until refCount becomes zero.
-
- internal Hashtable cmdTable; // Contains all the commands currently
- // registered in the namespace. Indexed by
- // strings; values have type (WrappedCommand).
- // Commands imported by Tcl_Import have
- // Command structures that point (via an
- // ImportedCmdRef structure) to the
- // Command structure in the source
- // namespace's command table.
-
- internal Hashtable varTable; // Contains all the (global) variables
- // currently in this namespace. Indexed
- // by strings; values have type (Var).
-
- internal string[] exportArray; // Reference to an array of string patterns
- // specifying which commands are exported.
- // A pattern may include "string match"
- // style wildcard characters to specify
- // multiple commands; however, no namespace
- // qualifiers are allowed. null if no
- // export patterns are registered.
-
- internal int numExportPatterns; // Number of export patterns currently
- // registered using "namespace export".
-
- internal int maxExportPatterns; // Mumber of export patterns for which
- // space is currently allocated.
-
-
- internal Resolver resolver;
- // If non-null, this object overrides the
- // usual command and variable resolution
- // mechanism in Tcl. This procedure is invoked
- // within findCommand and findNamespaceVar to
- // resolve all command and variable references
- // within the namespace.
-
- // When printing out a Namespace use the full namespace name string
-
- public override string ToString()
- {
- return fullName;
- }
- }
-
-
- // (ported ResolvedNsName to NamespaceCmd.ResolvedNsName)
-
- internal class ResolvedNsName
- {
- internal Namespace ns; // reference to namespace object
- internal long nsId; // sPtr's unique namespace id. Used to
- // verify that ns is still valid
- // (e.g., it's possible that the namespace
- // was deleted and a new one created at
- // the same address).
-
- internal Namespace refNs; // reference to the namespace containing the
- // reference (not the namespace that
- // contains the referenced namespace).
- internal int refCount; // Reference count: 1 for each nsName
- // object that has a pointer to this
- // ResolvedNsName structure as its internal
- // rep. This structure can be freed when
- // refCount becomes zero.
- }
- static NamespaceCmd()
- {
- nsMutex = new System.Object();
- }
- }
- }