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;
}
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;
}
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 var 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;
}
internal static TclObject evalTokens( Interp interp, TclToken[] tokenList, int tIndex, int count )
{
TclObject result, index, value;
TclToken token;
string p = null;
string varName;
BackSlashResult bs;
// The only tricky thing about this procedure is that it attempts to
// avoid object creation and string copying whenever possible. For
// example, if the value is just a nested command, then use the
// command's result object directly.
result = null;
for ( ; count > 0; count-- )
{
token = tokenList[tIndex];
// The switch statement below computes the next value to be
// concat to the result, as either a range of text or an
// object.
value = null;
switch ( token.type )
{
case TCL_TOKEN_TEXT:
p = token.TokenString;
break;
case TCL_TOKEN_BS:
bs = backslash( token.script_array, token.script_index );
if ( bs.isWordSep )
{
p = "\\" + bs.c;
}
else
{
System.Char ch = bs.c;
p = ch.ToString();
}
break;
case TCL_TOKEN_COMMAND:
interp.evalFlags |= Parser.TCL_BRACKET_TERM;
token.script_index++;
//should the nest level be changed???
//interp.nestLevel++;
eval2( interp, token.script_array, token.script_index, token.size - 2, 0 );
token.script_index--;
//interp.nestLevel--;
value = interp.getResult();
break;
case TCL_TOKEN_VARIABLE:
if ( token.numComponents == 1 )
{
index = null;
}
else
{
index = evalTokens( interp, tokenList, tIndex + 2, token.numComponents - 1 );
if ( index == null )
{
return null;
}
}
varName = tokenList[tIndex + 1].TokenString;
// In order to get the existing expr parser to work with the
// new Parser, we test the interp.noEval flag which is set
// by the expr parser. If it is != 0, then we do not evaluate
// the variable. This should be removed when the new expr
// parser is implemented.
if ( interp.noEval == 0 )
{
if ( index != null )
{
try
{
value = interp.getVar( varName, index.ToString(), 0 );
}
finally
{
index.release();
}
}
else
{
value = interp.getVar( varName, null, 0 );
}
}
else
{
value = TclString.newInstance( "" );
value.preserve();
}
count -= token.numComponents;
tIndex += token.numComponents;
break;
default:
throw new TclRuntimeError( "unexpected token type in evalTokens" );
}
// If value isn't null, the next piece of text comes from that
// object; otherwise, take value of p.
if ( result == null )
{
if ( value != null )
{
result = value;
}
else
{
result = TclString.newInstance( p );
}
result.preserve();
}
else
{
if ( result.Shared )
{
result.release();
result = result.duplicate();
result.preserve();
}
if ( value != null )
{
p = value.ToString();
}
TclString.append( result, p );
}
tIndex++;
}
return result;
}
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 );
}
}
/*
*----------------------------------------------------------------------
*
* 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;
}
/*
*----------------------------------------------------------------------
*
* 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" );
}
}
/// <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;//, result;
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 ( (System.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 ( (System.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( "" );
}
}
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" );
}
int i;
string name1 = objv[2].ToString();
string name2, strValue;
// Set each of the array variable names in the interp
for ( 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;
}
/// <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;
}
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;
}
