/// <summary> This procedure is invoked to process the "eval" Tcl command.
/// See the user documentation for details on what it does.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="argv">command arguments.
/// </param>
/// <exception cref=""> TclException if script causes error.
/// </exception>
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
if (argv.Length < 2)
{
throw new TclNumArgsException(interp, 1, argv, "arg ?arg ...?");
}
try
{
if (argv.Length == 2)
{
interp.Eval(argv[1], 0);
}
else
{
string s = Util.concat(1, argv.Length - 1, argv);
interp.Eval(s, 0);
}
}
catch (TclException e)
{
if (e.GetCompletionCode() == TCL.CompletionCode.ERROR)
{
interp.AddErrorInfo("\n (\"eval\" body line " + interp._errorLine + ")");
}
throw;
}
return(TCL.CompletionCode.RETURN);
}
internal static void eval(Interp interp, Interp slaveInterp, int objIx, TclObject[] objv)
{
TCL.CompletionCode result;
slaveInterp.preserve();
slaveInterp.allowExceptions();
try
{
if (objIx + 1 == objv.Length)
{
slaveInterp.Eval(objv[objIx], 0);
}
else
{
TclObject obj = TclList.NewInstance();
for (int ix = objIx; ix < objv.Length; ix++)
{
TclList.Append(interp, obj, objv[ix]);
}
obj.Preserve();
slaveInterp.Eval(obj, 0);
obj.Release();
}
result = slaveInterp._returnCode;
}
catch (TclException e)
{
result = e.GetCompletionCode();
}
slaveInterp.release();
interp.transferResult(slaveInterp, result);
}
public override void ProcessIdleEvent()
{
try
{
SupportClass.VectorRemoveElement(EnclosingInstance._assocData.Handlers, this);
Interp.Eval(Command, TCL.EVAL_GLOBAL);
}
catch (TclException e) { Interp.AddErrorInfo("\n (\"after\" script)"); Interp.BackgroundError(); }
finally { Command.Release(); Command = null; }
}
public static int Tcl_Eval(Interp interp, string s)
{
try
{
interp.Eval(s);
return(0);
}
catch
{
return(1);
};
}
/// <summary> This procedure is invoked to process the "while" Tcl command.
/// See the user documentation for details on what it does.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="argv">command arguments.
/// </param>
/// <exception cref=""> TclException if script causes error.
/// </exception>
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
if (argv.Length != 3)
{
throw new TclNumArgsException(interp, 1, argv, "test command");
}
string test = argv[1].ToString();
TclObject command = argv[2];
{
while (interp._expr.EvalBoolean(interp, test))
{
try
{
interp.Eval(command, 0);
}
catch (TclException e)
{
switch (e.GetCompletionCode())
{
case TCL.CompletionCode.BREAK:
goto loop_brk;
case TCL.CompletionCode.CONTINUE:
continue;
case TCL.CompletionCode.ERROR:
interp.AddErrorInfo("\n (\"while\" body line " + interp._errorLine + ")");
throw;
default:
throw;
}
}
}
}
loop_brk:
;
interp.ResetResult();
return(TCL.CompletionCode.RETURN);
}
public void traceProc(Interp interp, string part1, string part2, TCL.VarFlag flags)
{
if (((this.flags & flags) != 0) && ((flags & TCL.VarFlag.INTERP_DESTROYED) == 0))
{
StringBuilder sbuf = new StringBuilder(command);
try
{
Util.appendElement(interp, sbuf, part1);
if ((System.Object)part2 != null)
{
Util.appendElement(interp, sbuf, part2);
}
else
{
Util.appendElement(interp, sbuf, "");
}
if ((flags & TCL.VarFlag.TRACE_READS) != 0)
{
Util.appendElement(interp, sbuf, "r");
}
else if ((flags & TCL.VarFlag.TRACE_WRITES) != 0)
{
Util.appendElement(interp, sbuf, "w");
}
else if ((flags & TCL.VarFlag.TRACE_UNSETS) != 0)
{
Util.appendElement(interp, sbuf, "u");
}
}
catch (TclException e)
{
throw new TclRuntimeError("unexpected TclException: " + e.Message, e);
}
// Execute the command.
interp.Eval(sbuf.ToString(), 0);
}
}
/// <summary> This procedure is invoked to process the "catch" Tcl command.
/// See the user documentation for details on what it does.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="argv">command arguments.
/// </param>
/// <exception cref=""> TclException if wrong number of arguments.
/// </exception>
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
if (argv.Length != 2 && argv.Length != 3)
{
throw new TclNumArgsException(interp, 1, argv, "command ?varName?");
}
TclObject result;
TCL.CompletionCode code = TCL.CompletionCode.OK;
try
{
interp.Eval(argv[1], 0);
}
catch (TclException e)
{
code = e.GetCompletionCode();
}
result = interp.GetResult();
if (argv.Length == 3)
{
try
{
interp.SetVar(argv[2], result, 0);
}
catch (TclException e)
{
throw new TclException(interp, "couldn't save command result in variable");
}
}
interp.ResetResult();
interp.SetResult(TclInteger.NewInstance((int)code));
return(TCL.CompletionCode.RETURN);
}
public static int Tcl_EvalObjEx(Interp interp, TclObject tobj, int flags)
{
try
{
interp.Eval(tobj, flags);
return(0);
}
catch (TclException e)
{
if (e.GetCompletionCode() == TCL.CompletionCode.RETURN)
{
return(TCL_RETURN);
}
else if (e.GetCompletionCode() == TCL.CompletionCode.BREAK || interp.GetResult().ToString() == "invoked \"break\" outside of a loop")
{
return(TCL_BREAK);
}
else
{
return(TCL_ERROR);
}
};
}
/// <summary> See Tcl user documentation for details.</summary>
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
if ((argv.Length < 2) || (argv.Length > 3))
{
throw new TclNumArgsException(interp, 1, argv, "script ?count?");
}
int count;
if (argv.Length == 2)
{
count = 1;
}
else
{
count = TclInteger.Get(interp, argv[2]);
}
long startTime = System.DateTime.Now.Ticks;
for (int i = 0; i < count; i++)
{
interp.Eval(argv[1], 0);
}
long endTime = System.DateTime.Now.Ticks;
long uSecs = (((endTime - startTime) / 10) / count);
if (uSecs == 1)
{
interp.SetResult(TclString.NewInstance("1 microsecond per iteration"));
}
else
{
interp.SetResult(TclString.NewInstance(uSecs + " microseconds per iteration"));
}
return(TCL.CompletionCode.RETURN);
}
/// <summary> Compares the order of two items in the array.
///
/// </summary>
/// <param name="obj1">first item.
/// </param>
/// <param name="obj2">second item.
/// </param>
/// <returns> 0 if they are equal, 1 if obj1 > obj2, -1 otherwise.
///
/// </returns>
/// <exception cref=""> TclException if an error occurs during sorting.
/// </exception>
private int compare(TclObject obj1, TclObject obj2)
{
int index;
int code = 0;
if (sortIndex != -1)
{
// The "-index" option was specified. Treat each object as a
// list, extract the requested element from each list, and
// compare the elements, not the lists. The special index "end"
// is signaled here with a negative index (other than -1).
TclObject obj;
if (sortIndex < -1)
{
index = TclList.getLength(sortInterp, obj1) - 1;
}
else
{
index = sortIndex;
}
obj = TclList.index(sortInterp, obj1, index);
if (obj == null)
{
throw new TclException(sortInterp, "element " + index + " missing from sublist \"" + obj1 + "\"");
}
obj1 = obj;
if (sortIndex < -1)
{
index = TclList.getLength(sortInterp, obj2) - 1;
}
else
{
index = sortIndex;
}
obj = TclList.index(sortInterp, obj2, index);
if (obj == null)
{
throw new TclException(sortInterp, "element " + index + " missing from sublist \"" + obj2 + "\"");
}
obj2 = obj;
}
switch (sortMode)
{
case ASCII:
// ATK C# CompareTo use option
// similar to -dictionary but a > A
code = System.Globalization.CultureInfo.InvariantCulture.CompareInfo.Compare(obj1.ToString(), obj2.ToString(), System.Globalization.CompareOptions.Ordinal);
// code = obj1.ToString().CompareTo(obj2.ToString());
break;
case DICTIONARY:
code = doDictionary(obj1.ToString(), obj2.ToString());
break;
case INTEGER:
try
{
int int1 = TclInteger.Get(sortInterp, obj1);
int int2 = TclInteger.Get(sortInterp, obj2);
if (int1 > int2)
{
code = 1;
}
else if (int2 > int1)
{
code = -1;
}
}
catch (TclException e1)
{
sortInterp.AddErrorInfo("\n (converting list element from string to integer)");
throw e1;
}
break;
case REAL:
try
{
double f1 = TclDouble.Get(sortInterp, obj1);
double f2 = TclDouble.Get(sortInterp, obj2);
if (f1 > f2)
{
code = 1;
}
else if (f2 > f1)
{
code = -1;
}
}
catch (TclException e2)
{
sortInterp.AddErrorInfo("\n (converting list element from string to real)");
throw e2;
}
break;
case COMMAND:
StringBuilder sbuf = new StringBuilder(sortCommand);
Util.appendElement(sortInterp, sbuf, obj1.ToString());
Util.appendElement(sortInterp, sbuf, obj2.ToString());
try
{
sortInterp.Eval(sbuf.ToString(), 0);
}
catch (TclException e3)
{
sortInterp.AddErrorInfo("\n (user-defined comparison command)");
throw e3;
}
try
{
code = TclInteger.Get(sortInterp, sortInterp.GetResult());
}
catch (TclException e)
{
sortInterp.ResetResult();
TclException e4 = new TclException(sortInterp, "comparison command returned non-numeric result");
throw e4;
}
break;
default:
throw new TclRuntimeError("Unknown sortMode " + sortMode);
}
if (sortIncreasing)
{
return(code);
}
else
{
return(-code);
}
}
/// <summary> See Tcl user documentation for details.</summary>
/// <exception cref=""> TclException If incorrect number of arguments.
/// </exception>
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
int i;
bool value;
i = 1;
while (true)
{
/*
* At this point in the loop, argv and argc refer to an
* expression to test, either for the main expression or
* an expression following an "elseif". The arguments
* after the expression must be "then" (optional) and a
* script to execute if the expression is true.
*/
if (i >= argv.Length)
{
throw new TclException(interp, "wrong # args: no expression after \"" + argv[i - 1] + "\" argument");
}
try
{
value = interp._expr.EvalBoolean(interp, argv[i].ToString());
}
catch (TclException e)
{
switch (e.GetCompletionCode())
{
case TCL.CompletionCode.ERROR:
interp.AddErrorInfo("\n (\"if\" test expression)");
break;
}
throw;
}
i++;
if ((i < argv.Length) && (argv[i].ToString().Equals("then")))
{
i++;
}
if (i >= argv.Length)
{
throw new TclException(interp, "wrong # args: no script following \"" + argv[i - 1] + "\" argument");
}
if (value)
{
try
{
interp.Eval(argv[i], 0);
}
catch (TclException e)
{
switch (e.GetCompletionCode())
{
case TCL.CompletionCode.ERROR:
interp.AddErrorInfo("\n (\"if\" then script line " + interp._errorLine + ")");
break;
}
throw;
}
return(TCL.CompletionCode.RETURN);
}
/*
* The expression evaluated to false. Skip the command, then
* see if there is an "else" or "elseif" clause.
*/
i++;
if (i >= argv.Length)
{
interp.ResetResult();
return(TCL.CompletionCode.RETURN);
}
if (argv[i].ToString().Equals("elseif"))
{
i++;
continue;
}
break;
}
/*
* Couldn't find a "then" or "elseif" clause to execute.
* Check now for an "else" clause. We know that there's at
* least one more argument when we get here.
*/
if (argv[i].ToString().Equals("else"))
{
i++;
if (i >= argv.Length)
{
throw new TclException(interp, "wrong # args: no script following \"else\" argument");
}
else if (i != (argv.Length - 1))
{
throw new TclException(interp, "wrong # args: extra words after \"else\" clause in " + "\"if\" command");
}
}
try
{
interp.Eval(argv[i], 0);
}
catch (TclException e)
{
switch (e.GetCompletionCode())
{
case TCL.CompletionCode.ERROR:
interp.AddErrorInfo("\n (\"if\" else script line " + interp._errorLine + ")");
break;
}
throw;
}
return(TCL.CompletionCode.RETURN);
}
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] objv)
{
string optLevel;
int result;
CallFrame savedVarFrame, frame;
int objc = objv.Length;
int objv_index;
TclObject cmd;
if (objv.Length < 2)
{
throw new TclNumArgsException(interp, 1, objv, "?level? command ?arg ...?");
}
// Find the level to use for executing the command.
optLevel = objv[1].ToString();
// Java does not support passing a reference by refernece so use an array
CallFrame[] frameArr = new CallFrame[1];
result = CallFrame.GetFrame(interp, optLevel, frameArr);
frame = frameArr[0];
objc -= (result + 1);
if (objc == 0)
{
throw new TclNumArgsException(interp, 1, objv, "?level? command ?arg ...?");
}
objv_index = (result + 1);
// Modify the interpreter state to execute in the given frame.
savedVarFrame = interp.VarFrame;
interp.VarFrame = frame;
// Execute the residual arguments as a command.
if (objc == 1)
{
cmd = objv[objv_index];
}
else
{
cmd = TclString.NewInstance(Util.concat(objv_index, objv.Length - 1, objv));
}
cmd.Preserve();
try
{
interp.Eval(cmd, 0);
}
catch (TclException e)
{
if (e.GetCompletionCode() == TCL.CompletionCode.ERROR)
{
interp.AddErrorInfo("\n (\"uplevel\" body line " + interp._errorLine + ")");
}
throw;
}
finally
{
interp.VarFrame = savedVarFrame;
cmd.Release();
}
return(TCL.CompletionCode.RETURN);
}
/*
* This procedure is invoked to process the "for" Tcl command.
* See the user documentation for details on what it does.
*
* @param interp the current interpreter.
* @param argv command arguments.
* @exception TclException if script causes error.
*/
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
if (argv.Length != 5)
{
throw new TclNumArgsException(interp, 1, argv, "start test next command");
}
TclObject start = argv[1];
string test = argv[2].ToString();
TclObject next = argv[3];
TclObject command = argv[4];
bool done = false;
try
{
interp.Eval(start, 0);
}
catch (TclException e)
{
interp.AddErrorInfo("\n (\"for\" initial command)");
throw;
}
while (!done)
{
if (!interp._expr.EvalBoolean(interp, test))
{
break;
}
try
{
interp.Eval(command, 0);
}
catch (TclException e)
{
switch (e.GetCompletionCode())
{
case TCL.CompletionCode.BREAK:
done = true;
break;
case TCL.CompletionCode.CONTINUE:
break;
case TCL.CompletionCode.ERROR:
interp.AddErrorInfo("\n (\"for\" body line " + interp._errorLine + ")");
throw;
default:
throw;
}
}
if (!done)
{
try
{
interp.Eval(next, 0);
}
catch (TclException e)
{
switch (e.GetCompletionCode())
{
case TCL.CompletionCode.BREAK:
done = true;
break;
case TCL.CompletionCode.CONTINUE:
break;
default:
interp.AddErrorInfo("\n (\"for\" loop-end command)");
throw;
}
}
}
}
interp.ResetResult();
return(TCL.CompletionCode.RETURN);
}
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
int i, mode, body;
bool matched;
string inString;
TclObject[] switchArgv = null;
mode = EXACT;
for (i = 1; i < argv.Length; i++)
{
if (!argv[i].ToString().StartsWith("-"))
{
break;
}
int opt = TclIndex.Get(interp, argv[i], validCmds, "option", 1);
if (opt == LAST)
{
i++;
break;
}
else if (opt > LAST)
{
throw new TclException(interp, "SwitchCmd.cmdProc: bad option " + opt + " index to validCmds");
}
else
{
mode = opt;
}
}
if (argv.Length - i < 2)
{
throw new TclNumArgsException(interp, 1, argv, "?switches? string pattern body ... ?default body?");
}
inString = argv[i].ToString();
i++;
// If all of the pattern/command pairs are lumped into a single
// argument, split them out again.
if (argv.Length - i == 1)
{
switchArgv = TclList.getElements(interp, argv[i]);
i = 0;
}
else
{
switchArgv = argv;
}
for (; i < switchArgv.Length; i += 2)
{
if (i == (switchArgv.Length - 1))
{
throw new TclException(interp, "extra switch pattern with no body");
}
// See if the pattern matches the string.
matched = false;
string pattern = switchArgv[i].ToString();
if ((i == switchArgv.Length - 2) && pattern.Equals("default"))
{
matched = true;
}
else
{
switch (mode)
{
case EXACT:
matched = inString.Equals(pattern);
break;
case GLOB:
matched = Util.StringMatch(inString, pattern);
break;
case REGEXP:
matched = Util.regExpMatch(interp, inString, switchArgv[i]);
break;
}
}
if (!matched)
{
continue;
}
// We've got a match. Find a body to execute, skipping bodies
// that are "-".
for (body = i + 1; ; body += 2)
{
if (body >= switchArgv.Length)
{
throw new TclException(interp, "no body specified for pattern \"" + switchArgv[i] + "\"");
}
if (!switchArgv[body].ToString().Equals("-"))
{
break;
}
}
try
{
interp.Eval(switchArgv[body], 0);
return(TCL.CompletionCode.RETURN);
}
catch (TclException e)
{
if (e.GetCompletionCode() == TCL.CompletionCode.ERROR)
{
interp.AddErrorInfo("\n (\"" + switchArgv[i] + "\" arm line " + interp._errorLine + ")");
}
throw;
}
}
// Nothing matched: return nothing.
return(TCL.CompletionCode.RETURN);
}
internal static string pkgRequire(Interp interp, string pkgName, string version, bool exact)
{
VersionSatisfiesResult vsres;
Package pkg;
PkgAvail avail, best;
string script;
StringBuilder sbuf;
int pass, result;
// Do extra check to make sure that version is not
// null when the exact flag is set to true.
if ((System.Object)version == null && exact)
{
throw new TclException(interp, "conflicting arguments : version == null and exact == true");
}
// Before we can compare versions the version string
// must be verified but if it is null we are just looking
// for the latest version so skip the check in this case.
if ((System.Object)version != null)
{
checkVersion(interp, version);
}
// It can take up to three passes to find the package: one pass to
// run the "package unknown" script, one to run the "package ifneeded"
// script for a specific version, and a final pass to lookup the
// package loaded by the "package ifneeded" script.
vsres = new VersionSatisfiesResult();
for (pass = 1; ; pass++)
{
pkg = findPackage(interp, pkgName);
if ((System.Object)pkg.version != null)
{
break;
}
// The package isn't yet present. Search the list of available
// versions and invoke the script for the best available version.
best = null;
for (avail = pkg.avail; avail != null; avail = avail.next)
{
if ((best != null) && (compareVersions(avail.version, best.version, null) <= 0))
{
continue;
}
if ((System.Object)version != null)
{
result = compareVersions(avail.version, version, vsres);
if ((result != 0) && exact)
{
continue;
}
if (!vsres.satisfies)
{
continue;
}
}
best = avail;
}
if (best != null)
{
// We found an ifneeded script for the package. Be careful while
// executing it: this could cause reentrancy, so (a) protect the
// script itself from deletion and (b) don't assume that best
// will still exist when the script completes.
script = best.script;
try
{
interp.Eval(script, TCL.EVAL_GLOBAL);
}
catch (TclException e)
{
interp.AddErrorInfo("\n (\"package ifneeded\" script)");
// Throw the error with new info added to errorInfo.
throw;
}
interp.ResetResult();
pkg = findPackage(interp, pkgName);
break;
}
// Package not in the database. If there is a "package unknown"
// command, invoke it (but only on the first pass; after that,
// we should not get here in the first place).
if (pass > 1)
{
break;
}
script = interp._packageUnknown;
if ((System.Object)script != null)
{
sbuf = new StringBuilder();
try
{
Util.appendElement(interp, sbuf, script);
Util.appendElement(interp, sbuf, pkgName);
if ((System.Object)version == null)
{
Util.appendElement(interp, sbuf, "");
}
else
{
Util.appendElement(interp, sbuf, version);
}
if (exact)
{
Util.appendElement(interp, sbuf, "-exact");
}
}
catch (TclException e)
{
throw new TclRuntimeError("unexpected TclException: " + e.Message);
}
try
{
interp.Eval(sbuf.ToString(), TCL.EVAL_GLOBAL);
}
catch (TclException e)
{
interp.AddErrorInfo("\n (\"package unknown\" script)");
// Throw the first exception.
throw;
}
interp.ResetResult();
}
}
if ((System.Object)pkg.version == null)
{
sbuf = new StringBuilder();
sbuf.Append("can't find package " + pkgName);
if ((System.Object)version != null)
{
sbuf.Append(" " + version);
}
throw new TclException(interp, sbuf.ToString());
}
// At this point we know that the package is present. Make sure that the
// provided version meets the current requirement.
if ((System.Object)version == null)
{
return(pkg.version);
}
result = compareVersions(pkg.version, version, vsres);
if ((vsres.satisfies && !exact) || (result == 0))
{
return(pkg.version);
}
// If we have a version conflict we throw a TclException.
throw new TclException(interp, "version conflict for package \"" + pkgName + "\": have " + pkg.version + ", need " + version);
}
/// <summary> This procedure is invoked to process the "subst" Tcl command.
/// See the user documentation for details on what it does.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="argv">command arguments.
/// </param>
/// <exception cref=""> TclException if wrong # of args or invalid argument(s).
/// </exception>
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
int currentObjIndex, len, i;
int objc = argv.Length - 1;
bool doBackslashes = true;
bool doCmds = true;
bool doVars = true;
StringBuilder result = new StringBuilder();
string s;
char c;
for (currentObjIndex = 1; currentObjIndex < objc; currentObjIndex++)
{
if (!argv[currentObjIndex].ToString().StartsWith("-"))
{
break;
}
int opt = TclIndex.Get(interp, argv[currentObjIndex], validCmds, "switch", 0);
switch (opt)
{
case OPT_NOBACKSLASHES:
doBackslashes = false;
break;
case OPT_NOCOMMANDS:
doCmds = false;
break;
case OPT_NOVARS:
doVars = false;
break;
default:
throw new TclException(interp, "SubstCmd.cmdProc: bad option " + opt + " index to cmds");
}
}
if (currentObjIndex != objc)
{
throw new TclNumArgsException(interp, currentObjIndex, argv, "?-nobackslashes? ?-nocommands? ?-novariables? string");
}
/*
* Scan through the string one character at a time, performing
* command, variable, and backslash substitutions.
*/
s = argv[currentObjIndex].ToString();
len = s.Length;
i = 0;
while (i < len)
{
c = s[i];
if ((c == '[') && doCmds)
{
ParseResult res;
try
{
interp._evalFlags = Parser.TCL_BRACKET_TERM;
interp.Eval(s.Substring(i + 1, (len) - (i + 1)));
TclObject interp_result = interp.GetResult();
interp_result.Preserve();
res = new ParseResult(interp_result, i + interp._termOffset);
}
catch (TclException e)
{
i = e.errIndex + 1;
throw;
}
i = res.nextIndex + 2;
result.Append(res.Value.ToString());
res.Release();
}
else if (c == '\r')
{
/*
* (ToDo) may not be portable on Mac
*/
i++;
}
else if ((c == '$') && doVars)
{
ParseResult vres = Parser.parseVar(interp, s.Substring(i, (len) - (i)));
i += vres.nextIndex;
result.Append(vres.Value.ToString());
vres.Release();
}
else if ((c == '\\') && doBackslashes)
{
BackSlashResult bs = Tcl.Lang.Interp.backslash(s, i, len);
i = bs.NextIndex;
if (bs.IsWordSep)
{
break;
}
else
{
result.Append(bs.C);
}
}
else
{
result.Append(c);
i++;
}
}
interp.SetResult(result.ToString());
return(TCL.CompletionCode.RETURN);
}
/// <summary> Executes a "case" statement. See Tcl user
/// documentation for details.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="argv">command arguments.
/// </param>
/// <exception cref=""> TclException If incorrect number of arguments.
/// </exception>
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
if (argv.Length < 3)
{
throw new TclNumArgsException(interp, 1, argv, "string ?in? patList body ... ?default body?");
}
int i;
int body;
TclObject[] caseArgv;
string inString;
inString = argv[1].ToString();
caseArgv = argv;
body = -1;
if (argv[2].ToString().Equals("in"))
{
i = 3;
}
else
{
i = 2;
}
/*
* If all of the pattern/command pairs are lumped into a single
* argument, split them out again.
*/
if (argv.Length - i == 1)
{
caseArgv = TclList.getElements(interp, argv[i]);
i = 0;
}
{
for (; i < caseArgv.Length; i += 2)
{
int j;
if (i == (caseArgv.Length - 1))
{
throw new TclException(interp, "extra case pattern with no body");
}
/*
* Check for special case of single pattern (no list) with
* no backslash sequences.
*/
string caseString = caseArgv[i].ToString();
int len = caseString.Length;
for (j = 0; j < len; j++)
{
char c = caseString[j];
if (System.Char.IsWhiteSpace(c) || (c == '\\'))
{
break;
}
}
if (j == len)
{
if (caseString.Equals("default"))
{
body = i + 1;
}
if (Util.StringMatch(inString, caseString))
{
body = i + 1;
goto match_loop_brk;
}
continue;
}
/*
* Break up pattern lists, then check each of the patterns
* in the list.
*/
int numPats = TclList.getLength(interp, caseArgv[i]);
for (j = 0; j < numPats; j++)
{
if (Util.StringMatch(inString, TclList.index(interp, caseArgv[i], j).ToString()))
{
body = i + 1;
goto match_loop_brk;
}
}
}
}
match_loop_brk:
;
if (body != -1)
{
try
{
interp.Eval(caseArgv[body], 0);
}
catch (TclException e)
{
if (e.GetCompletionCode() == TCL.CompletionCode.ERROR)
{
interp.AddErrorInfo("\n (\"" + caseArgv[body - 1] + "\" arm line " + interp._errorLine + ")");
}
throw;
}
}
return(TCL.CompletionCode.RETURN);
}
/// <summary> Tcl_ForeachObjCmd -> ForeachCmd.cmdProc
///
/// This procedure is invoked to process the "foreach" Tcl command.
/// See the user documentation for details on what it does.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="objv">command arguments.
/// </param>
/// <exception cref=""> TclException if script causes error.
/// </exception>
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] objv)
{
if (objv.Length < 4 || (objv.Length % 2) != 0)
{
throw new TclNumArgsException(interp, 1, objv, "varList list ?varList list ...? command");
}
// foreach {n1 n2} {1 2 3 4} {n3} {1 2} {puts $n1-$n2-$n3}
// name[0] = {n1 n2} value[0] = {1 2 3 4}
// name[1] = {n3} value[0] = {1 2}
TclObject[] name = new TclObject[(objv.Length - 2) / 2];
TclObject[] value = new TclObject[(objv.Length - 2) / 2];
int c, i, j, base_;
int maxIter = 0;
TclObject command = objv[objv.Length - 1];
bool done = false;
for (i = 0; i < objv.Length - 2; i += 2)
{
int x = i / 2;
name[x] = objv[i + 1];
value[x] = objv[i + 2];
int nSize = TclList.getLength(interp, name[x]);
int vSize = TclList.getLength(interp, value[x]);
if (nSize == 0)
{
throw new TclException(interp, "foreach varlist is empty");
}
int iter = (vSize + nSize - 1) / nSize;
if (maxIter < iter)
{
maxIter = iter;
}
}
for (c = 0; !done && c < maxIter; c++)
{
// Set up the variables
for (i = 0; i < objv.Length - 2; i += 2)
{
int x = i / 2;
int nSize = TclList.getLength(interp, name[x]);
base_ = nSize * c;
for (j = 0; j < nSize; j++)
{
// Test and see if the name variable is an array.
Var[] result = Var.LookupVar(interp, name[x].ToString(), null, 0, null, false, false);
Var var = null;
if (result != null)
{
if (result[1] != null)
{
var = result[1];
}
else
{
var = result[0];
}
}
try
{
if (base_ + j >= TclList.getLength(interp, value[x]))
{
interp.SetVar(TclList.index(interp, name[x], j), TclString.NewInstance(""), 0);
}
else
{
interp.SetVar(TclList.index(interp, name[x], j), TclList.index(interp, value[x], base_ + j), 0);
}
}
catch (TclException e)
{
throw new TclException(interp, "couldn't set loop variable: \"" + TclList.index(interp, name[x], j) + "\"");
}
}
}
// Execute the script
try
{
interp.Eval(command, 0);
}
catch (TclException e)
{
switch (e.GetCompletionCode())
{
case TCL.CompletionCode.BREAK:
done = true;
break;
case TCL.CompletionCode.CONTINUE:
continue;
case TCL.CompletionCode.ERROR:
interp.AddErrorInfo("\n (\"foreach\" body line " + interp._errorLine + ")");
throw;
default:
throw;
}
}
}
interp.ResetResult();
return(TCL.CompletionCode.RETURN);
}
