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;
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);
}
if (var.isSQLITE3_Link())
{
to = (TclObject)var.sqlite3_get();
}
return(to);
}
catch { return(null); };
}
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();
}
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);
}
/// <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());
}
}
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 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);
}
internal static void create(Interp interp, Interp slaveInterp, Interp masterInterp, TclObject name, TclObject targetName, int objIx, TclObject[] objv)
{
string inString = name.ToString();
InterpAliasCmd alias = new InterpAliasCmd();
alias.name = name;
name.preserve();
alias.slaveInterp = slaveInterp;
alias.targetInterp = masterInterp;
alias.prefix = TclList.newInstance();
alias.prefix.preserve();
TclList.append(interp, alias.prefix, targetName);
TclList.insert(interp, alias.prefix, 1, objv, objIx, objv.Length - 1);
slaveInterp.createCommand(inString, alias);
alias.slaveCmd = NamespaceCmd.findCommand(slaveInterp, inString, null, 0);
try
{
interp.preventAliasLoop(slaveInterp, alias.slaveCmd);
}
catch (TclException e)
{
// Found an alias loop! The last call to Tcl_CreateObjCommand made
// the alias point to itself. Delete the command and its alias
// record. Be careful to wipe out its client data first, so the
// command doesn't try to delete itself.
slaveInterp.deleteCommandFromToken(alias.slaveCmd);
throw;
}
// Make an entry in the alias table. If it already exists delete
// the alias command. Then retry.
if (slaveInterp.aliasTable.ContainsKey(inString))
{
InterpAliasCmd oldAlias = (InterpAliasCmd)slaveInterp.aliasTable[inString];
slaveInterp.deleteCommandFromToken(oldAlias.slaveCmd);
}
alias.aliasEntry = inString;
SupportClass.PutElement(slaveInterp.aliasTable, inString, alias);
// Create the new command. We must do it after deleting any old command,
// because the alias may be pointing at a renamed alias, as in:
//
// interp alias {} foo {} bar # Create an alias "foo"
// rename foo zop # Now rename the alias
// interp alias {} foo {} zop # Now recreate "foo"...
SupportClass.PutElement(masterInterp.targetTable, alias.slaveCmd, slaveInterp);
interp.setResult(name);
}
/// <summary> Write to stdout or stderr. If the stdType is not set to
/// STDOUT or STDERR this is an error; either the stdType wasnt
/// correctly initialized, or this was called on a STDIN channel.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="s">the string to write
/// </param>
public override void write(Interp interp, TclObject outData)
{
checkWrite(interp);
if (stdType == STDERR)
{
System.Console.Error.Write(outData.ToString());
}
else
{
string s = outData.ToString();
System.Console.Out.Write(s);
if (buffering == TclIO.BUFF_NONE || (buffering == TclIO.BUFF_LINE && s.EndsWith("\n")))
{
System.Console.Out.Flush();
}
}
}
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;
}
/// <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)
{
InternalRep rep = tobj.InternalRep;
if (!(rep is TclByteArray))
{
char[] c = tobj.ToString().ToCharArray();
tobj.InternalRep = new TclByteArray(c);
}
}
/// <summary> Called to convert the other object's internal rep to list.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the TclObject to convert to use the List internal rep.
/// </param>
/// <exception cref=""> TclException if the object doesn't contain a valid list.
/// </exception>
internal static void setListFromAny(Interp interp, TclObject tobj)
{
InternalRep rep = tobj.InternalRep;
if (!(rep is TclList))
{
TclList tlist = new TclList();
splitList(interp, tlist.vector, tobj.ToString());
tobj.InternalRep = tlist;
}
}
/// <summary> Appends an array of characters to a TclObject Object.
/// Tcl_AppendUnicodeToObj() in Tcl 8.0.
///
/// </summary>
/// <param name="tobj">the TclObject to append a string to.
/// </param>
/// <param name="charArr">array of characters.
/// </param>
/// <param name="offset">index of first character to append.
/// </param>
/// <param name="length">number of characters to append.
/// </param>
public static void append(TclObject tobj, char[] charArr, int offset, int length)
{
StringFromAny = tobj;
TclString tstr = (TclString)tobj.InternalRep;
if (tstr.sbuf == null)
{
tstr.sbuf = new System.Text.StringBuilder(tobj.ToString());
}
tobj.invalidateStringRep();
tstr.sbuf.Append(charArr, offset, length);
}
/// <summary> Appends a string to a TclObject object. This method is equivalent to
/// Tcl_AppendToObj() in Tcl 8.0.
///
/// </summary>
/// <param name="tobj">the TclObject to append a string to.
/// </param>
/// <param name="string">the string to append to the object.
/// </param>
public static void append(TclObject tobj, string toAppend)
{
StringFromAny = tobj;
TclString tstr = (TclString)tobj.InternalRep;
if (tstr.sbuf == null)
{
tstr.sbuf = new System.Text.StringBuilder(tobj.ToString());
}
tobj.invalidateStringRep();
tstr.sbuf.Append(toAppend);
}
internal static void describe(Interp interp, Interp slaveInterp, TclObject name)
{
// If the alias has been renamed in the slave, the master can still use
// the original name (with which it was created) to find the alias to
// describe it.
string inString = name.ToString();
if (slaveInterp.aliasTable.ContainsKey(inString))
{
InterpAliasCmd alias = (InterpAliasCmd)slaveInterp.aliasTable[inString];
interp.setResult(alias.prefix);
}
}
public static bool Tcl_GetDoubleFromObj(Interp interp, TclObject to, ref double value)
{
try
{
if (to.ToString() == "NaN")
{
value = Double.NaN;
}
else
{
value = TclDouble.get(interp, to);
}
return(false);
}
catch { return(true); }
}
public static bool Tcl_GetWideIntFromObj(Interp interp, TclObject to, ref sqlite_int64 value)
{
try
{
if (to.ToString() == "NaN")
{
unchecked { value = (long)Double.NaN; }
}
else
{
value = TclLong.get(interp, to);
}
return(false);
}
catch { return(true); };
}
public static bool Tcl_ObjSetVar2(Interp interp, TclObject toName, TclObject part2, TclObject toValue, VarFlag flags)
{
try
{
if (part2 == null)
{
interp.setVar(toName, toValue, flags);
}
else
{
interp.setVar(toName.ToString(), part2.ToString(), toValue.ToString(), flags);
}
return(false);
}
catch { return(true); }
}
internal static int getIntForIndex(Interp interp, TclObject tobj, int endValue)
{
int length, offset;
if (tobj.InternalRep is TclInteger)
{
return(TclInteger.get(interp, tobj));
}
string bytes = tobj.ToString();
length = bytes.Length;
string intforindex_error = "bad index \"" + bytes + "\": must be integer or end?-integer?" + checkBadOctal(interp, bytes);
// FIXME : should we replace this call to regionMatches with a generic strncmp?
if (!(String.Compare("end", 0, bytes, 0, (length > 3) ? 3 : length) == 0))
{
try
{
offset = TclInteger.get(null, tobj);
}
catch (TclException e)
{
throw new TclException(interp, "bad index \"" + bytes + "\": must be integer or end?-integer?" + checkBadOctal(interp, bytes));
}
return(offset);
}
if (length <= 3)
{
return(endValue);
}
else if (bytes[3] == '-')
{
// This is our limited string expression evaluator
offset = Util.getInt(interp, bytes.Substring(3));
return(endValue + offset);
}
else
{
throw new TclException(interp, "bad index \"" + bytes + "\": must be integer or end?-integer?" + checkBadOctal(interp, bytes.Substring(3)));
}
}
/// <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);
}
internal static void delete(Interp interp, Interp slaveInterp, TclObject name)
{
// If the alias has been renamed in the slave, the master can still use
// the original name (with which it was created) to find the alias to
// delete it.
string inString = name.ToString();
if (!slaveInterp.aliasTable.ContainsKey(inString))
{
throw new TclException(interp, "alias \"" + inString + "\" not found");
}
InterpAliasCmd alias = (InterpAliasCmd)slaveInterp.aliasTable[inString];
slaveInterp.deleteCommandFromToken(alias.slaveCmd);
}
public static Regexp compile(Interp interp, TclObject exp, bool nocase)
{
try
{
return(new Regexp(exp.ToString(), nocase));
}
catch (System.ArgumentException e)
{
string msg = e.Message;
if (msg.Equals("missing )"))
{
msg = "unmatched ()";
}
else if (msg.Equals("missing ]"))
{
msg = "unmatched []";
}
msg = "couldn't compile regular expression pattern: " + msg;
throw new TclException(interp, msg);
}
}
private static string getTail(Interp interp, string path)
{
// Split the path and return the string form of the last component,
// unless there is only one component which is the root or an absolute
// path.
TclObject splitResult = FileUtil.splitAndTranslate(interp, path);
int last = TclList.getLength(interp, splitResult) - 1;
if (last >= 0)
{
if ((last > 0) || (FileUtil.getPathType(path) == FileUtil.PATH_RELATIVE))
{
TclObject tailObj = TclList.index(interp, splitResult, last);
return(tailObj.ToString());
}
}
return("");
}
private static void setDoubleFromAny(Interp interp, TclObject tobj)
{
InternalRep rep = tobj.InternalRep;
if (rep is TclDouble)
{
/*
* Do nothing.
*/
}
else if (rep is TclBoolean)
{
/*
* Short-cut.
*/
bool b = TclBoolean.get(interp, tobj);
if (b)
{
tobj.InternalRep = new TclDouble(1.0);
}
else
{
tobj.InternalRep = new TclDouble(0.0);
}
}
else if (rep is TclInteger)
{
/*
* Short-cut.
*/
int i = TclInteger.get(interp, tobj);
tobj.InternalRep = new TclDouble(i);
}
else
{
tobj.InternalRep = new TclDouble(interp, tobj.ToString());
}
}
public static Regexp compile(Interp interp, TclObject exp, bool nocase)
{
try
{
return new Regexp(exp.ToString(), nocase);
}
catch (System.ArgumentException e)
{
string msg = e.Message;
if (msg.Equals("missing )"))
{
msg = "unmatched ()";
}
else if (msg.Equals("missing ]"))
{
msg = "unmatched []";
}
msg = "couldn't compile regular expression pattern: " + msg;
throw new TclException(interp, msg);
}
}
/// <summary> Called to convert the other object's internal rep to boolean.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the TclObject to convert to use the
/// representation provided by this class.
/// </param>
private static void setBooleanFromAny(Interp interp, TclObject tobj)
{
InternalRep rep = tobj.InternalRep;
if (rep is TclBoolean)
{
/*
* Do nothing.
*/
}
else if (rep is TclInteger)
{
int i = TclInteger.get(interp, tobj);
tobj.InternalRep = new TclBoolean(i != 0);
}
else
{
/*
* (ToDo) other short-cuts
*/
tobj.InternalRep = new TclBoolean(interp, tobj.ToString());
}
}
/// <summary> Tcl_GetIndexFromObj -> get
///
/// Gets the index into the table of the object. Generate an error
/// it it doesn't occur. This also converts the object to an index
/// which should catch the lookup for speed improvement.
///
/// </summary>
/// <param name="interp">the interperter or null
/// </param>
/// <param name="tobj">the object to operate on.
/// @paran table the list of commands
/// @paran msg used as part of any error messages
/// @paran flags may be TCL.EXACT.
/// </param>
public static int get( Interp interp, TclObject tobj, string[] table, string msg, int flags )
{
InternalRep rep = tobj.InternalRep;
if ( rep is TclIndex )
{
if ( ( (TclIndex)rep ).table == table )
{
return ( (TclIndex)rep ).index;
}
}
string str = tobj.ToString();
int strLen = str.Length;
int tableLen = table.Length;
int index = -1;
int numAbbrev = 0;
{
if ( strLen > 0 )
{
for ( int i = 0; i < tableLen; i++ )
{
string option = table[i];
if ( ( ( flags & TCL.EXACT ) == TCL.EXACT ) && ( option.Length != strLen ) )
{
continue;
}
if ( option.Equals( str ) )
{
// Found an exact match already. Return it.
index = i;
goto checking_brk;
}
if ( option.StartsWith( str ) )
{
numAbbrev++;
index = i;
}
}
}
if ( numAbbrev != 1 )
{
StringBuilder sbuf = new StringBuilder();
if ( numAbbrev > 1 )
{
sbuf.Append( "ambiguous " );
}
else
{
sbuf.Append( "bad " );
}
sbuf.Append( msg );
sbuf.Append( " \"" );
sbuf.Append( str );
sbuf.Append( "\"" );
sbuf.Append( ": must be " );
sbuf.Append( table[0] );
for ( int i = 1; i < tableLen; i++ )
{
if ( i == ( tableLen - 1 ) )
{
sbuf.Append( ( i > 1 ) ? ", or " : " or " );
}
else
{
sbuf.Append( ", " );
}
sbuf.Append( table[i] );
}
throw new TclException( interp, sbuf.ToString() );
}
}
checking_brk:
;
// Create a new index object.
tobj.InternalRep = new TclIndex( index, table );
return index;
}
/// <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)
{
InternalRep rep = tobj.InternalRep;
if (!(rep is TclByteArray))
{
char[] c = tobj.ToString().ToCharArray();
tobj.InternalRep = new TclByteArray(c);
}
}
private static void setDoubleFromAny(Interp interp, TclObject tobj)
{
InternalRep rep = tobj.InternalRep;
if (rep is TclDouble)
{
/*
* Do nothing.
*/
}
else if (rep is TclBoolean)
{
/*
* Short-cut.
*/
bool b = TclBoolean.get(interp, tobj);
if (b)
{
tobj.InternalRep = new TclDouble(1.0);
}
else
{
tobj.InternalRep = new TclDouble(0.0);
}
}
else if (rep is TclInteger)
{
/*
* Short-cut.
*/
int i = TclInteger.get(interp, tobj);
tobj.InternalRep = new TclDouble(i);
}
else
{
tobj.InternalRep = new TclDouble(interp, tobj.ToString());
}
}
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;
}
/// <summary> Appends a TclObject to a TclObject. This method is equivalent to
/// Tcl_AppendToObj() in Tcl 8.0.
///
/// The type of the TclObject will be a TclString that contains the
/// string value:
/// tobj.toString() + tobj2.toString();
/// </summary>
internal static void append(TclObject tobj, TclObject tobj2)
{
append(tobj, tobj2.ToString());
}
internal static void delete( Interp interp, Interp slaveInterp, TclObject name )
{
// If the alias has been renamed in the slave, the master can still use
// the original name (with which it was created) to find the alias to
// delete it.
string inString = name.ToString();
if ( !slaveInterp.aliasTable.ContainsKey( inString ) )
{
throw new TclException( interp, "alias \"" + inString + "\" not found" );
}
InterpAliasCmd alias = (InterpAliasCmd)slaveInterp.aliasTable[inString];
slaveInterp.deleteCommandFromToken( alias.slaveCmd );
}
/// <summary> Untrace a variable whose name is stored in a Tcl object.
///
/// </summary>
/// <param name="nameObj">name of the variable.
/// </param>
/// <param name="trace">the trace to delete.
/// </param>
/// <param name="flags">misc flags that control the actions of this method.
/// </param>
internal static void untraceVar( Interp interp, TclObject nameObj, TCL.VarFlag flags, VarTrace proc )
{
untraceVar( interp, nameObj.ToString(), null, flags, proc );
}
/// <summary> Unset a variable whose name is stored in a Tcl object.
///
/// </summary>
/// <param name="nameObj">name of the variable.
/// </param>
/// <param name="flags">misc flags that control the actions of this method.
/// </param>
internal static void unsetVar( Interp interp, TclObject nameObj, TCL.VarFlag flags )
{
unsetVar( interp, nameObj.ToString(), null, flags );
}
/// <summary> TCL.Tcl_SetVar2Ex -> setVar
///
/// Given a two-part variable name, which may refer either to a scalar
/// variable or an element of an array, change the value of the variable
/// to a new Tcl object value. If the named scalar or array or element
/// doesn't exist then create one.
///
/// </summary>
/// <param name="interp">the interp that holds the variable
/// </param>
/// <param name="part1">1st part of the variable name.
/// </param>
/// <param name="part2">2nd part of the variable name.
/// </param>
/// <param name="newValue">the new value for the variable
/// </param>
/// <param name="flags">misc flags that control the actions of this method
///
/// Returns a pointer to the TclObject holding the new value of the
/// variable. If the write operation was disallowed because an array was
/// expected but not found (or vice versa), then null is returned; if
/// the TCL.VarFlag.LEAVE_ERR_MSG flag is set, then an exception will be raised.
/// Note that the returned object may not be the same one referenced
/// by newValue because variable traces may modify the variable's value.
/// The value of the given variable is set. If either the array or the
/// entry didn't exist then a new variable is created.
///
/// The reference count is decremented for any old value of the variable
/// and incremented for its new value. If the new value for the variable
/// is not the same one referenced by newValue (perhaps as a result
/// of a variable trace), then newValue's ref count is left unchanged
/// by TCL.Tcl_SetVar2Ex. newValue's ref count is also left unchanged if
/// we are appending it as a string value: that is, if "flags" includes
/// TCL.VarFlag.APPEND_VALUE but not TCL.VarFlag.LIST_ELEMENT.
///
/// The reference count for the returned object is _not_ incremented: if
/// you want to keep a reference to the object you must increment its
/// ref count yourself.
/// </param>
internal static TclObject setVar( Interp interp, string part1, string part2, TclObject newValue, TCL.VarFlag flags )
{
Var var;
Var array;
TclObject oldValue;
string bytes;
Var[] result = lookupVar( interp, part1, part2, flags, "set", true, true );
if ( result == null )
{
return null;
}
var = result[0];
array = result[1];
// If the variable is in a hashtable and its table field is null, then we
// may have an upvar to an array element where the array was deleted
// or an upvar to a namespace variable whose namespace was deleted.
// Generate an error (allowing the variable to be reset would screw up
// our storage allocation and is meaningless anyway).
if ( ( ( var.flags & VarFlags.IN_HASHTABLE ) != 0 ) && ( var.table == null ) )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
if ( var.isVarArrayElement() )
{
throw new TclVarException( interp, part1, part2, "set", danglingElement );
}
else
{
throw new TclVarException( interp, part1, part2, "set", danglingVar );
}
}
return null;
}
// It's an error to try to set an array variable itself.
if ( var.isVarArray() && !var.isVarUndefined() )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, "set", isArray );
}
return null;
}
// At this point, if we were appending, we used to call read traces: we
// treated append as a read-modify-write. However, it seemed unlikely to
// us that a real program would be interested in such reads being done
// during a set operation.
// Set the variable's new value. If appending, append the new value to
// the variable, either as a list element or as a string. Also, if
// appending, then if the variable's old value is unshared we can modify
// it directly, otherwise we must create a new copy to modify: this is
// "copy on write".
try
{
if ( var.isSQLITE3_Link() )
{
var.sqlite3_set( newValue );
return var.sqlite3_get();
}
else
{
oldValue = (TclObject)var.value;
if ( ( flags & TCL.VarFlag.APPEND_VALUE ) != 0 )
{
if ( var.isVarUndefined() && ( oldValue != null ) )
{
oldValue.release(); // discard old value
var.value = null;
oldValue = null;
}
if ( ( flags & TCL.VarFlag.LIST_ELEMENT ) != 0 )
{
// append list element
if ( oldValue == null )
{
oldValue = TclList.newInstance();
var.value = oldValue;
oldValue.preserve(); // since var is referenced
}
else if ( oldValue.Shared )
{
// append to copy
var.value = oldValue.duplicate();
oldValue.release();
oldValue = (TclObject)var.value;
oldValue.preserve(); // since var is referenced
}
TclList.append( interp, oldValue, newValue );
}
else
{
// append string
// We append newValuePtr's bytes but don't change its ref count.
bytes = newValue.ToString();
if ( oldValue == null )
{
var.value = TclString.newInstance( bytes );
( (TclObject)var.value ).preserve();
}
else
{
if ( oldValue.Shared )
{
// append to copy
var.value = oldValue.duplicate();
oldValue.release();
oldValue = (TclObject)var.value;
oldValue.preserve(); // since var is referenced
}
TclString.append( oldValue, newValue );
}
}
}
else
{
if ( ( flags & TCL.VarFlag.LIST_ELEMENT ) != 0 )
{
// set var to list element
int listFlags;
// We set the variable to the result of converting newValue's
// string rep to a list element. We do not change newValue's
// ref count.
if ( oldValue != null )
{
oldValue.release(); // discard old value
}
bytes = newValue.ToString();
listFlags = Util.scanElement( interp, bytes );
oldValue = TclString.newInstance( Util.convertElement( bytes, listFlags ) );
var.value = oldValue;
( (TclObject)var.value ).preserve();
}
else if ( newValue != oldValue )
{
var.value = newValue.duplicate();
( (TclObject)var.value ).preserve(); // var is another ref
if ( oldValue != null )
{
oldValue.release(); // discard old value
}
}
}
var.setVarScalar();
var.clearVarUndefined();
if ( array != null )
{
array.clearVarUndefined();
}
// Invoke any write traces for the variable.
if ( ( var.traces != null ) || ( ( array != null ) && ( array.traces != null ) ) )
{
string msg = callTraces( interp, array, var, part1, part2, ( flags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ) ) | TCL.VarFlag.TRACE_WRITES );
if ( (System.Object)msg != null )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, "set", msg );
}
return null; // Same as "goto cleanup" in C verison
}
}
// Return the variable's value unless the variable was changed in some
// gross way by a trace (e.g. it was unset and then recreated as an
// array).
if ( var.isVarScalar() && !var.isVarUndefined() )
{
return (TclObject)var.value;
}
// A trace changed the value in some gross way. Return an empty string
// object.
return TclString.newInstance( "" );
}
}
finally
{
// If the variable doesn't exist anymore and no-one's using it,
// then free up the relevant structures and hash table entries.
if ( var.isVarUndefined() )
{
cleanupVar( var, array );
}
}
}
/// <summary> Compares the order of two items in the array.
///
/// </summary>
/// <param name="obj1">first item.
/// </param>
/// <param name="obj2">second item.
/// </param>
/// <returns> 0 if they are equal, 1 if obj1 > obj2, -1 otherwise.
///
/// </returns>
/// <exception cref=""> TclException if an error occurs during sorting.
/// </exception>
private int compare( TclObject obj1, TclObject obj2 )
{
int index;
int code = 0;
if ( sortIndex != -1 )
{
// The "-index" option was specified. Treat each object as a
// list, extract the requested element from each list, and
// compare the elements, not the lists. The special index "end"
// is signaled here with a negative index (other than -1).
TclObject obj;
if ( sortIndex < -1 )
{
index = TclList.getLength( sortInterp, obj1 ) - 1;
}
else
{
index = sortIndex;
}
obj = TclList.index( sortInterp, obj1, index );
if ( obj == null )
{
throw new TclException( sortInterp, "element " + index + " missing from sublist \"" + obj1 + "\"" );
}
obj1 = obj;
if ( sortIndex < -1 )
{
index = TclList.getLength( sortInterp, obj2 ) - 1;
}
else
{
index = sortIndex;
}
obj = TclList.index( sortInterp, obj2, index );
if ( obj == null )
{
throw new TclException( sortInterp, "element " + index + " missing from sublist \"" + obj2 + "\"" );
}
obj2 = obj;
}
switch ( sortMode )
{
case ASCII:
// ATK C# CompareTo use option
// similar to -dictionary but a > A
code = System.Globalization.CultureInfo.InvariantCulture.CompareInfo.Compare( obj1.ToString(), obj2.ToString(), System.Globalization.CompareOptions.Ordinal );
// code = obj1.ToString().CompareTo(obj2.ToString());
break;
case DICTIONARY:
code = doDictionary( obj1.ToString(), obj2.ToString() );
break;
case INTEGER:
try
{
int int1 = TclInteger.get( sortInterp, obj1 );
int int2 = TclInteger.get( sortInterp, obj2 );
if ( int1 > int2 )
{
code = 1;
}
else if ( int2 > int1 )
{
code = -1;
}
}
catch ( TclException e1 )
{
sortInterp.addErrorInfo( "\n (converting list element from string to integer)" );
throw e1;
}
break;
case REAL:
try
{
double f1 = TclDouble.get( sortInterp, obj1 );
double f2 = TclDouble.get( sortInterp, obj2 );
if ( f1 > f2 )
{
code = 1;
}
else if ( f2 > f1 )
{
code = -1;
}
}
catch ( TclException e2 )
{
sortInterp.addErrorInfo( "\n (converting list element from string to real)" );
throw e2;
}
break;
case COMMAND:
StringBuilder sbuf = new StringBuilder( sortCommand );
Util.appendElement( sortInterp, sbuf, obj1.ToString() );
Util.appendElement( sortInterp, sbuf, obj2.ToString() );
try
{
sortInterp.eval( sbuf.ToString(), 0 );
}
catch ( TclException e3 )
{
sortInterp.addErrorInfo( "\n (user-defined comparison command)" );
throw e3;
}
try
{
code = TclInteger.get( sortInterp, sortInterp.getResult() );
}
catch ( TclException e )
{
sortInterp.resetResult();
TclException e4 = new TclException( sortInterp, "comparison command returned non-numeric result" );
throw e4;
}
break;
default:
throw new TclRuntimeError( "Unknown sortMode " + sortMode );
}
if ( sortIncreasing )
{
return code;
}
else
{
return -code;
}
}
/// <summary> Write to stdout or stderr. If the stdType is not set to
/// STDOUT or STDERR this is an error; either the stdType wasnt
/// correctly initialized, or this was called on a STDIN channel.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="s">the string to write
/// </param>
public override void write(Interp interp, TclObject outData)
{
checkWrite(interp);
if (stdType == STDERR)
{
System.Console.Error.Write(outData.ToString());
}
else
{
string s = outData.ToString();
System.Console.Out.Write(s);
if (buffering == TclIO.BUFF_NONE || (buffering == TclIO.BUFF_LINE && s.EndsWith("\n")))
{
System.Console.Out.Flush();
}
}
}
public TCL.CompletionCode cmdProc(Interp interp, TclObject[] argv)
{
int i;
Notifier notifier = (Notifier)interp.getNotifier();
Object info;
if (assocData == null)
{
/*
* Create the "after" information associated for this
* interpreter, if it doesn't already exist.
*/
assocData = (AfterAssocData)interp.getAssocData("tclAfter");
if (assocData == null)
{
assocData = new AfterAssocData(this);
interp.setAssocData("tclAfter", assocData);
}
}
if (argv.Length < 2)
{
throw new TclNumArgsException(interp, 1, argv, "option ?arg arg ...?");
}
/*
* First lets see if the command was passed a number as the first argument.
*/
bool isNumber = false;
int ms = 0;
if (argv[1].InternalRep is TclInteger)
{
ms = TclInteger.get(interp, argv[1]);
isNumber = true;
}
else
{
string s = argv[1].ToString();
if ((s.Length > 0) && (System.Char.IsDigit(s[0])))
{
ms = TclInteger.get(interp, argv[1]);
isNumber = true;
}
}
if (isNumber)
{
if (ms < 0)
{
ms = 0;
}
if (argv.Length == 2)
{
/*
* Sleep for at least the given milliseconds and return.
*/
long endTime = System.DateTime.Now.Ticks / 10000 + ms;
while (true)
{
try
{
System.Threading.Thread.Sleep(ms);
return(TCL.CompletionCode.RETURN);
}
catch (System.Threading.ThreadInterruptedException e)
{
/*
* We got interrupted. Sleep again if we havn't slept
* long enough yet.
*/
long sysTime = System.DateTime.Now.Ticks / 10000;
if (sysTime >= endTime)
{
return(TCL.CompletionCode.RETURN);
}
ms = (int)(endTime - sysTime);
continue;
}
}
}
TclObject cmd = getCmdObject(argv);
cmd.preserve();
assocData.lastAfterId++;
TimerInfo timerInfo = new TimerInfo(this, notifier, ms);
timerInfo.interp = interp;
timerInfo.command = cmd;
timerInfo.id = assocData.lastAfterId;
assocData.handlers.Add(timerInfo);
interp.setResult("after#" + timerInfo.id);
return(TCL.CompletionCode.RETURN);
}
/*
* If it's not a number it must be a subcommand.
*/
int index;
try
{
index = TclIndex.get(interp, argv[1], validOpts, "option", 0);
}
catch (TclException e)
{
throw new TclException(interp, "bad argument \"" + argv[1] + "\": must be cancel, idle, info, or a number");
}
switch (index)
{
case OPT_CANCEL:
if (argv.Length < 3)
{
throw new TclNumArgsException(interp, 2, argv, "id|command");
}
TclObject arg = getCmdObject(argv);
arg.preserve();
/*
* Search the timer/idle handler by id or by command.
*/
info = null;
for (i = 0; i < assocData.handlers.Count; i++)
{
Object obj = assocData.handlers[i];
if (obj is TimerInfo)
{
TclObject cmd = ((TimerInfo)obj).command;
if ((cmd == arg) || cmd.ToString().Equals(arg.ToString()))
{
info = obj;
break;
}
}
else
{
TclObject cmd = ((IdleInfo)obj).command;
if ((cmd == arg) || cmd.ToString().Equals(arg.ToString()))
{
info = obj;
break;
}
}
}
if (info == null)
{
info = getAfterEvent(arg.ToString());
}
arg.release();
/*
* Cancel the handler.
*/
if (info != null)
{
if (info is TimerInfo)
{
((TimerInfo)info).cancel();
((TimerInfo)info).command.release();
}
else
{
((IdleInfo)info).cancel();
((IdleInfo)info).command.release();
}
SupportClass.VectorRemoveElement(assocData.handlers, info);
}
break;
case OPT_IDLE:
if (argv.Length < 3)
{
throw new TclNumArgsException(interp, 2, argv, "script script ...");
}
TclObject cmd2 = getCmdObject(argv);
cmd2.preserve();
assocData.lastAfterId++;
IdleInfo idleInfo = new IdleInfo(this, notifier);
idleInfo.interp = interp;
idleInfo.command = cmd2;
idleInfo.id = assocData.lastAfterId;
assocData.handlers.Add(idleInfo);
interp.setResult("after#" + idleInfo.id);
break;
case OPT_INFO:
if (argv.Length == 2)
{
/*
* No id is given. Return a list of current after id's.
*/
TclObject list = TclList.newInstance();
for (i = 0; i < assocData.handlers.Count; i++)
{
int id;
Object obj = assocData.handlers[i];
if (obj is TimerInfo)
{
id = ((TimerInfo)obj).id;
}
else
{
id = ((IdleInfo)obj).id;
}
TclList.append(interp, list, TclString.newInstance("after#" + id));
}
interp.resetResult();
interp.setResult(list);
return(TCL.CompletionCode.RETURN);
}
if (argv.Length != 3)
{
throw new TclNumArgsException(interp, 2, argv, "?id?");
}
/*
* Return command and type of the given after id.
*/
info = getAfterEvent(argv[2].ToString());
if (info == null)
{
throw new TclException(interp, "event \"" + argv[2] + "\" doesn't exist");
}
TclObject list2 = TclList.newInstance();
TclList.append(interp, list2, ((info is TimerInfo)?((TimerInfo)info).command:((IdleInfo)info).command));
TclList.append(interp, list2, TclString.newInstance((info is TimerInfo)?"timer":"idle"));
interp.resetResult();
interp.setResult(list2);
break;
}
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);
}
public void eval( TclObject tobj, int flags )
{
eval( tobj.ToString(), flags );
}
internal static bool objCommandComplete( TclObject obj )
// Points to object holding script
// to check.
{
string inString = obj.ToString();
return commandComplete( inString, inString.Length );
}
internal static Interp create( Interp interp, TclObject path, bool safe )
{
Interp masterInterp;
string pathString;
TclObject[] objv = TclList.getElements( interp, path );
if ( objv.Length < 2 )
{
masterInterp = interp;
pathString = path.ToString();
}
else
{
TclObject obj = TclList.newInstance();
TclList.insert( interp, obj, 0, objv, 0, objv.Length - 2 );
masterInterp = InterpCmd.getInterp( interp, obj );
pathString = objv[objv.Length - 1].ToString();
}
if ( !safe )
{
safe = masterInterp.isSafe;
}
if ( masterInterp.slaveTable.ContainsKey( pathString ) )
{
throw new TclException( interp, "interpreter named \"" + pathString + "\" already exists, cannot create" );
}
Interp slaveInterp = new Interp();
InterpSlaveCmd slave = new InterpSlaveCmd();
slaveInterp.slave = slave;
slaveInterp.setAssocData( "InterpSlaveCmd", slave );
slave.masterInterp = masterInterp;
slave.path = pathString;
slave.slaveInterp = slaveInterp;
masterInterp.createCommand( pathString, slaveInterp.slave );
slaveInterp.slave.interpCmd = NamespaceCmd.findCommand( masterInterp, pathString, null, 0 );
SupportClass.PutElement( masterInterp.slaveTable, pathString, slaveInterp.slave );
slaveInterp.setVar( "tcl_interactive", "0", TCL.VarFlag.GLOBAL_ONLY );
// Inherit the recursion limit.
slaveInterp.maxNestingDepth = masterInterp.maxNestingDepth;
if ( safe )
{
try
{
makeSafe( slaveInterp );
}
catch ( TclException e )
{
SupportClass.WriteStackTrace( e, Console.Error );
}
}
else
{
//Tcl_Init(slaveInterp);
}
return slaveInterp;
}
/*
*----------------------------------------------------------------------
*
* SetNsNameFromAny -> setNsNameFromAny
*
* Attempt to generate a nsName internal representation for a
* TclObject.
*
* Results:
* Returns if the value could be converted to a proper
* namespace reference. Otherwise, raises TclException.
*
* Side effects:
* If successful, the object is made a nsName object. Its internal rep
* is set to point to a ResolvedNsName, which contains a cached pointer
* to the Namespace. Reference counts are kept on both the
* ResolvedNsName and the Namespace, so we can keep track of their
* usage and free them when appropriate.
*
*----------------------------------------------------------------------
*/
private static void setNsNameFromAny(Interp interp, TclObject tobj)
{
string name;
Namespace ns;
ResolvedNsName resName;
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
Namespace[] nsArr = new Namespace[1];
Namespace[] dummy1Arr = new Namespace[1];
string[] dummy2Arr = new string[1];
// Get the string representation.
name = tobj.ToString();
// Look for the namespace "name" in the current namespace. If there is
// an error parsing the (possibly qualified) name, return an error.
// If the namespace isn't found, we convert the object to an nsName
// object with a null ResolvedNsName internal rep.
getNamespaceForQualName(interp, name, null, TCL.VarFlag.FIND_ONLY_NS, nsArr, dummy1Arr, dummy1Arr, dummy2Arr);
// Get the values out of the arrays!
ns = nsArr[0];
// If we found a namespace, then create a new ResolvedNsName structure
// that holds a reference to it.
if (ns != null)
{
Namespace currNs = getCurrentNamespace(interp);
ns.refCount++;
resName = new ResolvedNsName();
resName.ns = ns;
resName.nsId = ns.nsId;
resName.refNs = currNs;
resName.refCount = 1;
}
else
{
resName = null;
}
// By setting the new internal rep we free up the old one.
// FIXME : should a NamespaceCmd wrap a ResolvedNsName?
// this is confusing because it seems like the C code uses
// a ResolvedNsName like it is the InternalRep.
NamespaceCmd wrap = new NamespaceCmd();
wrap.otherValue = resName;
tobj.InternalRep = wrap;
return ;
}
/// <summary> Called to convert the other object's internal rep to list.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the TclObject to convert to use the List internal rep.
/// </param>
/// <exception cref=""> TclException if the object doesn't contain a valid list.
/// </exception>
internal static void setListFromAny( Interp interp, TclObject tobj )
{
InternalRep rep = tobj.InternalRep;
if ( !( rep is TclList ) )
{
TclList tlist = new TclList();
splitList( interp, tlist.vector, tobj.ToString() );
tobj.InternalRep = tlist;
}
}
/// <summary> Called to convert the other object's internal rep to boolean.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the TclObject to convert to use the
/// representation provided by this class.
/// </param>
private static void setBooleanFromAny( Interp interp, TclObject tobj )
{
InternalRep rep = tobj.InternalRep;
if ( rep is TclBoolean )
{
/*
* Do nothing.
*/
}
else if ( rep is TclInteger )
{
int i = TclInteger.get( interp, tobj );
tobj.InternalRep = new TclBoolean( i != 0 );
}
else
{
/*
* (ToDo) other short-cuts
*/
tobj.InternalRep = new TclBoolean( interp, tobj.ToString() );
}
}
/// <summary> This procedure is invoked to process the "open" 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 pipeline = false; /* True if opening pipeline chan */
int prot = 438; /* Final rdwr permissions of file */
int modeFlags = TclIO.RDONLY; /* Rdwr mode for the file. See the
* TclIO class for more info on the
* valid modes */
if ((argv.Length < 2) || (argv.Length > 4))
{
throw new TclNumArgsException(interp, 1, argv, "fileName ?access? ?permissions?");
}
if (argv.Length > 2)
{
TclObject mode = argv[2];
string modeStr = mode.ToString();
int len = modeStr.Length;
// This "r+1" hack is just to get a test case to pass
if ((len == 0) || (modeStr.StartsWith("r+") && len >= 3))
{
throw new TclException(interp, "illegal access mode \"" + modeStr + "\"");
}
if (len < 3)
{
switch (modeStr[0])
{
case 'r': {
if (len == 1)
{
modeFlags = TclIO.RDONLY;
break;
}
else if (modeStr[1] == '+')
{
modeFlags = TclIO.RDWR;
break;
}
}
goto case 'w';
case 'w': {
FileInfo f = FileUtil.getNewFileObj(interp, argv[1].ToString());
bool tmpBool;
if (File.Exists(f.FullName))
{
tmpBool = true;
}
else
{
tmpBool = Directory.Exists(f.FullName);
}
if (tmpBool)
{
bool tmpBool2;
try {
if (File.Exists(f.FullName))
{
File.SetAttributes(f.FullName, FileAttributes.Normal);
File.Delete(f.FullName);
tmpBool2 = true;
}
else if (Directory.Exists(f.FullName))
{
Directory.Delete(f.FullName);
tmpBool2 = true;
}
else
{
tmpBool2 = false;
}
}
// ATK added because .NET do not allow often to delete
// files used by another process
catch (System.IO.IOException e)
{
throw new TclException(interp, "cannot open file: " + argv[1].ToString());
}
bool generatedAux = tmpBool2;
}
if (len == 1)
{
modeFlags = (TclIO.WRONLY | TclIO.CREAT);
break;
}
else if (modeStr[1] == '+')
{
modeFlags = (TclIO.RDWR | TclIO.CREAT);
break;
}
}
goto case 'a';
case 'a': {
if (len == 1)
{
modeFlags = (TclIO.WRONLY | TclIO.APPEND);
break;
}
else if (modeStr[1] == '+')
{
modeFlags = (TclIO.RDWR | TclIO.CREAT | TclIO.APPEND);
break;
}
}
goto default;
default: {
throw new TclException(interp, "illegal access mode \"" + modeStr + "\"");
}
}
}
else
{
modeFlags = 0;
bool gotRorWflag = false;
int mlen = TclList.getLength(interp, mode);
for (int i = 0; i < mlen; i++)
{
TclObject marg = TclList.index(interp, mode, i);
if (marg.ToString().Equals("RDONLY"))
{
modeFlags |= TclIO.RDONLY;
gotRorWflag = true;
}
else
{
if (marg.ToString().Equals("WRONLY"))
{
modeFlags |= TclIO.WRONLY;
gotRorWflag = true;
}
else
{
if (marg.ToString().Equals("RDWR"))
{
modeFlags |= TclIO.RDWR;
gotRorWflag = true;
}
else
{
if (marg.ToString().Equals("APPEND"))
{
modeFlags |= TclIO.APPEND;
}
else
{
if (marg.ToString().Equals("CREAT"))
{
modeFlags |= TclIO.CREAT;
}
else
{
if (marg.ToString().Equals("EXCL"))
{
modeFlags |= TclIO.EXCL;
}
else
{
if (marg.ToString().Equals("TRUNC"))
{
modeFlags |= TclIO.TRUNC;
}
else
{
throw new TclException(interp, "invalid access mode \"" + marg.ToString() + "\": must be RDONLY, WRONLY, RDWR, APPEND, " + "CREAT EXCL, NOCTTY, NONBLOCK, or TRUNC");
}
}
}
}
}
}
}
}
if (!gotRorWflag)
{
throw new TclException(interp, "access mode must include either RDONLY, WRONLY, or RDWR");
}
}
}
if (argv.Length == 4)
{
prot = TclInteger.get(interp, argv[3]);
throw new TclException(interp, "setting permissions not implemented yet");
}
if ((argv[1].ToString().Length > 0) && (argv[1].ToString()[0] == '|'))
{
pipeline = true;
throw new TclException(interp, "pipes not implemented yet");
}
/*
* Open the file or create a process pipeline.
*/
if (!pipeline)
{
try
{
FileChannel file = new FileChannel();
file.open(interp, argv[1].ToString(), modeFlags);
TclIO.registerChannel(interp, file);
interp.setResult(file.ChanName);
}
catch (System.IO.IOException e)
{
throw new TclException(interp, "cannot open file: " + argv[1].ToString());
}
}
else
{
/*
* Pipeline code here...
*/
}
return(TCL.CompletionCode.RETURN);
}
/// <summary> Appends an array of characters to a TclObject Object.
/// Tcl_AppendUnicodeToObj() in Tcl 8.0.
///
/// </summary>
/// <param name="tobj">the TclObject to append a string to.
/// </param>
/// <param name="charArr">array of characters.
/// </param>
/// <param name="offset">index of first character to append.
/// </param>
/// <param name="length">number of characters to append.
/// </param>
public static void append(TclObject tobj, char[] charArr, int offset, int length)
{
StringFromAny = tobj;
TclString tstr = (TclString) tobj.InternalRep;
if (tstr.sbuf == null)
{
tstr.sbuf = new System.Text.StringBuilder(tobj.ToString());
}
tobj.invalidateStringRep();
tstr.sbuf.Append(charArr, offset, length);
}
/// <summary> Tcl_WriteObj -> writeObj
///
/// Takes the Tcl object and queues its contents for output. If the
/// encoding of the channel is NULL, takes the byte-array representation
/// of the object and queues those bytes for output. Otherwise, takes
/// the characters in the UTF-8 (string) representation of the object
/// and converts them for output using the channel's current encoding.
/// May flush internal buffers to output if one becomes full or is ready
/// for some other reason, e.g. if it contains a newline and the channel
/// is in line buffering mode.
///
/// The number of bytes written or -1 in case of error. If -1,
/// Tcl_GetErrno will return the error code.
///
/// May buffer up output and may cause output to be produced on the
/// channel.
///
/// </summary>
/// <param name="obj"> The object to write.
/// </param>
internal int writeObj( TclObject obj )
{
// Always use the topmost channel of the stack
//char *src;
int srcLen;
//statePtr = ((Channel *) chan)->state;
//chanPtr = statePtr->topChanPtr;
//if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
// return -1;
//}
if ( (System.Object)encoding == null )
{
srcLen = TclByteArray.getLength( null, obj );
byte[] bytes = TclByteArray.getBytes( null, obj );
return writeBytes( bytes, 0, srcLen );
}
else
{
char[] chars = obj.ToString().ToCharArray();
return writeChars( chars, 0, chars.Length );
}
}
public static string Tcl_GetString(TclObject to)
{
return(to.ToString());
}
/// <summary> SetlongFromAny -> TclLong.setlongFromAny
///
/// Called to convert the other object's longernal 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 setlongFromAny( Interp interp, TclObject tobj )
{
InternalRep rep = tobj.InternalRep;
if ( rep is TclLong )
{
// Do nothing.
}
else if ( rep is TclBoolean )
{
bool b = TclBoolean.get( interp, tobj );
if ( b )
{
tobj.InternalRep = new TclLong( 1 );
}
else
{
tobj.InternalRep = new TclLong( 0 );
}
}
else
{
// (ToDo) other short-cuts
tobj.InternalRep = new TclLong( interp, tobj.ToString() );
}
}
public static string Tcl_GetStringFromObj(TclObject to, int n)
{
Debug.Assert(n == 0, "Try calling by ref");
return(to.ToString());
}
internal static void create( Interp interp, Interp slaveInterp, Interp masterInterp, TclObject name, TclObject targetName, int objIx, TclObject[] objv )
{
string inString = name.ToString();
InterpAliasCmd alias = new InterpAliasCmd();
alias.name = name;
name.preserve();
alias.slaveInterp = slaveInterp;
alias.targetInterp = masterInterp;
alias.prefix = TclList.newInstance();
alias.prefix.preserve();
TclList.append( interp, alias.prefix, targetName );
TclList.insert( interp, alias.prefix, 1, objv, objIx, objv.Length - 1 );
slaveInterp.createCommand( inString, alias );
alias.slaveCmd = NamespaceCmd.findCommand( slaveInterp, inString, null, 0 );
try
{
interp.preventAliasLoop( slaveInterp, alias.slaveCmd );
}
catch ( TclException e )
{
// Found an alias loop! The last call to Tcl_CreateObjCommand made
// the alias point to itself. Delete the command and its alias
// record. Be careful to wipe out its client data first, so the
// command doesn't try to delete itself.
slaveInterp.deleteCommandFromToken( alias.slaveCmd );
throw;
}
// Make an entry in the alias table. If it already exists delete
// the alias command. Then retry.
if ( slaveInterp.aliasTable.ContainsKey( inString ) )
{
InterpAliasCmd oldAlias = (InterpAliasCmd)slaveInterp.aliasTable[inString];
slaveInterp.deleteCommandFromToken( oldAlias.slaveCmd );
}
alias.aliasEntry = inString;
SupportClass.PutElement( slaveInterp.aliasTable, inString, alias );
// Create the new command. We must do it after deleting any old command,
// because the alias may be pointing at a renamed alias, as in:
//
// interp alias {} foo {} bar # Create an alias "foo"
// rename foo zop # Now rename the alias
// interp alias {} foo {} zop # Now recreate "foo"...
SupportClass.PutElement( masterInterp.targetTable, alias.slaveCmd, slaveInterp );
interp.setResult( name );
}
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();
}
internal static void describe( Interp interp, Interp slaveInterp, TclObject name )
{
// If the alias has been renamed in the slave, the master can still use
// the original name (with which it was created) to find the alias to
// describe it.
string inString = name.ToString();
if ( slaveInterp.aliasTable.ContainsKey( inString ) )
{
InterpAliasCmd alias = (InterpAliasCmd)slaveInterp.aliasTable[inString];
interp.setResult( alias.prefix );
}
}
/// <summary> Query the value of a variable whose name is stored in a Tcl object.
///
/// </summary>
/// <param name="interp">the interp that holds the variable
/// </param>
/// <param name="nameObj">name of the variable.
/// </param>
/// <param name="flags">misc flags that control the actions of this method.
/// </param>
/// <returns> the value of the variable.
/// </returns>
internal static TclObject getVar( Interp interp, TclObject nameObj, TCL.VarFlag flags )
{
return getVar( interp, nameObj.ToString(), null, flags );
}
/// <summary> Tcl_ObjGetVar2 -> getVar
///
/// Query the value of a variable.
///
/// </summary>
/// <param name="interp">the interp that holds the variable
/// </param>
/// <param name="part1">1st part of the variable name.
/// </param>
/// <param name="part2">2nd part of the variable name.
/// </param>
/// <param name="flags">misc flags that control the actions of this method.
/// </param>
/// <returns> the value of the variable.
/// </returns>
internal static TclObject getVar( Interp interp, TclObject part1Obj, TclObject part2Obj, TCL.VarFlag flags )
{
string part1, part2;
part1 = part1Obj.ToString();
if ( part2Obj != null )
{
part2 = part2Obj.ToString();
}
else
{
part2 = null;
}
return getVar( interp, part1, part2, flags );
}
public static int Tcl_DStringLength(TclObject str)
{
return(str.ToString().Length);
}
internal static int getIntForIndex( Interp interp, TclObject tobj, int endValue )
{
int length, offset;
if ( tobj.InternalRep is TclInteger )
{
return TclInteger.get( interp, tobj );
}
string bytes = tobj.ToString();
length = bytes.Length;
string intforindex_error = "bad index \"" + bytes + "\": must be integer or end?-integer?" + checkBadOctal( interp, bytes );
// FIXME : should we replace this call to regionMatches with a generic strncmp?
if ( !( String.Compare( "end", 0, bytes, 0, ( length > 3 ) ? 3 : length ) == 0 ) )
{
try
{
offset = TclInteger.get( null, tobj );
}
catch ( TclException e )
{
throw new TclException( interp, "bad index \"" + bytes + "\": must be integer or end?-integer?" + checkBadOctal( interp, bytes ) );
}
return offset;
}
if ( length <= 3 )
{
return endValue;
}
else if ( bytes[3] == '-' )
{
// This is our limited string expression evaluator
offset = Util.getInt( interp, bytes.Substring( 3 ) );
return endValue + offset;
}
else
{
throw new TclException( interp, "bad index \"" + bytes + "\": must be integer or end?-integer?" + checkBadOctal( interp, bytes.Substring( 3 ) ) );
}
}
public static byte[] Tcl_GetByteArrayFromObj(TclObject to, ref int n)
{
return(Encoding.UTF8.GetBytes(to.ToString()));
}
internal void sqlite3_set( TclObject to )
{
if ( ( flags & VarFlags.SQLITE3_LINK_READ_ONLY ) == 0 )
{
if ( ( flags & VarFlags.SQLITE3_LINK_INT ) != 0 )
( (SQLITE3_GETSET)sqlite3_get_set ).iValue = Convert.ToInt32( to.ToString() );
else
if ( ( flags & VarFlags.SQLITE3_LINK_STRING ) != 0 )
( (SQLITE3_GETSET)sqlite3_get_set ).sValue = to.ToString();
else
( (SQLITE3_GETSET)sqlite3_get_set ).sValue = to.ToString();
}
}
/// <summary> Appends a string to a TclObject object. This method is equivalent to
/// Tcl_AppendToObj() in Tcl 8.0.
///
/// </summary>
/// <param name="tobj">the TclObject to append a string to.
/// </param>
/// <param name="string">the string to append to the object.
/// </param>
public static void append(TclObject tobj, string toAppend)
{
StringFromAny = tobj;
TclString tstr = (TclString) tobj.InternalRep;
if (tstr.sbuf == null)
{
tstr.sbuf = new System.Text.StringBuilder(tobj.ToString());
}
tobj.invalidateStringRep();
tstr.sbuf.Append( toAppend );
}
