/// <summary> Creates an exception with the appropiate Tcl error message to
/// indicate an error with variable access.
///
/// </summary>
/// <param name="interp">currrent interpreter.
/// </param>
/// <param name="name1">first part of a variable name.
/// </param>
/// <param name="name2">second part of a variable name. May be null.
/// </param>
/// <param name="operation">either "read" or "set".
/// </param>
/// <param name="reason">a string message to explain why the operation fails..
/// </param>
internal TclVarException(Interp interp, string name1, string name2, string operation, string reason)
: base(TCL.CompletionCode.ERROR)
{
if (interp != null)
{
interp.ResetResult();
if ((System.Object)name2 == null)
{
interp.SetResult("can't " + operation + " \"" + name1 + "\": " + reason);
}
else
{
interp.SetResult("can't " + operation + " \"" + name1 + "(" + name2 + ")\": " + reason);
}
}
}
/// <summary> See Tcl user documentation for details.</summary>
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
string sep = null;
if (argv.Length == 2)
{
sep = null;
}
else if (argv.Length == 3)
{
sep = argv[2].ToString();
}
else
{
throw new TclNumArgsException(interp, 1, argv, "list ?joinString?");
}
TclObject list = argv[1];
int size = TclList.getLength(interp, list);
if (size == 0)
{
interp.ResetResult();
return TCL.CompletionCode.RETURN;
}
StringBuilder sbuf = new StringBuilder(TclList.index(interp, list, 0).ToString());
for (int i = 1; i < size; i++)
{
if ((System.Object)sep == null)
{
sbuf.Append(' ');
}
else
{
sbuf.Append(sep);
}
sbuf.Append(TclList.index(interp, list, i).ToString());
}
interp.SetResult(sbuf.ToString());
return TCL.CompletionCode.RETURN;
}
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
int flags;
if (argv.Length == 1)
{
flags = TCL.ALL_EVENTS | TCL.DONT_WAIT;
}
else if (argv.Length == 2)
{
TclIndex.Get(interp, argv[1], validOpts, "option", 0);
/*
* Since we just have one valid option, if the above call returns
* without an exception, we've got "idletasks" (or abreviations).
*/
flags = TCL.IDLE_EVENTS | TCL.DONT_WAIT;
}
else
{
throw new TclNumArgsException(interp, 1, argv, "?idletasks?");
}
while (interp.GetNotifier().doOneEvent(flags) != 0)
{
/* Empty loop body */
}
/*
* Must clear the interpreter's result because event handlers could
* have executed commands.
*/
interp.ResetResult();
return TCL.CompletionCode.RETURN;
}
/// <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;
}
/// <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;
}
/*
* 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;
}
internal void transferResult(Interp sourceInterp, TCL.CompletionCode result)
{
if (sourceInterp == this)
{
return;
}
if (result == TCL.CompletionCode.ERROR)
{
TclObject obj;
// An error occurred, so transfer error information from the source
// interpreter to the target interpreter. Setting the flags tells
// the target interp that it has inherited a partial traceback
// chain, not just a simple error message.
if (!sourceInterp._errAlreadyLogged)
{
sourceInterp.AddErrorInfo("");
}
sourceInterp._errAlreadyLogged = true;
ResetResult();
obj = sourceInterp.GetVar("errorInfo", TCL.VarFlag.GLOBAL_ONLY);
SetVar("errorInfo", obj, TCL.VarFlag.GLOBAL_ONLY);
obj = sourceInterp.GetVar("errorCode", TCL.VarFlag.GLOBAL_ONLY);
SetVar("errorCode", obj, TCL.VarFlag.GLOBAL_ONLY);
_errInProgress = true;
_errCodeSet = true;
}
_returnCode = result;
SetResult(sourceInterp.GetResult());
sourceInterp.ResetResult();
if (result != TCL.CompletionCode.OK)
{
throw new TclException(this, GetResult().ToString(), result);
}
}