public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
string dirName;
if ( argv.Length > 2 )
{
throw new TclNumArgsException( interp, 1, argv, "?dirName?" );
}
if ( argv.Length == 1 )
{
dirName = "~";
}
else
{
dirName = argv[1].ToString();
}
if ( ( JACL.PLATFORM == JACL.PLATFORM_WINDOWS ) && ( dirName.Length == 2 ) && ( dirName[1] == ':' ) )
{
dirName = dirName + "/";
}
// Set the interp's working dir.
interp.setWorkingDir( dirName );
return TCL.CompletionCode.RETURN;
}
/// <summary> This procedure is invoked to process the "seek" Tcl command.
/// See the user documentation for details on what it does.
/// </summary>
public TCL.CompletionCode cmdProc(Interp interp, TclObject[] argv)
{
Channel chan; /* The channel being operated on this method */
int mode; /* Stores the search mode, either beg, cur or end
* of file. See the TclIO class for more info */
if (argv.Length != 3 && argv.Length != 4)
{
throw new TclNumArgsException(interp, 1, argv, "channelId offset ?origin?");
}
// default is the beginning of the file
mode = TclIO.SEEK_SET;
if (argv.Length == 4)
{
int index = TclIndex.get(interp, argv[3], validOrigins, "origin", 0);
switch (index)
{
case OPT_START: {
mode = TclIO.SEEK_SET;
break;
}
case OPT_CURRENT: {
mode = TclIO.SEEK_CUR;
break;
}
case OPT_END: {
mode = TclIO.SEEK_END;
break;
}
}
}
chan = TclIO.getChannel(interp, argv[1].ToString());
if (chan == null)
{
throw new TclException(interp, "can not find channel named \"" + argv[1].ToString() + "\"");
}
long offset = TclInteger.get(interp, argv[2]);
try
{
chan.seek(interp, offset, mode);
}
catch (System.IO.IOException e)
{
// FIXME: Need to figure out Tcl specific error conditions.
// Should we also wrap an IOException in a ReflectException?
throw new TclRuntimeError("SeekCmd.cmdProc() Error: IOException when seeking " + chan.ChanName + ":" + e.Message);
}
return TCL.CompletionCode.RETURN;
}
/// <summary> This procedure is invoked to process the "flush" 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>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
Channel chan; /* The channel being operated on this method */
if ( argv.Length != 2 )
{
throw new TclNumArgsException( interp, 1, argv, "channelId" );
}
chan = TclIO.getChannel( interp, argv[1].ToString() );
if ( chan == null )
{
throw new TclException( interp, "can not find channel named \"" + argv[1].ToString() + "\"" );
}
try
{
chan.flush( interp );
}
catch ( IOException e )
{
throw new TclRuntimeError( "FlushCmd.cmdProc() Error: IOException when flushing " + chan.ChanName );
}
return TCL.CompletionCode.RETURN;
}
/// <summary> Tcl_ReadChars -> read
///
/// Read data from the Channel into the given TclObject.
///
/// </summary>
/// <param name="interp"> is used for TclExceptions.
/// </param>
/// <param name="tobj"> the object data will be added to.
/// </param>
/// <param name="readType"> specifies if the read should read the entire
/// buffer (TclIO.READ_ALL), the next line
/// (TclIO.READ_LINE), of a specified number
/// of bytes (TclIO.READ_N_BYTES).
/// </param>
/// <param name="numBytes"> the number of bytes/chars to read. Used only
/// when the readType is TclIO.READ_N_BYTES.
/// </param>
/// <returns> the number of bytes read.
/// Returns -1 on EOF or on error.
/// </returns>
/// <exception cref=""> TclException is thrown if read occurs on WRONLY channel.
/// </exception>
/// <exception cref=""> IOException is thrown when an IO error occurs that was not
/// correctly tested for. Most cases should be caught.
/// </exception>
internal int read(Interp interp, TclObject tobj, int readType, int numBytes)
{
TclObject dataObj;
checkRead(interp);
initInput();
switch (readType)
{
case TclIO.READ_ALL:
{
return(input.doReadChars(tobj, -1));
}
case TclIO.READ_LINE:
{
return(input.getsObj(tobj));
}
case TclIO.READ_N_BYTES:
{
return(input.doReadChars(tobj, numBytes));
}
default:
{
throw new TclRuntimeError("Channel.read: Invalid read mode.");
}
}
}
/// <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> TCL.Tcl_GetIntFromObj -> TclInteger.get
///
/// Returns the integer value of the object.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the object to operate on.
/// </param>
/// <returns> the integer value of the object.
/// </returns>
public static int get(Interp interp, TclObject tobj)
{
setIntegerFromAny(interp, tobj);
TclInteger tint = (TclInteger)tobj.InternalRep;
return(tint.value);
}
/// <summary> This procedure is invoked to process the "tell" 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>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
Channel chan; /* The channel being operated on this method */
if ( argv.Length != 2 )
{
throw new TclNumArgsException( interp, 1, argv, "channelId" );
}
chan = TclIO.getChannel( interp, argv[1].ToString() );
if ( chan == null )
{
throw new TclException( interp, "can not find channel named \"" + argv[1].ToString() + "\"" );
}
try
{
interp.setResult( TclInteger.newInstance( (int)chan.tell() ) );
}
catch ( IOException e )
{
throw new TclException( interp, "Error in TellCmd" );
}
return TCL.CompletionCode.RETURN;
}
/*
** 2007 May 05
**
** The author disclaims copyright to this source code. In place of
** a legal notice, here is a blessing:
**
** May you do good and not evil.
** May you find forgiveness for yourself and forgive others.
** May you share freely, never taking more than you give.
**
*************************************************************************
** Code for testing the btree.c module in SQLite. This code
** is not included in the SQLite library. It is used for automated
** testing of the SQLite library.
*************************************************************************
** Included in SQLite3 port to C#-SQLite; 2008 Noah B Hart
** C#-SQLite is an independent reimplementation of the SQLite software library
**
** SQLITE_SOURCE_ID: 2009-12-07 16:39:13 1ed88e9d01e9eda5cbc622e7614277f29bcc551c
**
** $Header$
*************************************************************************
*/
//#include "btreeInt.h"
//#include <tcl.h>
/*
** Usage: sqlite3_shared_cache_report
**
** Return a list of file that are shared and the number of
** references to each file.
*/
static int sqlite3BtreeSharedCacheReport(
object clientData,
Tcl_Interp interp,
int objc,
Tcl_Obj[] objv
)
{
/// <summary> Tcl_GetlongFromObj -> TclLong.get
///
/// Returns the long value of the object.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the object to operate on.
/// </param>
/// <returns> the long value of the object.
/// </returns>
public static long get(Interp interp, TclObject tobj)
{
setlongFromAny(interp, tobj);
TclLong tlong = (TclLong)tobj.InternalRep;
return(tlong.value);
}
public static void Tcl_Free(ref TclObject to)
{
while (to.refCount > 0)
{
to.release();
}
}
internal Procedure( Interp interp, NamespaceCmd.Namespace ns, string name, TclObject args, TclObject b, string sFileName, int sLineNumber )
{
this.ns = ns;
srcFileName = sFileName;
srcLineNumber = sLineNumber;
// Break up the argument list into argument specifiers, then process
// each argument specifier.
int numArgs = TclList.getLength( interp, args );
argList = new TclObject[numArgs][];
for ( int i = 0; i < numArgs; i++ )
{
argList[i] = new TclObject[2];
}
for ( int i = 0; i < numArgs; i++ )
{
// Now divide the specifier up into name and default.
TclObject argSpec = TclList.index( interp, args, i );
int specLen = TclList.getLength( interp, argSpec );
if ( specLen == 0 )
{
throw new TclException( interp, "procedure \"" + name + "\" has argument with no name" );
}
if ( specLen > 2 )
{
throw new TclException( interp, "too many fields in argument " + "specifier \"" + argSpec + "\"" );
}
argList[i][0] = TclList.index( interp, argSpec, 0 );
argList[i][0].preserve();
if ( specLen == 2 )
{
argList[i][1] = TclList.index( interp, argSpec, 1 );
argList[i][1].preserve();
}
else
{
argList[i][1] = null;
}
}
if ( numArgs > 0 && ( argList[numArgs - 1][0].ToString().Equals( "args" ) ) )
{
isVarArgs = true;
}
else
{
isVarArgs = false;
}
body = new CharPointer( b.ToString() );
body_length = body.length();
}
/// <summary> Sorts the list according to the sort mode and (optional) sort command.
/// The resulting list will contain no duplicates, if argument unique is
/// specifed as true.
/// If tobj is not a list object, an attempt will be made to
/// convert it to a list.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="tobj">the list to sort.
/// </param>
/// <param name="sortMode">the sorting mode.
/// </param>
/// <param name="sortIncreasing">true if to sort the elements in increasing order.
/// </param>
/// <param name="command">the command to compute the order of two elements.
/// </param>
/// <param name="unique">true if the result should contain no duplicates.
/// </param>
/// <exception cref=""> TclException if tobj is not a valid list.
/// </exception>
internal static void sort(Interp interp, TclObject tobj, int sortMode, int sortIndex, bool sortIncreasing, string command, bool unique)
{
setListFromAny(interp, tobj);
tobj.invalidateStringRep();
TclList tlist = (TclList)tobj.InternalRep;
int size = tlist.vector.Count;
if (size <= 1)
{
return;
}
TclObject[] objArray = new TclObject[size];
for (int i = 0; i < size; i++)
{
objArray[i] = (TclObject)tlist.vector[i];
}
QSort s = new QSort();
int newsize = s.sort(interp, objArray, sortMode, sortIndex, sortIncreasing, command, unique);
for (int i = 0; i < size; i++)
{
if (i < newsize)
{
tlist.vector[i] = objArray[i];
objArray[i] = null;
}
else
{
tlist.vector.RemoveAt(newsize);
}
}
}
private string wrongNumProcArgs(TclObject name, Procedure proc)
{
int i;
System.Text.StringBuilder sbuf = new System.Text.StringBuilder(200);
sbuf.Append("wrong # args: should be \"");
sbuf.Append(name.ToString());
for (i = 0; i < proc.argList.Length; i++)
{
TclObject arg = proc.argList[i][0];
TclObject def = proc.argList[i][1];
sbuf.Append(" ");
if (def != null)
{
sbuf.Append("?");
}
sbuf.Append(arg.ToString());
if (def != null)
{
sbuf.Append("?");
}
}
sbuf.Append("\"");
throw new TclException(interp, sbuf.ToString());
}
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);
}
/// <summary> Evaluates a Tcl expression. See Tcl user documentation for
/// details.
/// </summary>
/// <exception cref=""> TclException If malformed expression.
/// </exception>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
if ( argv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, argv, "arg ?arg ...?" );
}
if ( argv.Length == 2 )
{
interp.setResult( interp.expr.eval( interp, argv[1].ToString() ) );
}
else
{
StringBuilder sbuf = new StringBuilder();
sbuf.Append( argv[1].ToString() );
for ( int i = 2; i < argv.Length; i++ )
{
sbuf.Append( ' ' );
sbuf.Append( argv[i].ToString() );
}
interp.setResult( interp.expr.eval( interp, sbuf.ToString() ) );
}
return TCL.CompletionCode.RETURN;
}
/*
*----------------------------------------------------------------------
*
* InfoArgsCmd --
*
* Called to implement the "info args" command that returns the
* argument list for a procedure. Handles the following syntax:
*
* info args procName
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
private static void InfoArgsCmd(Interp interp, TclObject[] objv)
{
string name;
Procedure proc;
TclObject listObj;
if (objv.Length != 3)
{
throw new TclNumArgsException(interp, 2, objv, "procname");
}
name = objv[2].ToString();
proc = Procedure.findProc(interp, name);
if (proc == null)
{
throw new TclException(interp, "\"" + name + "\" isn't a procedure");
}
// Build a return list containing the arguments.
listObj = TclList.newInstance();
for (int i = 0; i < proc.argList.Length; i++)
{
TclObject s = TclString.newInstance(proc.argList[i][0]);
TclList.append(interp, listObj, s);
}
interp.setResult(listObj);
return;
}
/// <deprecated> The takeExclusive method has been deprecated
/// in favor of the new duplicate() method. The takeExclusive
/// method would modify the ref count of the original object
/// and return an object with a ref count of 1 instead of 0.
/// These two behaviors lead to lots of useless duplication
/// of objects that could be modified directly.
/// </deprecated>
public TclObject takeExclusive()
{
disposedCheck();
if (refCount == 1)
{
return(this);
}
else if (refCount > 1)
{
if (internalRep is TclString)
{
if ((System.Object)stringRep == null)
{
stringRep = internalRep.ToString();
}
}
TclObject newObj = new TclObject(internalRep.duplicate());
newObj.stringRep = this.stringRep;
newObj.refCount = 1;
refCount--;
return(newObj);
}
else
{
throw new TclRuntimeError("takeExclusive() called on object \"" + ToString() + "\" with: refCount = 0");
}
}
/// <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;
}
/*
*----------------------------------------------------------------------
*
* AppendLocals --
*
* Append the local variables for the current frame to the
* specified list object.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
private static void AppendLocals(Interp interp, TclObject list, string pattern, bool includeLinks)
{
Var var;
string varName;
Hashtable localVarTable;
IDictionaryEnumerator search;
localVarTable = interp.varFrame.varTable;
// Compiled locals do not exist in Jacl
if (localVarTable != null)
{
for (search = localVarTable.GetEnumerator(); search.MoveNext();)
{
var = (Var)search.Value;
varName = (string)search.Key;
if (!var.isVarUndefined() && (includeLinks || !var.isVarLink()))
{
if (((System.Object)pattern == null) || Util.stringMatch(varName, pattern))
{
TclList.append(interp, list, TclString.newInstance(varName));
}
}
}
}
}
/// <summary> Chain this frame into the call frame stack and binds the parameters
/// values to the formal parameters of the procedure.
///
/// </summary>
/// <param name="proc">the procedure.
/// </param>
/// <param name="proc">argv the parameter values.
/// </param>
/// <exception cref=""> TclException if wrong number of arguments.
/// </exception>
internal void chain( Procedure proc, TclObject[] objv )
{
// FIXME: double check this ns thing in case where proc is renamed to different ns.
this.ns = proc.ns;
this.objv = objv;
// FIXME : quick level hack : fix later
level = ( interp.varFrame == null ) ? 1 : ( interp.varFrame.level + 1 );
caller = interp.frame;
callerVar = interp.varFrame;
interp.frame = this;
interp.varFrame = this;
// parameter bindings
int numArgs = proc.argList.Length;
if ( ( !proc.isVarArgs ) && ( objv.Length - 1 > numArgs ) )
{
wrongNumProcArgs( objv[0], proc );
}
int i, j;
for ( i = 0, j = 1; i < numArgs; i++, j++ )
{
// Handle the special case of the last formal being
// "args". When it occurs, assign it a list consisting of
// all the remaining actual arguments.
TclObject varName = proc.argList[i][0];
TclObject value = null;
if ( ( i == ( numArgs - 1 ) ) && proc.isVarArgs )
{
value = TclList.newInstance();
value.preserve();
for ( int k = j; k < objv.Length; k++ )
{
TclList.append( interp, value, objv[k] );
}
interp.setVar( varName, value, 0 );
value.release();
}
else
{
if ( j < objv.Length )
{
value = objv[j];
}
else if ( proc.argList[i][1] != null )
{
value = proc.argList[i][1];
}
else
{
wrongNumProcArgs( objv[0], proc );
}
interp.setVar( varName, value, 0 );
}
}
}
internal static Interp getInterp(Interp interp, TclObject path)
{
TclObject[] objv = TclList.getElements(interp, path);
Interp searchInterp = interp; //Interim storage for interp. to find.
for (int i = 0; i < objv.Length; i++)
{
string name = objv[i].ToString();
if (!searchInterp.slaveTable.ContainsKey(name))
{
searchInterp = null;
break;
}
InterpSlaveCmd slave = (InterpSlaveCmd)searchInterp.slaveTable[name];
searchInterp = slave.slaveInterp;
if (searchInterp == null)
{
break;
}
}
if (searchInterp == null)
{
throw new TclException(interp, "could not find interpreter \"" + path.ToString() + "\"");
}
return(searchInterp);
}
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);
}
/// <summary> Returns the bytes of a ByteArray object. If tobj is not a ByteArray
/// object, an attempt will be made to convert it to a ByteArray. <p>
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="tobj">the byte array object.
/// </param>
/// <returns> a byte array.
/// </returns>
/// <exception cref=""> TclException if tobj is not a valid ByteArray.
/// </exception>
public static byte[] getBytes(Interp interp, TclObject tobj)
{
setByteArrayFromAny(interp, tobj);
TclByteArray tbyteArray = (TclByteArray)tobj.InternalRep;
return(tbyteArray.bytes);
}
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> Returns the value of the object as an boolean.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the TclObject to use as an boolean.
/// </param>
/// <returns> the boolean value of the object.
/// </returns>
/// <exception cref=""> TclException if the object cannot be converted into a
/// boolean.
/// </exception>
public static bool get(Interp interp, TclObject tobj)
{
setBooleanFromAny(interp, tobj);
TclBoolean tbool = (TclBoolean)(tobj.InternalRep);
return(tbool.value);
}
public TCL.CompletionCode cmdProc(Interp interp, TclObject[] argv)
{
if (argv.Length != 2)
{
throw new TclNumArgsException(interp, 1, argv, "name");
}
VwaitTrace trace = new VwaitTrace();
Var.traceVar(interp, argv[1], TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.TRACE_WRITES | TCL.VarFlag.TRACE_UNSETS, trace);
int foundEvent = 1;
while (!trace.done && (foundEvent != 0))
{
foundEvent = interp.getNotifier().doOneEvent(TCL.ALL_EVENTS);
}
Var.untraceVar(interp, argv[1], TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.TRACE_WRITES | TCL.VarFlag.TRACE_UNSETS, trace);
// Clear out the interpreter's result, since it may have been set
// by event handlers.
interp.resetResult();
if (foundEvent == 0)
{
throw new TclException(interp, "can't wait for variable \"" + argv[1] + "\": would wait forever");
}
return TCL.CompletionCode.RETURN;
}
public TclPosixException(Interp interp, int errno, bool appendPosixMsg, string errorMsg)
: base(TCL.CompletionCode.ERROR)
{
string msg = getPosixMsg(errno);
TclObject threeEltListObj = TclList.newInstance();
TclList.append(interp, threeEltListObj, TclString.newInstance("POSIX"));
TclList.append(interp, threeEltListObj, TclString.newInstance(getPosixId(errno)));
TclList.append(interp, threeEltListObj, TclString.newInstance(msg));
interp.setErrorCode(threeEltListObj);
if (interp != null)
{
if (appendPosixMsg)
{
interp.setResult(errorMsg + ": " + msg);
}
else
{
interp.setResult(errorMsg);
}
}
}
/// <summary> Creates a TclException with the appropiate Tcl error
/// message for having the wring number of arguments to a Tcl command.
/// <p>
/// Example: <pre>
///
/// if (argv.length != 3) {
/// throw new TclNumArgsException(interp, 1, argv, "option name");
/// }
/// </pre>
///
/// </summary>
/// <param name="interp">current Interpreter.
/// </param>
/// <param name="argc">the number of arguments to copy from the offending
/// command to put into the error message.
/// </param>
/// <param name="argv">the arguments of the offending command.
/// </param>
/// <param name="message">extra message to appear in the error message that
/// explains the proper usage of the command.
/// </param>
/// <exception cref=""> TclException is always thrown.
/// </exception>
public TclNumArgsException( Interp interp, int argc, TclObject[] argv, string message )
: base(TCL.CompletionCode.ERROR)
{
if ( interp != null )
{
StringBuilder buff = new StringBuilder( 50 );
buff.Append( "wrong # args: should be \"" );
for ( int i = 0; i < argc; i++ )
{
if ( argv[i].InternalRep is TclIndex )
{
buff.Append( argv[i].InternalRep.ToString() );
}
else
{
buff.Append( argv[i].ToString() );
}
if ( i < ( argc - 1 ) )
{
buff.Append( " " );
}
}
if ( ( message != null ) )
{
buff.Append( " " + message );
}
buff.Append( "\"" );
interp.setResult( buff.ToString() );
}
}
internal Procedure(Interp interp, NamespaceCmd.Namespace ns, string name, TclObject args, TclObject b, string sFileName, int sLineNumber)
{
this.ns = ns;
srcFileName = sFileName;
srcLineNumber = sLineNumber;
// Break up the argument list into argument specifiers, then process
// each argument specifier.
int numArgs = TclList.getLength(interp, args);
argList = new TclObject[numArgs][];
for (int i = 0; i < numArgs; i++)
{
argList[i] = new TclObject[2];
}
for (int i = 0; i < numArgs; i++)
{
// Now divide the specifier up into name and default.
TclObject argSpec = TclList.index(interp, args, i);
int specLen = TclList.getLength(interp, argSpec);
if (specLen == 0)
{
throw new TclException(interp, "procedure \"" + name + "\" has argument with no name");
}
if (specLen > 2)
{
throw new TclException(interp, "too many fields in argument " + "specifier \"" + argSpec + "\"");
}
argList[i][0] = TclList.index(interp, argSpec, 0);
argList[i][0].preserve();
if (specLen == 2)
{
argList[i][1] = TclList.index(interp, argSpec, 1);
argList[i][1].preserve();
}
else
{
argList[i][1] = null;
}
}
if (numArgs > 0 && (argList[numArgs - 1][0].ToString().Equals("args")))
{
isVarArgs = true;
}
else
{
isVarArgs = false;
}
body = new CharPointer(b.ToString());
body_length = body.length();
}
/// <summary> SetIntFromAny -> TclInteger.setIntegerFromAny
///
/// Called to convert the other object's internal rep to this type.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="forIndex">true if this methid is called by getForIndex.
/// </param>
/// <param name="tobj">the TclObject to convert to use the
/// representation provided by this class.
/// </param>
private static void setIntegerFromAny(Interp interp, TclObject tobj)
{
InternalRep rep = tobj.InternalRep;
if (rep is TclInteger)
{
// Do nothing.
}
else if (rep is TclBoolean)
{
bool b = TclBoolean.get(interp, tobj);
if (b)
{
tobj.InternalRep = new TclInteger(1);
}
else
{
tobj.InternalRep = new TclInteger(0);
}
}
else
{
// (ToDo) other short-cuts
tobj.InternalRep = new TclInteger(interp, tobj.ToString());
}
}
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 static string Tcl_GetStringFromObj(TclObject to, ref int n)
{
string ts = System.Text.Encoding.UTF8.GetString(System.Text.Encoding.UTF8.GetBytes(to.ToString()));
n = ts.Length;
return(ts);
}
/// <summary> This procedure is invoked to process the "gets" 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>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
bool writeToVar = false; // If true write to var passes as arg
string varName = ""; // The variable to write value to
Channel chan; // The channel being operated on
int lineLen;
TclObject line;
if ( ( argv.Length < 2 ) || ( argv.Length > 3 ) )
{
throw new TclNumArgsException( interp, 1, argv, "channelId ?varName?" );
}
if ( argv.Length == 3 )
{
writeToVar = true;
varName = argv[2].ToString();
}
chan = TclIO.getChannel( interp, argv[1].ToString() );
if ( chan == null )
{
throw new TclException( interp, "can not find channel named \"" + argv[1].ToString() + "\"" );
}
try
{
line = TclString.newInstance( new StringBuilder( 64 ) );
lineLen = chan.read( interp, line, TclIO.READ_LINE, 0 );
if ( lineLen < 0 )
{
// FIXME: Need more specific posix error codes!
if ( !chan.eof() && !chan.isBlocked( interp ) )
{
throw new TclPosixException( interp, TclPosixException.EIO, true, "error reading \"" + argv[1].ToString() + "\"" );
}
lineLen = -1;
}
if ( writeToVar )
{
interp.setVar( varName, line, 0 );
interp.setResult( lineLen );
}
else
{
interp.setResult( line );
}
}
catch ( IOException e )
{
throw new TclRuntimeError( "GetsCmd.cmdProc() Error: IOException when getting " + chan.ChanName + ": " + e.Message );
}
return TCL.CompletionCode.RETURN;
}
public static void Tcl_DecrRefCount(ref TclObject to)
{
to.release();
if (to.internalRep == null)
{
to = null;
}
}
public static string Tcl_GetStringFromObj(TclObject to, out int n)
{
byte[] tb = System.Text.Encoding.UTF8.GetBytes(to.ToString());
string ts = System.Text.Encoding.UTF8.GetString(tb, 0, tb.Length);
n = ts.Length;
return(ts);
}
/// <summary> Queries the length of the list. If tobj is not a list object,
/// an attempt will be made to convert it to a list.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the TclObject to use as a list.
/// </param>
/// <returns> the length of the list.
/// </returns>
/// <exception cref=""> TclException if tobj is not a valid list.
/// </exception>
public static int getLength(Interp interp, TclObject tobj)
{
setListFromAny(interp, tobj);
TclList tlist = (TclList)tobj.InternalRep;
return(tlist.vector.Count);
}
/// <summary> This procedure is invoked to process the "break" Tcl command.
/// See the user documentation for details on what it does.
/// </summary>
/// <exception cref=""> TclException is always thrown.
/// </exception>
public TCL.CompletionCode cmdProc(Interp interp, TclObject[] argv)
{
if (argv.Length != 1)
{
throw new TclNumArgsException(interp, 1, argv, null);
}
throw new TclException(interp, null, TCL.CompletionCode.BREAK);
}
/// <summary> This procedure inserts the elements in elements[] into the list at
/// the given index. If tobj is not a list object, an attempt will
/// be made to convert it to a list.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the TclObject to use as a list.
/// </param>
/// <param name="index">the starting index of the insertion operation. <=0 means
/// the beginning of the list. >= TclList.getLength(tobj) means
/// the end of the list.
/// </param>
/// <param name="elements">the element(s) to insert.
/// </param>
/// <param name="from">insert elements starting from elements[from] (inclusive)
/// </param>
/// <param name="to">insert elements up to elements[to] (inclusive)
/// </param>
/// <exception cref=""> TclException if tobj is not a valid list.
/// </exception>
internal static void insert(Interp interp, TclObject tobj, int index, TclObject[] elements, int from, int to)
{
if (tobj.Shared)
{
throw new TclRuntimeError("TclList.insert() called with shared object");
}
replace(interp, tobj, index, 0, elements, from, to);
}
/// <summary> Queries the length of the byte array. If tobj is not a byte array
/// object, an attempt will be made to convert it to a byte array.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the TclObject to use as a byte array.
/// </param>
/// <returns> the length of the byte array.
/// </returns>
/// <exception cref=""> TclException if tobj is not a valid byte array.
/// </exception>
public static int getLength(Interp interp, TclObject tobj)
{
setByteArrayFromAny(interp, tobj);
TclByteArray tbyteArray = (TclByteArray)tobj.InternalRep;
return(tbyteArray.used);
}
public static bool Tcl_ListObjAppendElement(Interp interp, TclObject to, TclObject elemObj)
{
try
{
TclList.append(interp, to, elemObj);
return(false);
}
catch { return(true); }
}
public static void Tcl_SetLongObj(TclObject to, long result)
{
while (to.Shared)
{
to.release();
}
TclLong.set(to, result);
to.preserve();
}
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); };
}
internal BgErrorMgr(Interp i)
{
InitBlock();
interp = i;
bgerrorCmdObj = TclString.newInstance("bgerror");
bgerrorCmdObj.preserve();
errors = new ArrayList(10);
}
static int Tcl_GetIndexFromObjStruct( Interp interp, TclObject to, BackupSubCommand[] table, int len, string msg, int flags, ref int index )
{
string zCmd = to.ToString();
for ( index = 0 ; index < len ; index++ )
{
if ( zCmd == table[index].zCmd ) return 0;
}
return 1;
}
internal BgErrorMgr( Interp i )
{
InitBlock();
interp = i;
bgerrorCmdObj = TclString.newInstance( "bgerror" );
bgerrorCmdObj.preserve();
errors = new ArrayList( 10 );
}
/// <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)
{
if (argv.Length != 2)
{
throw new TclNumArgsException(interp, 1, argv, "list");
}
interp.setResult(TclInteger.newInstance(TclList.getLength(interp, argv[1])));
return TCL.CompletionCode.RETURN;
}
internal static int FormatNumber(Interp interp, char type, TclObject src, byte[] resultBytes, int cursor)
{
if (type == 'd')
{
double dvalue = TclDouble.get(interp, src);
System.IO.MemoryStream ms = new System.IO.MemoryStream(resultBytes, cursor, 8);
System.IO.BinaryWriter writer = new System.IO.BinaryWriter(ms);
writer.Write(dvalue);
cursor += 8;
writer.Close();
ms.Close();
}
else if (type == 'f')
{
float fvalue = (float)TclDouble.get(interp, src);
System.IO.MemoryStream ms = new System.IO.MemoryStream(resultBytes, cursor, 4);
System.IO.BinaryWriter writer = new System.IO.BinaryWriter(ms);
writer.Write(fvalue);
cursor += 4;
writer.Close();
ms.Close();
}
else
{
int value = TclInteger.get(interp, src);
if (type == 'c')
{
resultBytes[cursor++] = (byte)value;
}
else if (type == 's')
{
resultBytes[cursor++] = (byte)value;
resultBytes[cursor++] = (byte)(value >> 8);
}
else if (type == 'S')
{
resultBytes[cursor++] = (byte)(value >> 8);
resultBytes[cursor++] = (byte)value;
}
else if (type == 'i')
{
resultBytes[cursor++] = (byte)value;
resultBytes[cursor++] = (byte)(value >> 8);
resultBytes[cursor++] = (byte)(value >> 16);
resultBytes[cursor++] = (byte)(value >> 24);
}
else if (type == 'I')
{
resultBytes[cursor++] = (byte)(value >> 24);
resultBytes[cursor++] = (byte)(value >> 16);
resultBytes[cursor++] = (byte)(value >> 8);
resultBytes[cursor++] = (byte)value;
}
}
return(cursor);
}
/// <summary> Tcl_UpvarObjCmd -> UpvarCmd.cmdProc
///
/// This procedure is invoked to process the "upvar" Tcl command.
/// See the user documentation for details on what it does.
/// </summary>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
CallFrame frame;
string frameSpec, otherVarName, myVarName;
int p;
int objc = objv.Length, objv_index;
int result;
if ( objv.Length < 3 )
{
throw new TclNumArgsException( interp, 1, objv, "?level? otherVar localVar ?otherVar localVar ...?" );
}
// Find the call frame containing each of the "other variables" to be
// linked to.
frameSpec = 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, frameSpec, frameArr );
frame = frameArr[0];
objc -= ( result + 1 );
if ( ( objc & 1 ) != 0 )
{
throw new TclNumArgsException( interp, 1, objv, "?level? otherVar localVar ?otherVar localVar ...?" );
}
objv_index = result + 1;
// Iterate over each (other variable, local variable) pair.
// Divide the other variable name into two parts, then call
// MakeUpvar to do all the work of linking it to the local variable.
for ( ; objc > 0; objc -= 2, objv_index += 2 )
{
myVarName = objv[objv_index + 1].ToString();
otherVarName = objv[objv_index].ToString();
int otherLength = otherVarName.Length;
p = otherVarName.IndexOf( (System.Char)'(' );
if ( ( p != -1 ) && ( otherVarName[otherLength - 1] == ')' ) )
{
// This is an array variable name
Var.makeUpvar( interp, frame, otherVarName.Substring( 0, ( p ) - ( 0 ) ), otherVarName.Substring( p + 1, ( otherLength - 1 ) - ( p + 1 ) ), 0, myVarName, 0 );
}
else
{
// This is a scalar variable name
Var.makeUpvar( interp, frame, otherVarName, null, 0, myVarName, 0 );
}
}
interp.resetResult();
return TCL.CompletionCode.RETURN;
}
public static TclObject Tcl_GetVar2Ex(Interp interp, string part1, string part2, VarFlag flags)
{
try
{
Var[] result = Var.lookupVar(interp, part1, part2, flags, "read", false, true);
if (result == null)
{
// lookupVar() returns null only if VarFlag.LEAVE_ERR_MSG is
// not part of the flags argument, return null in this case.
return(null);
}
Var var = result[0];
Var array = result[1];
TclObject to = null;
if (var.isVarScalar() && !var.isVarUndefined())
{
to = (TclObject)var.value;
//if ( to.typePtr != "String" )
//{
// double D = 0;
// if ( !Double.TryParse( to.ToString(), out D ) ) { if ( String.IsNullOrEmpty( to.typePtr ) ) to.typePtr = "string"; }
// else if ( to.typePtr == "ByteArray" )
// to.typePtr = "bytearray";
// else if ( to.ToString().Contains( "." ) )
// to.typePtr = "double";
// else
// to.typePtr = "int";
//}
return(to);
}
else if (var.isSQLITE3_Link())
{
to = (TclObject)var.sqlite3_get();
}
else
{
to = TclList.newInstance();
foreach (string key in ((Hashtable)array.value).Keys)
{
Var s = (Var)((Hashtable)array.value)[key];
if (s.value != null)
{
TclList.append(null, to, TclString.newInstance(s.value.ToString()));
}
}
}
return(to);
}
catch (Exception e)
{
return(null);
};
}
/// <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 TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
targetInterp.preserve();
targetInterp.nestLevel++;
targetInterp.resetResult();
targetInterp.allowExceptions();
// Append the arguments to the command prefix and invoke the command
// in the target interp's global namespace.
TclObject[] prefv = TclList.getElements( interp, prefix );
TclObject cmd = TclList.newInstance();
cmd.preserve();
TclList.replace( interp, cmd, 0, 0, prefv, 0, prefv.Length - 1 );
TclList.replace( interp, cmd, prefv.Length, 0, argv, 1, argv.Length - 1 );
TclObject[] cmdv = TclList.getElements( interp, cmd );
TCL.CompletionCode result = targetInterp.invoke( cmdv, Interp.INVOKE_NO_TRACEBACK );
cmd.release();
targetInterp.nestLevel--;
// Check if we are at the bottom of the stack for the target interpreter.
// If so, check for special return codes.
if ( targetInterp.nestLevel == 0 )
{
if ( result == TCL.CompletionCode.RETURN )
{
result = targetInterp.updateReturnInfo();
}
if ( result != TCL.CompletionCode.OK && result != TCL.CompletionCode.ERROR )
{
try
{
targetInterp.processUnexpectedResult( result );
}
catch ( TclException e )
{
result = e.getCompletionCode();
}
}
}
targetInterp.release();
interp.transferResult( targetInterp, result );
return TCL.CompletionCode.RETURN;
}
// The new value for the object.
public static void set( TclObject tobj, double d )
{
tobj.invalidateStringRep();
InternalRep rep = tobj.InternalRep;
if ( rep is TclDouble )
{
TclDouble tdouble = (TclDouble)rep;
tdouble.value = d;
}
else
{
tobj.InternalRep = new TclDouble( d );
}
}
/// <summary>----------------------------------------------------------------------
///
/// Tcl_RenameObjCmd -> RenameCmd.cmdProc
///
/// This procedure is invoked to process the "rename" Tcl command.
/// See the user documentation for details on what it does.
///
/// Results:
/// A standard Tcl object result.
///
/// Side effects:
/// See the user documentation.
///
/// ----------------------------------------------------------------------
/// </summary>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
string oldName, newName;
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 1, objv, "oldName newName" );
}
oldName = objv[1].ToString();
newName = objv[2].ToString();
interp.renameCommand( oldName, newName );
return TCL.CompletionCode.RETURN;
}
/// <summary> Changes the object value of the object.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the object to operate on.
/// @paran i the new object value.
/// </param>
public static void set( TclObject tobj, object o )
{
tobj.invalidateStringRep();
InternalRep rep = tobj.InternalRep;
TclObj tint;
if ( rep is TclObj )
{
tint = (TclObj)rep;
tint.value = o;
}
else
{
tobj.InternalRep = new TclObj( o );
}
}
public static double get( Interp interp, TclObject tobj )
{
InternalRep rep = tobj.InternalRep;
TclDouble tdouble;
if ( !( rep is TclDouble ) )
{
setDoubleFromAny( interp, tobj );
tdouble = (TclDouble)( tobj.InternalRep );
}
else
{
tdouble = (TclDouble)rep;
}
return tdouble.value;
}
/// <summary> See Tcl user documentation for details.</summary>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, objv, "varName ?varName ...?" );
}
// If we are not executing inside a Tcl procedure, just return.
if ( ( interp.varFrame == null ) || !interp.varFrame.isProcCallFrame )
{
return TCL.CompletionCode.RETURN;
}
for ( int i = 1; i < objv.Length; i++ )
{
// Make a local variable linked to its counterpart in the global ::
// namespace.
TclObject obj = objv[i];
string varName = obj.ToString();
// The variable name might have a scope qualifier, but the name for
// the local "link" variable must be the simple name at the tail.
int tail = varName.Length;
tail -= 1; // tail should start on the last index of the string
while ( ( tail > 0 ) && ( ( varName[tail] != ':' ) || ( varName[tail - 1] != ':' ) ) )
{
tail--;
}
if ( varName[tail] == ':' )
{
tail++;
}
// Link to the variable "varName" in the global :: namespace.
Var.makeUpvar( interp, null, varName, null, TCL.VarFlag.GLOBAL_ONLY, varName.Substring( tail ), 0 );
}
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;
}
/// <summary> See Tcl user documentation for details.</summary>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
TclObject list = TclList.newInstance();
list.preserve();
try
{
for ( int i = 1; i < argv.Length; i++ )
TclList.append( interp, list, argv[i] );
interp.setResult( list );
}
finally
{
list.release();
}
return TCL.CompletionCode.RETURN;
}
/// <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;
}
/// <summary> See Tcl user documentation for details.</summary>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
int code;
if ( argv.Length > 2 )
{
throw new TclNumArgsException( interp, 1, argv, "?returnCode?" );
}
if ( argv.Length == 2 )
{
code = TclInteger.get( interp, argv[1] );
}
else
{
code = 0;
}
return TCL.CompletionCode.EXIT;
}
