public static void Tcl_Free(ref TclObject to)
{
while (to.refCount > 0)
{
to.Release();
}
}
private ArrayList Errors = new ArrayList(10); // A list of the pending background error handlers.
internal BgErrorMgr(Interp i)
{
Interp = i;
BgerrorCmdObj = TclString.NewInstance("bgerror");
BgerrorCmdObj.Preserve();
Errors = new ArrayList(10);
}
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);
}
/*
*----------------------------------------------------------------------
*
* 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>
/// 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);
}
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);
}
/*
*----------------------------------------------------------------------
*
* 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;
}
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> 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> 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)
{
IInternalRep 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());
}
}
/// <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);
}
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> 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);
}
/// <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);
}
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);
}
/// <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> 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> 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);
}
}
}
public static void Tcl_DecrRefCount(ref TclObject to)
{
to.Release();
if (to.internalRep == null)
{
to = null;
}
}
/// <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 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);
}
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 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 void Tcl_SetLongObj(TclObject to, long result)
{
while (to.Shared)
{
to.Release();
}
TclLong.set(to, result);
to.Preserve();
}
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.Ext_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);
};
}
internal static int FormatNumber(Interp interp, char type, TclObject src, byte[] resultBytes, int cursor)
{
if (type == 'd')
{
double dvalue = TclDouble.Get(interp, src);
MemoryStream ms = new MemoryStream(resultBytes, cursor, 8);
BinaryWriter writer = new BinaryWriter(ms);
writer.Write(dvalue);
cursor += 8;
writer.Close();
ms.Close();
}
else if (type == 'f')
{
float fvalue = (float)TclDouble.Get(interp, src);
MemoryStream ms = new MemoryStream(resultBytes, cursor, 4);
BinaryWriter writer = new 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);
}
public static TclObject Tcl_NewListObj(int nArg, TclObject[] aArg)
{
TclObject to = TclList.NewInstance();
for (int i = 0; i < nArg; i++)
{
TclList.Append(null, to, aArg[i]);
}
return(to);
}
/// <summary> Called to convert the other object's internal rep to a ByteArray.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the TclObject to convert to use the ByteArray internal rep.
/// </param>
/// <exception cref=""> TclException if the object doesn't contain a valid ByteArray.
/// </exception>
internal static void setByteArrayFromAny(Interp interp, TclObject tobj)
{
IInternalRep rep = tobj.InternalRep;
if (!(rep is TclByteArray))
{
char[] c = tobj.ToString().ToCharArray();
tobj.InternalRep = new TclByteArray(c);
}
}
public override void ProcessIdleEvent()
{
try
{
SupportClass.VectorRemoveElement(EnclosingInstance._assocData.Handlers, this);
Interp.Eval(Command, TCL.EVAL_GLOBAL);
}
catch (TclException e) { Interp.AddErrorInfo("\n (\"after\" script)"); Interp.BackgroundError(); }
finally { Command.Release(); Command = null; }
}
public static void Tcl_SetIntObj(TclObject to, int result
)
{
while (to.Shared)
{
to.Release();
}
TclInteger.set(to, result);
to.Preserve();
}
