public TCL.CompletionCode CmdProc(Interp interp, TclObject[] objv)
{
TclObject varValue = null;
if (objv.Length < 2)
{
throw new TclNumArgsException(interp, 1, objv, "varName ?value value ...?");
}
else if (objv.Length == 2)
{
interp.ResetResult();
interp.SetResult(interp.GetVar(objv[1], 0));
}
else
{
for (int i = 2; i < objv.Length; i++)
{
varValue = interp.SetVar(objv[1], objv[i], TCL.VarFlag.APPEND_VALUE);
}
if (varValue != null)
{
interp.ResetResult();
interp.SetResult(varValue);
}
else
{
interp.ResetResult();
}
}
return(TCL.CompletionCode.RETURN);
}
internal static string doTildeSubst(Interp interp, string user)
{
string dir;
if (user.Length == 0)
{
try
{
dir = interp.GetVar("env", "HOME", TCL.VarFlag.GLOBAL_ONLY).ToString();
}
catch (System.Exception e)
{
throw new TclException(interp, "couldn't find HOME environment variable to expand path");
}
return(dir);
}
// WARNING: Java does not support other users. "dir" is always null,
// but it should be the home directory (corresponding to the user name), as
// specified in the password file.
dir = null;
if ((System.Object)dir == null)
{
throw new TclException(interp, "user \"" + user + "\" doesn't exist");
}
return(dir);
}
/*
*----------------------------------------------------------------------
*
* InfoPatchLevelCmd --
*
* Called to implement the "info patchlevel" command that returns the
* default value for an argument to a procedure. Handles the following
* syntax:
*
* info patchlevel
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
private static void InfoPatchLevelCmd(Interp interp, TclObject[] objv)
{
if (objv.Length != 2)
{
throw new TclNumArgsException(interp, 2, objv, null);
}
interp.SetResult(interp.GetVar("tcl_patchLevel", TCL.VarFlag.GLOBAL_ONLY));
return;
}
public static TclObject Tcl_GetVarType(Interp interp, string part1, string part2, VarFlag flags)
{
try
{
TclObject to = interp.GetVar(part1, part2, flags);
return(to);
}
catch
{
return(null);
};
}
public static TclObject Tcl_GetVar(Interp interp, string part, VarFlag flags)
{
try
{
TclObject to = interp.GetVar(part, flags);
return(to);
}
catch (Exception e)
{
return(TclObj.newInstance(""));
};
}
/*
*----------------------------------------------------------------------
*
* InfoLibraryCmd --
*
* Called to implement the "info library" command that returns the
* library directory for the Tcl installation. Handles the following
* syntax:
*
* info library
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
private static void InfoLibraryCmd(Interp interp, TclObject[] objv)
{
if (objv.Length != 2)
{
throw new TclNumArgsException(interp, 2, objv, null);
}
try
{
interp.SetResult(interp.GetVar("tcl_library", TCL.VarFlag.GLOBAL_ONLY));
return;
}
catch (TclException e)
{
// If the variable has not been defined
throw new TclException(interp, "no library has been specified for Tcl");
}
}
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
bool debug;
if (argv.Length == 2)
{
System.Diagnostics.Debug.WriteLine("getting value of \"" + argv[1].ToString() + "\"");
interp.SetResult(interp.GetVar(argv[1], 0));
}
else if (argv.Length == 3)
{
System.Diagnostics.Debug.WriteLine("setting value of \"" + argv[1].ToString() + "\" to \"" + argv[2].ToString() + "\"");
interp.SetResult(interp.SetVar(argv[1], argv[2], 0));
}
else
{
throw new TclNumArgsException(interp, 1, argv, "varName ?newValue?");
}
return(TCL.CompletionCode.RETURN);
}
/// <summary>
/// Tcl_LappendObjCmd -> LappendCmd.cmdProc
///
/// This procedure is invoked to process the "lappend" Tcl command.
/// See the user documentation for details on what it does.
/// </summary>
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] objv)
{
TclObject varValue, newValue = null;
int i;//int numElems, i, j;
bool createdNewObj, createVar;
if (objv.Length < 2)
{
throw new TclNumArgsException(interp, 1, objv, "varName ?value value ...?");
}
if (objv.Length == 2)
{
try
{
newValue = interp.GetVar(objv[1], 0);
}
catch (TclException e)
{
// The variable doesn't exist yet. Just create it with an empty
// initial value.
varValue = TclList.NewInstance();
try
{
newValue = interp.SetVar(objv[1], varValue, 0);
}
finally
{
if (newValue == null)
{
varValue.Release(); // free unneeded object
}
}
interp.ResetResult();
return(TCL.CompletionCode.RETURN);
}
}
else
{
// We have arguments to append. We used to call Tcl_SetVar2 to
// append each argument one at a time to ensure that traces were run
// for each append step. We now append the arguments all at once
// because it's faster. Note that a read trace and a write trace for
// the variable will now each only be called once. Also, if the
// variable's old value is unshared we modify it directly, otherwise
// we create a new copy to modify: this is "copy on write".
createdNewObj = false;
createVar = true;
try
{
varValue = interp.GetVar(objv[1], 0);
}
catch (TclException e)
{
// We couldn't read the old value: either the var doesn't yet
// exist or it's an array element. If it's new, we will try to
// create it with Tcl_ObjSetVar2 below.
// FIXME : not sure we even need this parse for anything!
// If we do not need to parse could we at least speed it up a bit
string varName;
int nameBytes;
varName = objv[1].ToString();
nameBytes = varName.Length; // Number of Unicode chars in string
for (i = 0; i < nameBytes; i++)
{
if (varName[i] == '(')
{
i = nameBytes - 1;
if (varName[i] == ')')
{
// last char is ')' => array ref
createVar = false;
}
break;
}
}
varValue = TclList.NewInstance();
createdNewObj = true;
}
// We only take this branch when the catch branch was not run
if (createdNewObj == false && varValue.Shared)
{
varValue = varValue.duplicate();
createdNewObj = true;
}
// Insert the new elements at the end of the list.
for (i = 2; i < objv.Length; i++)
{
TclList.Append(interp, varValue, objv[i]);
}
// No need to call varValue.invalidateStringRep() since it
// is called during the TclList.append operation.
// Now store the list object back into the variable. If there is an
// error setting the new value, decrement its ref count if it
// was new and we didn't create the variable.
try
{
newValue = interp.SetVar(objv[1].ToString(), varValue, 0);
}
catch (TclException e)
{
if (createdNewObj && !createVar)
{
varValue.Release(); // free unneeded obj
}
throw;
}
}
// Set the interpreter's object result to refer to the variable's value
// object.
interp.SetResult(newValue);
return(TCL.CompletionCode.RETURN);
}
/// <summary>
/// This procedure is invoked to process the "array" Tcl command. See the user documentation for details on what it does.
/// </summary>
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] objv)
{
Var var = null, array = null;
bool notArray = false;
string varName, msg;
int index;
if (objv.Length < 3)
{
throw new TclNumArgsException(interp, 1, objv, "option arrayName ?arg ...?");
}
index = TclIndex.Get(interp, objv[1], _validCmds, "option", 0);
// Locate the array variable (and it better be an array).
varName = objv[2].ToString();
Var[] retArray = Var.LookupVar(interp, varName, null, 0, null, false, false);
// Assign the values returned in the array
if (retArray != null)
{
var = retArray[0];
array = retArray[1];
}
if (var == null || !var.IsVarArray() || var.IsVarUndefined())
{
notArray = true;
}
// Special array trace used to keep the env array in sync for array names, array get, etc.
if (var != null && var.Traces != null)
{
msg = Var.CallTraces(interp, array, var, varName, null, (TCL.VarFlag.LEAVE_ERR_MSG | TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.TRACE_ARRAY));
if ((object)msg != null)
{
throw new TclVarException(interp, varName, null, "trace array", msg);
}
}
switch (index)
{
case OPT_ANYMORE:
{
if (objv.Length != 4)
{
throw new TclNumArgsException(interp, 2, objv, "arrayName searchId");
}
if (notArray)
{
ErrorNotArray(interp, objv[2].ToString());
}
if (var.SidVec == null)
{
ErrorIllegalSearchId(interp, objv[2].ToString(), objv[3].ToString());
}
SearchId e = var.getSearch(objv[3].ToString());
if (e == null)
{
ErrorIllegalSearchId(interp, objv[2].ToString(), objv[3].ToString());
}
if (e.HasMore)
{
interp.SetResult("1");
}
else
{
interp.SetResult("0");
}
break;
}
case OPT_DONESEARCH:
{
if (objv.Length != 4)
{
throw new TclNumArgsException(interp, 2, objv, "arrayName searchId");
}
if (notArray)
{
ErrorNotArray(interp, objv[2].ToString());
}
bool rmOK = true;
if (var.SidVec != null)
{
rmOK = var.RemoveSearch(objv[3].ToString());
}
if (var.SidVec == null || !rmOK)
{
ErrorIllegalSearchId(interp, objv[2].ToString(), objv[3].ToString());
}
break;
}
case OPT_EXISTS:
{
if (objv.Length != 3)
{
throw new TclNumArgsException(interp, 2, objv, "arrayName");
}
interp.SetResult(!notArray);
break;
}
case OPT_GET:
{
// Due to the differences in the hashtable implementation from the Tcl core and Java, the output will be rearranged.
// This is not a negative side effect, however, test results will differ.
if (objv.Length != 3 && objv.Length != 4)
{
throw new TclNumArgsException(interp, 2, objv, "arrayName ?pattern?");
}
if (notArray)
{
return(TCL.CompletionCode.RETURN);
}
string pattern = null;
if (objv.Length == 4)
{
pattern = objv[3].ToString();
}
Hashtable table = (Hashtable)var._value;
TclObject tobj = TclList.NewInstance();
string arrayName = objv[2].ToString();
string key, strValue;
Var var2;
// Go through each key in the hash table. If there is a pattern, test for a match. Each valid key and its value
// is written into sbuf, which is returned.
// FIXME : do we need to port over the 8.1 code for this loop?
for (IDictionaryEnumerator e = table.GetEnumerator(); e.MoveNext();)
{
key = ((string)e.Key);
var2 = (Var)e.Value;
if (var2.IsVarUndefined())
{
continue;
}
if ((object)pattern != null && !Util.StringMatch(key, pattern))
{
continue;
}
strValue = interp.GetVar(arrayName, key, 0).ToString();
TclList.Append(interp, tobj, TclString.NewInstance(key));
TclList.Append(interp, tobj, TclString.NewInstance(strValue));
}
interp.SetResult(tobj);
break;
}
case OPT_NAMES:
{
if ((objv.Length != 3) && (objv.Length != 4))
{
throw new TclNumArgsException(interp, 2, objv, "arrayName ?pattern?");
}
if (notArray)
{
return(TCL.CompletionCode.RETURN);
}
string pattern = null;
if (objv.Length == 4)
{
pattern = objv[3].ToString();
}
Hashtable table = (Hashtable)var._value;
TclObject tobj = TclList.NewInstance();
string key;
// Go through each key in the hash table. If there is a pattern, test for a match. Each valid key and its value
// is written into sbuf, which is returned.
for (IDictionaryEnumerator e = table.GetEnumerator(); e.MoveNext();)
{
key = (string)e.Key;
Var elem = (Var)e.Value;
if (!elem.IsVarUndefined())
{
if ((System.Object)pattern != null)
{
if (!Util.StringMatch(key, pattern))
{
continue;
}
}
TclList.Append(interp, tobj, TclString.NewInstance(key));
}
}
interp.SetResult(tobj);
break;
}
case OPT_NEXTELEMENT:
{
if (objv.Length != 4)
{
throw new TclNumArgsException(interp, 2, objv, "arrayName searchId");
}
if (notArray)
{
ErrorNotArray(interp, objv[2].ToString());
}
if (var.SidVec == null)
{
ErrorIllegalSearchId(interp, objv[2].ToString(), objv[3].ToString());
}
SearchId e = var.getSearch(objv[3].ToString());
if (e == null)
{
ErrorIllegalSearchId(interp, objv[2].ToString(), objv[3].ToString());
}
if (e.HasMore)
{
Hashtable table = (Hashtable)var._value;
DictionaryEntry entry = e.nextEntry();
string key = (string)entry.Key;
Var elem = (Var)entry.Value;
if ((elem.Flags & VarFlags.UNDEFINED) == 0)
{
interp.SetResult(key);
}
else
{
interp.SetResult(string.Empty);
}
}
break;
}
case OPT_SET:
{
if (objv.Length != 4)
{
throw new TclNumArgsException(interp, 2, objv, "arrayName list");
}
int size = TclList.getLength(interp, objv[3]);
if (size % 2 != 0)
{
throw new TclException(interp, "list must have an even number of elements");
}
string name1 = objv[2].ToString();
string name2, strValue;
// Set each of the array variable names in the interp
for (int i = 0; i < size; i++)
{
name2 = TclList.index(interp, objv[3], i++).ToString();
strValue = TclList.index(interp, objv[3], i).ToString();
interp.SetVar(name1, name2, TclString.NewInstance(strValue), 0);
}
break;
}
case OPT_SIZE:
{
if (objv.Length != 3)
{
throw new TclNumArgsException(interp, 2, objv, "arrayName");
}
if (notArray)
{
interp.SetResult(0);
}
else
{
Hashtable table = (Hashtable)var._value;
int size = 0;
for (IDictionaryEnumerator e = table.GetEnumerator(); e.MoveNext();)
{
Var elem = (Var)e.Value;
if ((elem.Flags & VarFlags.UNDEFINED) == 0)
{
size++;
}
}
interp.SetResult(size);
}
break;
}
case OPT_STARTSEARCH:
{
if (objv.Length != 3)
{
throw new TclNumArgsException(interp, 2, objv, "arrayName");
}
if (notArray)
{
ErrorNotArray(interp, objv[2].ToString());
}
if (var.SidVec == null)
{
var.SidVec = new ArrayList(10);
}
// Create a SearchId Object:
// To create a new SearchId object, a unique string identifier needs to be composed and we need to
// create an Enumeration of the array keys. The unique string identifier is created from three strings:
// "s-" is the default prefix
// "i" is a unique number that is 1+ the greatest SearchId index currently on the ArrayVar.
// "name" is the name of the array
// Once the SearchId string is created we construct a new SearchId object using the string and the
// Enumeration. From now on the string is used to uniquely identify the SearchId object.
int i = var.NextIndex;
string s = "s-" + i + "-" + objv[2].ToString();
IDictionaryEnumerator e = ((Hashtable)var._value).GetEnumerator();
var.SidVec.Add(new SearchId(e, s, i));
interp.SetResult(s);
break;
}
case OPT_UNSET:
{
string pattern;
string name;
if (objv.Length != 3 && objv.Length != 4)
{
throw new TclNumArgsException(interp, 2, objv, "arrayName ?pattern?");
}
if (notArray) //Ignot this error -- errorNotArray(interp, objv[2].ToString());
{
break;
}
if (objv.Length == 3) // When no pattern is given, just unset the whole array
{
interp.UnsetVar(objv[2], 0);
}
else
{
pattern = objv[3].ToString();
Hashtable table = (Hashtable)(((Hashtable)var._value).Clone());
for (IDictionaryEnumerator e = table.GetEnumerator(); e.MoveNext();)
{
name = (string)e.Key;
Var elem = (Var)e.Value;
if (var.IsVarUndefined())
{
continue;
}
if (Util.StringMatch(name, pattern))
{
interp.UnsetVar(varName, name, 0);
}
}
}
break;
}
}
return(TCL.CompletionCode.RETURN);
}
public void traceProc(Interp interp, string name1, string name2, TCL.VarFlag flags)
{
// If the variable is unset, then recreate the trace and restore
// the default value of the format string.
if ((flags & TCL.VarFlag.TRACE_UNSETS) != 0)
{
if (((flags & TCL.VarFlag.TRACE_DESTROYED) != 0) && ((flags & TCL.VarFlag.INTERP_DESTROYED) == 0))
{
interp.TraceVar(name1, name2, new PrecTraceProc(), TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.TRACE_WRITES | TCL.VarFlag.TRACE_READS | TCL.VarFlag.TRACE_UNSETS);
Util.precision = Util.DEFAULT_PRECISION;
}
return;
}
// When the variable is read, reset its value from our shared
// value. This is needed in case the variable was modified in
// some other interpreter so that this interpreter's value is
// out of date.
if ((flags & TCL.VarFlag.TRACE_READS) != 0)
{
interp.SetVar(name1, name2, TclInteger.NewInstance(Util.precision), flags & TCL.VarFlag.GLOBAL_ONLY);
return;
}
// The variable is being written. Check the new value and disallow
// it if it isn't reasonable.
//
// (ToDo) Disallow it if this is a safe interpreter (we don't want
// safe interpreters messing up the precision of other
// interpreters).
TclObject tobj = null;
try
{
tobj = interp.GetVar(name1, name2, (flags & TCL.VarFlag.GLOBAL_ONLY));
}
catch (TclException e)
{
// Do nothing when fixme does not exist.
}
string value;
if (tobj != null)
{
value = tobj.ToString();
}
else
{
value = "";
}
StrtoulResult r = Util.Strtoul(value, 0, 10);
if ((r == null) || (r.value <= 0) || (r.value > TCL_MAX_PREC) || (r.value > 100) || (r.Index == 0) || (r.Index != value.Length))
{
interp.SetVar(name1, name2, TclInteger.NewInstance(Util.precision), TCL.VarFlag.GLOBAL_ONLY);
throw new TclException(interp, "improper value for precision");
}
Util.precision = (int)r.value;
}
