public TCL.CompletionCode cmdProc(Interp interp, TclObject[] argv)
{
if (argv.Length < 2 || argv.Length > 4)
{
throw new TclNumArgsException(interp, 1, argv, "message ?errorInfo? ?errorCode?");
}
if (argv.Length >= 3)
{
string errorInfo = argv[2].ToString();
if (!errorInfo.Equals(""))
{
interp.addErrorInfo(errorInfo);
interp.errAlreadyLogged = true;
}
}
if (argv.Length == 4)
{
interp.setErrorCode(argv[3]);
}
interp.setResult(argv[1]);
throw new TclException(TCL.CompletionCode.ERROR);
}
/// <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;
}
/// <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;
}
/// <summary> This procedure is invoked to process the "incr" Tcl command.
/// See the user documentation for details on what it does.
/// </summary>
/// <exception cref=""> TclException if wrong # of args or increment is not an
/// integer.
/// </exception>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
int incrAmount;
TclObject newValue;
if ( ( objv.Length != 2 ) && ( objv.Length != 3 ) )
{
throw new TclNumArgsException( interp, 1, objv, "varName ?increment?" );
}
// Calculate the amount to increment by.
if ( objv.Length == 2 )
{
incrAmount = 1;
}
else
{
try
{
incrAmount = TclInteger.get( interp, objv[2] );
}
catch ( TclException e )
{
interp.addErrorInfo( "\n (reading increment)" );
throw;
}
}
// Increment the variable's value.
newValue = Var.incrVar( interp, objv[1], null, incrAmount, TCL.VarFlag.LEAVE_ERR_MSG );
// FIXME: we need to look at this exception throwing problem again
/*
if (newValue == null) {
return TCL_ERROR;
}
*/
// Set the interpreter's object result to refer to the variable's new
// value object.
interp.setResult( newValue );
return TCL.CompletionCode.RETURN;
}
public TCL.CompletionCode cmdProc(Interp interp, TclObject[] argv)
{
string fileName = null;
bool url = false;
if (argv.Length == 2)
{
fileName = argv[1].ToString();
}
else if (argv.Length == 3)
{
if (argv[1].ToString().Equals("-url"))
{
url = true;
fileName = argv[2].ToString();
}
}
if ((System.Object) fileName == null)
{
throw new TclNumArgsException(interp, 1, argv, "?-url? fileName");
}
try
{
if (url)
{
if (fileName.StartsWith("resource:/"))
{
interp.evalResource(fileName.Substring(9));
}
else
{
interp.evalURL(null, fileName);
}
}
else
{
interp.evalFile(fileName);
}
}
catch (TclException e)
{
TCL.CompletionCode code = e.getCompletionCode();
if (code == TCL.CompletionCode.RETURN)
{
TCL.CompletionCode realCode = interp.updateReturnInfo();
if (realCode != TCL.CompletionCode.OK)
{
e.setCompletionCode(realCode);
throw ;
}
}
else if (code == TCL.CompletionCode.ERROR)
{
/*
* Record information telling where the error occurred.
*/
interp.addErrorInfo("\n (file line " + interp.errorLine + ")");
throw ;
}
else
{
throw ;
}
}
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[] 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;
}
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> TclIncrVar2 -> incrVar
///
/// Given a two-part variable name, which may refer either to a scalar
/// variable or an element of an array, increment the Tcl object value
/// of the variable by a specified amount.
///
/// </summary>
/// <param name="part1">1st part of the variable name.
/// </param>
/// <param name="part2">2nd part of the variable name.
/// </param>
/// <param name="incrAmount">Amount to be added to variable.
/// </param>
/// <param name="flags">misc flags that control the actions of this method
///
/// Results:
/// Returns a reference to the TclObject holding the new value of the
/// variable. If the specified variable doesn't exist, or there is a
/// clash in array usage, or an error occurs while executing variable
/// traces, then a TclException will be raised.
///
/// Side effects:
/// The value of the given variable is incremented by the specified
/// amount. If either the array or the entry didn't exist then a new
/// variable is created. The ref count for the returned object is _not_
/// incremented to reflect the returned reference; if you want to keep a
/// reference to the object you must increment its ref count yourself.
///
/// ----------------------------------------------------------------------
/// </param>
internal static TclObject incrVar( Interp interp, TclObject part1, TclObject part2, int incrAmount, TCL.VarFlag flags )
{
TclObject varValue = null;
bool createdNewObj; // Set to true if var's value object is shared
// so we must increment a copy (i.e. copy
// on write).
int i;
bool err;
// There are two possible error conditions that depend on the setting of
// TCL.VarFlag.LEAVE_ERR_MSG. an exception could be raised or null could be returned
err = false;
try
{
varValue = getVar( interp, part1, part2, flags );
}
catch ( TclException e )
{
err = true;
throw;
}
finally
{
// FIXME : is this the correct way to catch the error?
if ( err || varValue == null )
interp.addErrorInfo( "\n (reading value of variable to increment)" );
}
// Increment the variable's value. If the object is unshared we can
// modify it directly, otherwise we must create a new copy to modify:
// this is "copy on write". Then free the variable's old string
// representation, if any, since it will no longer be valid.
createdNewObj = false;
if ( varValue.Shared )
{
varValue = varValue.duplicate();
createdNewObj = true;
}
try
{
i = TclInteger.get( interp, varValue );
}
catch ( TclException e )
{
if ( createdNewObj )
{
varValue.release(); // free unneeded copy
}
throw;
}
TclInteger.set( varValue, ( i + incrAmount ) );
// Store the variable's new value and run any write traces.
return setVar( interp, part1, part2, varValue, flags );
}
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
// Create the call frame and parameter bindings
CallFrame frame = interp.newCallFrame( this, argv );
// Execute the body
interp.pushDebugStack( srcFileName, srcLineNumber );
try
{
Parser.eval2( interp, body.array, body.index, body_length, 0 );
}
catch ( TclException e )
{
TCL.CompletionCode code = e.getCompletionCode();
if ( code == TCL.CompletionCode.RETURN )
{
TCL.CompletionCode realCode = interp.updateReturnInfo();
if ( realCode != TCL.CompletionCode.OK )
{
e.setCompletionCode( realCode );
throw;
}
}
else if ( code == TCL.CompletionCode.ERROR )
{
interp.addErrorInfo( "\n (procedure \"" + argv[0] + "\" line " + interp.errorLine + ")" );
throw;
}
else if ( code == TCL.CompletionCode.BREAK )
{
throw new TclException( interp, "invoked \"break\" outside of a loop" );
}
else if ( code == TCL.CompletionCode.CONTINUE )
{
throw new TclException( interp, "invoked \"continue\" outside of a loop" );
}
else
{
throw;
}
}
finally
{
interp.popDebugStack();
// The check below is a hack. The problem is that there
// could be unset traces on the variables, which cause
// scripts to be evaluated. This will clear the
// errInProgress 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.
if ( interp.errInProgress )
{
frame.dispose();
interp.errInProgress = true;
}
else
{
frame.dispose();
}
}
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 );
}
}
/// <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;
}
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;
}
/// <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;
}
/*
*----------------------------------------------------------------------
*
* 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 ;
}
/*
*----------------------------------------------------------------------
*
* 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 ;
}
internal static void logCommandInfo( Interp interp, char[] script_array, int script_index, int cmdIndex, int length, TclException e )
// The exception caused by the script
// evaluation.
{
string ellipsis;
string msg;
int offset;
int pIndex;
if ( interp.errAlreadyLogged )
{
// Someone else has already logged error information for this
// command; we shouldn't add anything more.
return;
}
// Compute the line number where the error occurred.
// Note: The script array must be accessed directly
// because we want to count from the beginning of
// the script, not the current index.
interp.errorLine = 1;
for ( pIndex = 0; pIndex < cmdIndex; pIndex++ )
{
if ( script_array[pIndex] == '\n' )
{
interp.errorLine++;
}
}
// Create an error message to add to errorInfo, including up to a
// maximum number of characters of the command.
if ( length < 0 )
{
//take into account the trailing '\0'
int script_length = script_array.Length - 1;
length = script_length - cmdIndex;
}
if ( length > 150 )
{
offset = 150;
ellipsis = "...";
}
else
{
offset = length;
ellipsis = "";
}
msg = new string( script_array, cmdIndex, offset );
if ( !( interp.errInProgress ) )
{
interp.addErrorInfo( "\n while executing\n\"" + msg + ellipsis + "\"" );
}
else
{
interp.addErrorInfo( "\n invoked from within\n\"" + msg + ellipsis + "\"" );
}
interp.errAlreadyLogged = false;
e.errIndex = cmdIndex + offset;
}
/// <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;
}
