wasCSharpSQLite

Subversion Repositories:
Compare Path: Rev
With Path: Rev
?path1? @ 1  →  ?path2? @ 4
/trunk/TCL/Properties/AssemblyInfo.cs
@@ -0,0 +1,33 @@
using System.Reflection;
using System.Runtime.CompilerServices;
using System.Runtime.InteropServices;
 
// General Information about an assembly is controlled through the following
// set of attributes. Change these attribute values to modify the information
// associated with an assembly.
[assembly: AssemblyTitle("csTCL")]
[assembly: AssemblyDescription("TCL running under C#")]
[assembly: AssemblyConfiguration("")]
[assembly: AssemblyCompany("Pioneer Software Consulting")]
[assembly: AssemblyProduct("tcl.Properties")]
[assembly: AssemblyCopyright("Copyright © 2009")]
[assembly: AssemblyTrademark("")]
[assembly: AssemblyCulture("")]
 
// Setting ComVisible to false makes the types in this assembly not visible
// to COM components. If you need to access a type in this assembly from
// COM, set the ComVisible attribute to true on that type.
[assembly: ComVisible(false)]
 
// The following GUID is for the ID of the typelib if this project is exposed to COM
[assembly: Guid("94139fff-ae42-4535-b2a0-6c74c1948f86")]
 
// Version information for an assembly consists of the following four values:
//
// Major Version
// Minor Version
// Build Number
// Revision
//
[assembly: AssemblyVersion("1.8")]
[assembly: AssemblyFileVersion("1.0.0.0")]
/trunk/TCL/src/SupportClass.cs
@@ -0,0 +1,1368 @@
//
// In order to convert some functionality to Visual C#, the Java Language Conversion Assistant
// creates "support classes" that duplicate the original functionality.
//
// Support classes replicate the functionality of the original code, but in some cases they are
// substantially different architecturally. Although every effort is made to preserve the
// original architecture of the application in the converted project, the user should be aware that
// the primary goal of these support classes is to replicate functionality, and that at times
// the architecture of the resulting solution may differ somewhat.
//
// Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
//$Header$
 
using System;
using System.Collections;
using System.Globalization;
using System.IO;
using System.Reflection;
using System.Threading;
 
/// <summary>
/// This interface should be implemented by any class whose instances are intended
/// to be executed by a thread.
/// </summary>
public interface IThreadRunnable
{
/// <summary>
/// This method has to be implemented in order that starting of the thread causes the object's
/// run method to be called in that separately executing thread.
/// </summary>
void Run();
}
 
/// <summary>
/// Contains conversion support elements such as classes, interfaces and static methods.
/// </summary>
public class SupportClass
{
/// <summary>
/// Support class used to handle threads
/// </summary>
public class ThreadClass : IThreadRunnable
{
/// <summary>
/// The instance of Thread
/// </summary>
private Thread threadField;
 
/// <summary>
/// Initializes a new instance of the ThreadClass class
/// </summary>
public ThreadClass()
{
threadField = new Thread( new ThreadStart( Run ) );
}
 
/// <summary>
/// Initializes a new instance of the Thread class.
/// </summary>
/// <param name="Name">The name of the thread</param>
public ThreadClass( string Name )
{
threadField = new Thread( new ThreadStart( Run ) );
this.Name = Name;
}
 
/// <summary>
/// Initializes a new instance of the Thread class.
/// </summary>
/// <param name="Start">A ThreadStart delegate that references the methods to be invoked when this thread begins executing</param>
public ThreadClass( ThreadStart Start )
{
threadField = new Thread( Start );
}
 
/// <summary>
/// Initializes a new instance of the Thread class.
/// </summary>
/// <param name="Start">A ThreadStart delegate that references the methods to be invoked when this thread begins executing</param>
/// <param name="Name">The name of the thread</param>
public ThreadClass( ThreadStart Start, string Name )
{
threadField = new Thread( Start );
this.Name = Name;
}
 
/// <summary>
/// This method has no functionality unless the method is overridden
/// </summary>
public virtual void Run()
{
}
 
/// <summary>
/// Causes the operating system to change the state of the current thread instance to ThreadState.Running
/// </summary>
public void Start()
{
threadField.Start();
}
 
/// <summary>
/// Interrupts a thread that is in the WaitSleepJoin thread state
/// </summary>
public void Interrupt()
{
threadField.Interrupt();
}
 
/// <summary>
/// Gets the current thread instance
/// </summary>
public Thread Instance
{
get
{
return threadField;
}
set
{
threadField = value;
}
}
 
/// <summary>
/// Gets or sets the name of the thread
/// </summary>
public string Name
{
get
{
return threadField.Name;
}
set
{
if ( threadField.Name == null )
threadField.Name = value;
}
}
 
/// <summary>
/// Gets or sets a value indicating the scheduling priority of a thread
/// </summary>
public ThreadPriority Priority
{
get
{
return threadField.Priority;
}
set
{
threadField.Priority = value;
}
}
 
/// <summary>
/// Gets a value indicating the execution status of the current thread
/// </summary>
public bool IsAlive
{
get
{
return threadField.IsAlive;
}
}
 
/// <summary>
/// Gets or sets a value indicating whether or not a thread is a background thread.
/// </summary>
public bool IsBackground
{
get
{
return threadField.IsBackground;
}
set
{
threadField.IsBackground = value;
}
}
 
/// <summary>
/// Blocks the calling thread until a thread terminates
/// </summary>
public void Join()
{
threadField.Join();
}
 
/// <summary>
/// Blocks the calling thread until a thread terminates or the specified time elapses
/// </summary>
/// <param name="MiliSeconds">Time of wait in milliseconds</param>
public void Join( long MiliSeconds )
{
lock ( this )
{
threadField.Join( new TimeSpan( MiliSeconds * 10000 ) );
}
}
 
/// <summary>
/// Blocks the calling thread until a thread terminates or the specified time elapses
/// </summary>
/// <param name="MiliSeconds">Time of wait in milliseconds</param>
/// <param name="NanoSeconds">Time of wait in nanoseconds</param>
public void Join( long MiliSeconds, int NanoSeconds )
{
lock ( this )
{
threadField.Join( new TimeSpan( MiliSeconds * 10000 + NanoSeconds * 100 ) );
}
}
 
/// <summary>
/// Resumes a thread that has been suspended
/// </summary>
public void Resume()
{
threadField.Resume();
}
 
/// <summary>
/// Raises a ThreadAbortException in the thread on which it is invoked,
/// to begin the process of terminating the thread. Calling this method
/// usually terminates the thread
/// </summary>
public void Abort()
{
threadField.Abort();
}
 
/// <summary>
/// Raises a ThreadAbortException in the thread on which it is invoked,
/// to begin the process of terminating the thread while also providing
/// exception information about the thread termination.
/// Calling this method usually terminates the thread.
/// </summary>
/// <param name="stateInfo">An object that contains application-specific information, such as state, which can be used by the thread being aborted</param>
public void Abort( Object stateInfo )
{
lock ( this )
{
threadField.Abort( stateInfo );
}
}
 
/// <summary>
/// Suspends the thread, if the thread is already suspended it has no effect
/// </summary>
public void Suspend()
{
threadField.Suspend();
}
 
/// <summary>
/// Obtain a String that represents the current Object
/// </summary>
/// <returns>A String that represents the current Object</returns>
public override string ToString()
{
return "Thread[" + Name + "," + Priority.ToString() + "," + "" + "]";
}
 
/// <summary>
/// Gets the currently running thread
/// </summary>
/// <returns>The currently running thread</returns>
public static ThreadClass Current()
{
ThreadClass CurrentThread = new ThreadClass();
CurrentThread.Instance = Thread.CurrentThread;
return CurrentThread;
}
}
 
 
/*******************************/
/// <summary>
/// Removes the first occurrence of an specific object from an ArrayList instance.
/// </summary>
/// <param name="arrayList">The ArrayList instance</param>
/// <param name="element">The element to remove</param>
/// <returns>True if item is found in the ArrayList; otherwise, false</returns>
public static Boolean VectorRemoveElement( ArrayList arrayList, Object element )
{
Boolean containsItem = arrayList.Contains( element );
arrayList.Remove( element );
return containsItem;
}
 
/*******************************/
/// <summary>
/// Converts an array of sbytes to an array of bytes
/// </summary>
/// <param name="sbyteArray">The array of sbytes to be converted</param>
/// <returns>The new array of bytes</returns>
public static byte[] ToByteArray( sbyte[] sbyteArray )
{
byte[] byteArray = new byte[sbyteArray.Length];
for ( int index = 0; index < sbyteArray.Length; index++ )
byteArray[index] = (byte)sbyteArray[index];
return byteArray;
}
 
/// <summary>
/// Converts a string to an array of bytes
/// </summary>
/// <param name="sourceString">The string to be converted</param>
/// <returns>The new array of bytes</returns>
public static byte[] ToByteArray( string sourceString )
{
byte[] byteArray = new byte[sourceString.Length];
for ( int index = 0; index < sourceString.Length; index++ )
byteArray[index] = (byte)sourceString[index];
return byteArray;
}
 
/// <summary>
/// Converts a array of object-type instances to a byte-type array.
/// </summary>
/// <param name="tempObjectArray">Array to convert.</param>
/// <returns>An array of byte type elements.</returns>
public static byte[] ToByteArray( object[] tempObjectArray )
{
byte[] byteArray = new byte[tempObjectArray.Length];
for ( int index = 0; index < tempObjectArray.Length; index++ )
byteArray[index] = (byte)tempObjectArray[index];
return byteArray;
}
 
 
/*******************************/
/// <summary>
/// This method returns the literal value received
/// </summary>
/// <param name="literal">The literal to return</param>
/// <returns>The received value</returns>
public static long Identity( long literal )
{
return literal;
}
 
/// <summary>
/// This method returns the literal value received
/// </summary>
/// <param name="literal">The literal to return</param>
/// <returns>The received value</returns>
public static ulong Identity( ulong literal )
{
return literal;
}
 
/// <summary>
/// This method returns the literal value received
/// </summary>
/// <param name="literal">The literal to return</param>
/// <returns>The received value</returns>
public static float Identity( float literal )
{
return literal;
}
 
/// <summary>
/// This method returns the literal value received
/// </summary>
/// <param name="literal">The literal to return</param>
/// <returns>The received value</returns>
public static double Identity( double literal )
{
return literal;
}
 
/*******************************/
/// <summary>
/// Copies an array of chars obtained from a String into a specified array of chars
/// </summary>
/// <param name="sourceString">The String to get the chars from</param>
/// <param name="sourceStart">Position of the String to start getting the chars</param>
/// <param name="sourceEnd">Position of the String to end getting the chars</param>
/// <param name="destinationArray">Array to return the chars</param>
/// <param name="destinationStart">Position of the destination array of chars to start storing the chars</param>
/// <returns>An array of chars</returns>
public static void GetCharsFromString( string sourceString, int sourceStart, int sourceEnd, ref char[] destinationArray, int destinationStart )
{
int sourceCounter;
int destinationCounter;
sourceCounter = sourceStart;
destinationCounter = destinationStart;
while ( sourceCounter < sourceEnd )
{
destinationArray[destinationCounter] = (char)sourceString[sourceCounter];
sourceCounter++;
destinationCounter++;
}
}
 
/*******************************/
/// <summary>
/// This class manages different issues for calendars.
/// The different calendars are internally managed using a hash table structure.
/// </summary>
public class CalendarManager
{
/// <summary>
/// Field number for get and set indicating the year.
/// </summary>
public const int YEAR = 0;
 
/// <summary>
/// Field number for get and set indicating the month.
/// </summary>
public const int MONTH = 1;
 
/// <summary>
/// Field number for get and set indicating the day of the month.
/// </summary>
public const int DATE = 2;
 
/// <summary>
/// Field number for get and set indicating the hour of the morning or afternoon.
/// </summary>
public const int HOUR = 3;
 
/// <summary>
/// Field number for get and set indicating the minute within the hour.
/// </summary>
public const int MINUTE = 4;
 
/// <summary>
/// Field number for get and set indicating the second within the minute.
/// </summary>
public const int SECOND = 5;
 
/// <summary>
/// Field number for get and set indicating the millisecond within the second.
/// </summary>
public const int MILLISECOND = 6;
 
/// <summary>
/// Field number for get and set indicating the day of the month.
/// </summary>
public const int DAY_OF_MONTH = 7;
 
/// <summary>
/// Field used to get or set the day of the week.
/// </summary>
public const int DAY_OF_WEEK = 8;
 
/// <summary>
/// Field number for get and set indicating the hour of the day.
/// </summary>
public const int HOUR_OF_DAY = 9;
 
/// <summary>
/// Field number for get and set indicating whether the HOUR is before or after noon.
/// </summary>
public const int AM_PM = 10;
 
/// <summary>
/// Value of the AM_PM field indicating the period of the day from midnight to just
/// before noon.
/// </summary>
public const int AM = 11;
 
/// <summary>
/// Value of the AM_PM field indicating the period of the day from noon to just before midnight.
/// </summary>
public const int PM = 12;
 
/// <summary>
/// The hash table that contains the type of calendars and its properties.
/// </summary>
static public CalendarHashTable manager = new CalendarHashTable();
 
/// <summary>
/// Internal class that inherits from HashTable to manage the different calendars.
/// This structure will contain an instance of Calendar that represents
/// a type of calendar and its properties (represented by an instance of CalendarProperties
/// class).
/// </summary>
public class CalendarHashTable : Hashtable
{
/// <summary>
/// Gets the calendar current date and time.
/// </summary>
/// <param name="calendar">The calendar to get its current date and time.</param>
/// <returns>A DateTime value that indicates the current date and time for the
/// calendar given.</returns>
public DateTime GetDateTime( Calendar calendar )
{
if ( this[calendar] != null )
return ( (CalendarProperties)this[calendar] ).dateTime;
else
{
CalendarProperties tempProps = new CalendarProperties();
tempProps.dateTime = DateTime.Now;
this.Add( calendar, tempProps );
return this.GetDateTime( calendar );
}
}
 
/// <summary>
/// Sets the specified DateTime value to the specified calendar.
/// </summary>
/// <param name="calendar">The calendar to set its date.</param>
/// <param name="date">The DateTime value to set to the calendar.</param>
public void SetDateTime( Calendar calendar, DateTime date )
{
if ( this[calendar] != null )
{
( (CalendarProperties)this[calendar] ).dateTime = date;
}
else
{
CalendarProperties tempProps = new CalendarProperties();
tempProps.dateTime = date;
this.Add( calendar, tempProps );
}
}
 
/// <summary>
/// Sets the corresponding field in an specified calendar with the value given.
/// If the specified calendar does not have exist in the hash table, it creates a
/// new instance of the calendar with the current date and time and then assings it
/// the new specified value.
/// </summary>
/// <param name="calendar">The calendar to set its date or time.</param>
/// <param name="field">One of the fields that composes a date/time.</param>
/// <param name="fieldValue">The value to be set.</param>
public void Set( Calendar calendar, int field, int fieldValue )
{
if ( this[calendar] != null )
{
DateTime tempDate = ( (CalendarProperties)this[calendar] ).dateTime;
switch ( field )
{
case CalendarManager.DATE:
tempDate = tempDate.AddDays( fieldValue - tempDate.Day );
break;
case CalendarManager.HOUR:
tempDate = tempDate.AddHours( fieldValue - tempDate.Hour );
break;
case CalendarManager.MILLISECOND:
tempDate = tempDate.AddMilliseconds( fieldValue - tempDate.Millisecond );
break;
case CalendarManager.MINUTE:
tempDate = tempDate.AddMinutes( fieldValue - tempDate.Minute );
break;
case CalendarManager.MONTH:
//Month value is 0-based. e.g., 0 for January
tempDate = tempDate.AddMonths( fieldValue - ( tempDate.Month + 1 ) );
break;
case CalendarManager.SECOND:
tempDate = tempDate.AddSeconds( fieldValue - tempDate.Second );
break;
case CalendarManager.YEAR:
tempDate = tempDate.AddYears( fieldValue - tempDate.Year );
break;
case CalendarManager.DAY_OF_MONTH:
tempDate = tempDate.AddDays( fieldValue - tempDate.Day );
break;
case CalendarManager.DAY_OF_WEEK:
;
tempDate = tempDate.AddDays( ( fieldValue - 1 ) - (int)tempDate.DayOfWeek );
break;
case CalendarManager.HOUR_OF_DAY:
tempDate = tempDate.AddHours( fieldValue - tempDate.Hour );
break;
 
default:
break;
}
( (CalendarProperties)this[calendar] ).dateTime = tempDate;
}
else
{
CalendarProperties tempProps = new CalendarProperties();
tempProps.dateTime = DateTime.Now;
this.Add( calendar, tempProps );
this.Set( calendar, field, fieldValue );
}
}
 
/// <summary>
/// Sets the corresponding date (day, month and year) to the calendar specified.
/// If the calendar does not exist in the hash table, it creates a new instance and sets
/// its values.
/// </summary>
/// <param name="calendar">The calendar to set its date.</param>
/// <param name="year">Integer value that represent the year.</param>
/// <param name="month">Integer value that represent the month.</param>
/// <param name="day">Integer value that represent the day.</param>
public void Set( Calendar calendar, int year, int month, int day )
{
if ( this[calendar] != null )
{
this.Set( calendar, CalendarManager.YEAR, year );
this.Set( calendar, CalendarManager.MONTH, month );
this.Set( calendar, CalendarManager.DATE, day );
}
else
{
CalendarProperties tempProps = new CalendarProperties();
//Month value is 0-based. e.g., 0 for January
tempProps.dateTime = new DateTime( year, month + 1, day );
this.Add( calendar, tempProps );
}
}
 
/// <summary>
/// Sets the corresponding date (day, month and year) and hour (hour and minute)
/// to the calendar specified.
/// If the calendar does not exist in the hash table, it creates a new instance and sets
/// its values.
/// </summary>
/// <param name="calendar">The calendar to set its date and time.</param>
/// <param name="year">Integer value that represent the year.</param>
/// <param name="month">Integer value that represent the month.</param>
/// <param name="day">Integer value that represent the day.</param>
/// <param name="hour">Integer value that represent the hour.</param>
/// <param name="minute">Integer value that represent the minutes.</param>
public void Set( Calendar calendar, int year, int month, int day, int hour, int minute )
{
if ( this[calendar] != null )
{
this.Set( calendar, CalendarManager.YEAR, year );
this.Set( calendar, CalendarManager.MONTH, month );
this.Set( calendar, CalendarManager.DATE, day );
this.Set( calendar, CalendarManager.HOUR, hour );
this.Set( calendar, CalendarManager.MINUTE, minute );
}
else
{
CalendarProperties tempProps = new CalendarProperties();
//Month value is 0-based. e.g., 0 for January
tempProps.dateTime = new DateTime( year, month + 1, day, hour, minute, 0 );
this.Add( calendar, tempProps );
}
}
 
/// <summary>
/// Sets the corresponding date (day, month and year) and hour (hour, minute and second)
/// to the calendar specified.
/// If the calendar does not exist in the hash table, it creates a new instance and sets
/// its values.
/// </summary>
/// <param name="calendar">The calendar to set its date and time.</param>
/// <param name="year">Integer value that represent the year.</param>
/// <param name="month">Integer value that represent the month.</param>
/// <param name="day">Integer value that represent the day.</param>
/// <param name="hour">Integer value that represent the hour.</param>
/// <param name="minute">Integer value that represent the minutes.</param>
/// <param name="second">Integer value that represent the seconds.</param>
public void Set( Calendar calendar, int year, int month, int day, int hour, int minute, int second )
{
if ( this[calendar] != null )
{
this.Set( calendar, CalendarManager.YEAR, year );
this.Set( calendar, CalendarManager.MONTH, month );
this.Set( calendar, CalendarManager.DATE, day );
this.Set( calendar, CalendarManager.HOUR, hour );
this.Set( calendar, CalendarManager.MINUTE, minute );
this.Set( calendar, CalendarManager.SECOND, second );
}
else
{
CalendarProperties tempProps = new CalendarProperties();
//Month value is 0-based. e.g., 0 for January
tempProps.dateTime = new DateTime( year, month + 1, day, hour, minute, second );
this.Add( calendar, tempProps );
}
}
 
/// <summary>
/// Gets the value represented by the field specified.
/// </summary>
/// <param name="calendar">The calendar to get its date or time.</param>
/// <param name="field">One of the field that composes a date/time.</param>
/// <returns>The integer value for the field given.</returns>
public int Get( Calendar calendar, int field )
{
if ( this[calendar] != null )
{
int tempHour;
switch ( field )
{
case CalendarManager.DATE:
return ( (CalendarProperties)this[calendar] ).dateTime.Day;
case CalendarManager.HOUR:
tempHour = ( (CalendarProperties)this[calendar] ).dateTime.Hour;
return tempHour > 12 ? tempHour - 12 : tempHour;
case CalendarManager.MILLISECOND:
return ( (CalendarProperties)this[calendar] ).dateTime.Millisecond;
case CalendarManager.MINUTE:
return ( (CalendarProperties)this[calendar] ).dateTime.Minute;
case CalendarManager.MONTH:
//Month value is 0-based. e.g., 0 for January
return ( (CalendarProperties)this[calendar] ).dateTime.Month - 1;
case CalendarManager.SECOND:
return ( (CalendarProperties)this[calendar] ).dateTime.Second;
case CalendarManager.YEAR:
return ( (CalendarProperties)this[calendar] ).dateTime.Year;
case CalendarManager.DAY_OF_MONTH:
return ( (CalendarProperties)this[calendar] ).dateTime.Day;
case CalendarManager.DAY_OF_WEEK:
return (int)( ( (CalendarProperties)this[calendar] ).dateTime.DayOfWeek );
case CalendarManager.HOUR_OF_DAY:
return ( (CalendarProperties)this[calendar] ).dateTime.Hour;
case CalendarManager.AM_PM:
tempHour = ( (CalendarProperties)this[calendar] ).dateTime.Hour;
return tempHour > 12 ? CalendarManager.PM : CalendarManager.AM;
 
default:
return 0;
}
}
else
{
CalendarProperties tempProps = new CalendarProperties();
tempProps.dateTime = DateTime.Now;
this.Add( calendar, tempProps );
return this.Get( calendar, field );
}
}
 
/// <summary>
/// Sets the time in the specified calendar with the long value.
/// </summary>
/// <param name="calendar">The calendar to set its date and time.</param>
/// <param name="milliseconds">A long value that indicates the milliseconds to be set to
/// the hour for the calendar.</param>
public void SetTimeInMilliseconds( Calendar calendar, long milliseconds )
{
if ( this[calendar] != null )
{
( (CalendarProperties)this[calendar] ).dateTime = new DateTime( milliseconds );
}
else
{
CalendarProperties tempProps = new CalendarProperties();
tempProps.dateTime = new DateTime( TimeSpan.TicksPerMillisecond * milliseconds );
this.Add( calendar, tempProps );
}
}
 
/// <summary>
/// Gets what the first day of the week is; e.g., Sunday in US, Monday in France.
/// </summary>
/// <param name="calendar">The calendar to get its first day of the week.</param>
/// <returns>A DayOfWeek value indicating the first day of the week.</returns>
public DayOfWeek GetFirstDayOfWeek( Calendar calendar )
{
if ( this[calendar] != null && ( (CalendarProperties)this[calendar] ).dateTimeFormat != null )
{
return ( (CalendarProperties)this[calendar] ).dateTimeFormat.FirstDayOfWeek;
}
else
{
CalendarProperties tempProps = new CalendarProperties();
tempProps.dateTimeFormat = new DateTimeFormatInfo();
tempProps.dateTimeFormat.FirstDayOfWeek = DayOfWeek.Sunday;
this.Add( calendar, tempProps );
return this.GetFirstDayOfWeek( calendar );
}
}
 
/// <summary>
/// Sets what the first day of the week is; e.g., Sunday in US, Monday in France.
/// </summary>
/// <param name="calendar">The calendar to set its first day of the week.</param>
/// <param name="firstDayOfWeek">A DayOfWeek value indicating the first day of the week
/// to be set.</param>
public void SetFirstDayOfWeek( Calendar calendar, DayOfWeek firstDayOfWeek )
{
if ( this[calendar] != null && ( (CalendarProperties)this[calendar] ).dateTimeFormat != null )
{
( (CalendarProperties)this[calendar] ).dateTimeFormat.FirstDayOfWeek = firstDayOfWeek;
}
else
{
CalendarProperties tempProps = new CalendarProperties();
tempProps.dateTimeFormat = new DateTimeFormatInfo();
this.Add( calendar, tempProps );
this.SetFirstDayOfWeek( calendar, firstDayOfWeek );
}
}
 
/// <summary>
/// Removes the specified calendar from the hash table.
/// </summary>
/// <param name="calendar">The calendar to be removed.</param>
public void Clear( Calendar calendar )
{
if ( this[calendar] != null )
this.Remove( calendar );
}
 
/// <summary>
/// Removes the specified field from the calendar given.
/// If the field does not exists in the calendar, the calendar is removed from the table.
/// </summary>
/// <param name="calendar">The calendar to remove the value from.</param>
/// <param name="field">The field to be removed from the calendar.</param>
public void Clear( Calendar calendar, int field )
{
if ( this[calendar] != null )
this.Remove( calendar );
else
this.Set( calendar, field, 0 );
}
 
/// <summary>
/// Internal class that represents the properties of a calendar instance.
/// </summary>
class CalendarProperties
{
/// <summary>
/// The date and time of a calendar.
/// </summary>
public DateTime dateTime;
 
/// <summary>
/// The format for the date and time in a calendar.
/// </summary>
public DateTimeFormatInfo dateTimeFormat;
}
}
}
 
/*******************************/
/// <summary>
/// Provides support for DateFormat
/// </summary>
public class DateTimeFormatManager
{
static public DateTimeFormatHashTable manager = new DateTimeFormatHashTable();
 
/// <summary>
/// Hashtable class to provide functionality for dateformat properties
/// </summary>
public class DateTimeFormatHashTable : Hashtable
{
/// <summary>
/// Sets the format for datetime.
/// </summary>
/// <param name="format">DateTimeFormat instance to set the pattern</param>
/// <param name="newPattern">A string with the pattern format</param>
public void SetDateFormatPattern( DateTimeFormatInfo format, string newPattern )
{
if ( this[format] != null )
( (DateTimeFormatProperties)this[format] ).DateFormatPattern = newPattern;
else
{
DateTimeFormatProperties tempProps = new DateTimeFormatProperties();
tempProps.DateFormatPattern = newPattern;
Add( format, tempProps );
}
}
 
/// <summary>
/// Gets the current format pattern of the DateTimeFormat instance
/// </summary>
/// <param name="format">The DateTimeFormat instance which the value will be obtained</param>
/// <returns>The string representing the current datetimeformat pattern</returns>
public string GetDateFormatPattern( DateTimeFormatInfo format )
{
if ( this[format] == null )
return "d-MMM-yy";
else
return ( (DateTimeFormatProperties)this[format] ).DateFormatPattern;
}
 
/// <summary>
/// Sets the datetimeformat pattern to the giving format
/// </summary>
/// <param name="format">The datetimeformat instance to set</param>
/// <param name="newPattern">The new datetimeformat pattern</param>
public void SetTimeFormatPattern( DateTimeFormatInfo format, string newPattern )
{
if ( this[format] != null )
( (DateTimeFormatProperties)this[format] ).TimeFormatPattern = newPattern;
else
{
DateTimeFormatProperties tempProps = new DateTimeFormatProperties();
tempProps.TimeFormatPattern = newPattern;
Add( format, tempProps );
}
}
 
/// <summary>
/// Gets the current format pattern of the DateTimeFormat instance
/// </summary>
/// <param name="format">The DateTimeFormat instance which the value will be obtained</param>
/// <returns>The string representing the current datetimeformat pattern</returns>
public string GetTimeFormatPattern( DateTimeFormatInfo format )
{
if ( this[format] == null )
return "h:mm:ss tt";
else
return ( (DateTimeFormatProperties)this[format] ).TimeFormatPattern;
}
 
/// <summary>
/// Internal class to provides the DateFormat and TimeFormat pattern properties on .NET
/// </summary>
class DateTimeFormatProperties
{
public string DateFormatPattern = "d-MMM-yy";
public string TimeFormatPattern = "h:mm:ss tt";
}
}
}
/*******************************/
/// <summary>
/// Gets the DateTimeFormat instance using the culture passed as parameter and sets the pattern to the time or date depending of the value
/// </summary>
/// <param name="dateStyle">The desired date style.</param>
/// <param name="timeStyle">The desired time style</param>
/// <param name="culture">The CultureInfo instance used to obtain the DateTimeFormat</param>
/// <returns>The DateTimeFomatInfo of the culture and with the desired date or time style</returns>
public static DateTimeFormatInfo GetDateTimeFormatInstance( int dateStyle, int timeStyle, CultureInfo culture )
{
DateTimeFormatInfo format = culture.DateTimeFormat;
 
switch ( timeStyle )
{
case -1:
DateTimeFormatManager.manager.SetTimeFormatPattern( format, "" );
break;
 
case 0:
DateTimeFormatManager.manager.SetTimeFormatPattern( format, "h:mm:ss 'o clock' tt zzz" );
break;
 
case 1:
DateTimeFormatManager.manager.SetTimeFormatPattern( format, "h:mm:ss tt zzz" );
break;
 
case 2:
DateTimeFormatManager.manager.SetTimeFormatPattern( format, "h:mm:ss tt" );
break;
 
case 3:
DateTimeFormatManager.manager.SetTimeFormatPattern( format, "h:mm tt" );
break;
}
 
switch ( dateStyle )
{
case -1:
DateTimeFormatManager.manager.SetDateFormatPattern( format, "" );
break;
 
case 0:
DateTimeFormatManager.manager.SetDateFormatPattern( format, "dddd, MMMM dd%, yyy" );
break;
 
case 1:
DateTimeFormatManager.manager.SetDateFormatPattern( format, "MMMM dd%, yyy" );
break;
 
case 2:
DateTimeFormatManager.manager.SetDateFormatPattern( format, "d-MMM-yy" );
break;
 
case 3:
DateTimeFormatManager.manager.SetDateFormatPattern( format, "M/dd/yy" );
break;
}
 
return format;
}
 
/*******************************/
/// <summary>
/// Gets the DateTimeFormat instance and date instance to obtain the date with the format passed
/// </summary>
/// <param name="format">The DateTimeFormat to obtain the time and date pattern</param>
/// <param name="date">The date instance used to get the date</param>
/// <returns>A string representing the date with the time and date patterns</returns>
public static string FormatDateTime( DateTimeFormatInfo format, DateTime date )
{
string timePattern = DateTimeFormatManager.manager.GetTimeFormatPattern( format );
string datePattern = DateTimeFormatManager.manager.GetDateFormatPattern( format );
return date.ToString( datePattern + " " + timePattern, format );
}
 
/*******************************/
/// <summary>
/// Adds a new key-and-value pair into the hash table
/// </summary>
/// <param name="collection">The collection to work with</param>
/// <param name="key">Key used to obtain the value</param>
/// <param name="newValue">Value asociated with the key</param>
/// <returns>The old element associated with the key</returns>
public static Object PutElement( IDictionary collection, Object key, Object newValue )
{
Object element = collection[key];
collection[key] = newValue;
return element;
}
 
/*******************************/
/// <summary>
/// Provides support functions to create read-write random acces files and write functions
/// </summary>
public class RandomAccessFileSupport
{
/// <summary>
/// Creates a new random acces stream with read-write or read rights
/// </summary>
/// <param name="fileName">A relative or absolute path for the file to open</param>
/// <param name="mode">Mode to open the file in</param>
/// <returns>The new FileStream</returns>
public static FileStream CreateRandomAccessFile( string fileName, string mode )
{
FileStream newFile = null;
 
if ( mode.CompareTo( "rw" ) == 0 )
newFile = new FileStream( fileName, FileMode.OpenOrCreate, FileAccess.ReadWrite );
else if ( mode.CompareTo( "r" ) == 0 )
newFile = new FileStream( fileName, FileMode.Open, FileAccess.Read );
else
throw new ArgumentException();
 
return newFile;
}
 
/// <summary>
/// Creates a new random acces stream with read-write or read rights
/// </summary>
/// <param name="fileName">File infomation for the file to open</param>
/// <param name="mode">Mode to open the file in</param>
/// <returns>The new FileStream</returns>
public static FileStream CreateRandomAccessFile( FileInfo fileName, string mode )
{
return CreateRandomAccessFile( fileName.FullName, mode );
}
 
/// <summary>
/// Writes the data to the specified file stream
/// </summary>
/// <param name="data">Data to write</param>
/// <param name="fileStream">File to write to</param>
public static void WriteBytes( string data, FileStream fileStream )
{
int index = 0;
int length = data.Length;
 
while ( index < length )
fileStream.WriteByte( (byte)data[index++] );
}
 
/// <summary>
/// Writes the received string to the file stream
/// </summary>
/// <param name="data">String of information to write</param>
/// <param name="fileStream">File to write to</param>
public static void WriteChars( string data, FileStream fileStream )
{
WriteBytes( data, fileStream );
}
 
/// <summary>
/// Writes the received data to the file stream
/// </summary>
/// <param name="sByteArray">Data to write</param>
/// <param name="fileStream">File to write to</param>
public static void WriteRandomFile( sbyte[] sByteArray, FileStream fileStream )
{
byte[] byteArray = ToByteArray( sByteArray );
fileStream.Write( byteArray, 0, byteArray.Length );
}
}
 
/*******************************/
/// <summary>
/// Checks if a file have write permissions
/// </summary>
/// <param name="file">The file instance to check</param>
/// <returns>True if have write permissions otherwise false</returns>
public static bool FileCanWrite( FileInfo file )
{
return ( File.GetAttributes( file.FullName ) & FileAttributes.ReadOnly ) != FileAttributes.ReadOnly;
}
 
/*******************************/
/// <summary>
/// Checks if the giving File instance is a directory or file, and returns his Length
/// </summary>
/// <param name="file">The File instance to check</param>
/// <returns>The length of the file</returns>
public static long FileLength( FileInfo file )
{
if ( Directory.Exists( file.FullName ) )
return 0;
else
return file.Length;
}
 
/*******************************/
/// <summary>Reads a number of characters from the current source Stream and writes the data to the target array at the specified index.</summary>
/// <param name="sourceStream">The source Stream to read from.</param>
/// <param name="target">Contains the array of characteres read from the source Stream.</param>
/// <param name="start">The starting index of the target array.</param>
/// <param name="count">The maximum number of characters to read from the source Stream.</param>
/// <returns>The number of characters read. The number will be less than or equal to count depending on the data available in the source Stream. Returns -1 if the end of the stream is reached.</returns>
public static Int32 ReadInput( Stream sourceStream, ref byte[] target, int start, int count )
{
// Returns 0 bytes if not enough space in target
if ( target.Length == 0 )
return 0;
 
byte[] receiver = new byte[target.Length];
int bytesRead = sourceStream.Read( receiver, start, count );
 
// Returns -1 if EOF
if ( bytesRead == 0 )
return -1;
 
for ( int i = start; i < start + bytesRead; i++ )
target[i] = (byte)receiver[i];
 
return bytesRead;
}
 
/// <summary>Reads a number of characters from the current source TextReader and writes the data to the target array at the specified index.</summary>
/// <param name="sourceTextReader">The source TextReader to read from</param>
/// <param name="target">Contains the array of characteres read from the source TextReader.</param>
/// <param name="start">The starting index of the target array.</param>
/// <param name="count">The maximum number of characters to read from the source TextReader.</param>
/// <returns>The number of characters read. The number will be less than or equal to count depending on the data available in the source TextReader. Returns -1 if the end of the stream is reached.</returns>
public static Int32 ReadInput( TextReader sourceTextReader, ref sbyte[] target, int start, int count )
{
// Returns 0 bytes if not enough space in target
if ( target.Length == 0 )
return 0;
 
char[] charArray = new char[target.Length];
int bytesRead = sourceTextReader.Read( charArray, start, count );
 
// Returns -1 if EOF
if ( bytesRead == 0 )
return -1;
 
for ( int index = start; index < start + bytesRead; index++ )
target[index] = (sbyte)charArray[index];
 
return bytesRead;
}
 
/*******************************/
/// <summary>
/// Performs an unsigned bitwise right shift with the specified number
/// </summary>
/// <param name="number">Number to operate on</param>
/// <param name="bits">Ammount of bits to shift</param>
/// <returns>The resulting number from the shift operation</returns>
public static int URShift( int number, int bits )
{
if ( number >= 0 )
return number >> bits;
else
return ( number >> bits ) + ( 2 << ~bits );
}
 
/// <summary>
/// Performs an unsigned bitwise right shift with the specified number
/// </summary>
/// <param name="number">Number to operate on</param>
/// <param name="bits">Ammount of bits to shift</param>
/// <returns>The resulting number from the shift operation</returns>
public static int URShift( int number, long bits )
{
return URShift( number, (int)bits );
}
 
/// <summary>
/// Performs an unsigned bitwise right shift with the specified number
/// </summary>
/// <param name="number">Number to operate on</param>
/// <param name="bits">Ammount of bits to shift</param>
/// <returns>The resulting number from the shift operation</returns>
public static long URShift( long number, int bits )
{
if ( number >= 0 )
return number >> bits;
else
return ( number >> bits ) + ( 2L << ~bits );
}
 
/// <summary>
/// Performs an unsigned bitwise right shift with the specified number
/// </summary>
/// <param name="number">Number to operate on</param>
/// <param name="bits">Ammount of bits to shift</param>
/// <returns>The resulting number from the shift operation</returns>
public static long URShift( long number, long bits )
{
return URShift( number, (int)bits );
}
 
/*******************************/
/// <summary>
/// Writes the exception stack trace to the received stream
/// </summary>
/// <param name="throwable">Exception to obtain information from</param>
/// <param name="stream">Output sream used to write to</param>
public static void WriteStackTrace( Exception throwable, TextWriter stream )
{
stream.Write( throwable.StackTrace );
stream.Flush();
}
 
/*******************************/
/// <summary>
/// Removes the element with the specified key from a Hashtable instance.
/// </summary>
/// <param name="hashtable">The Hashtable instance</param>
/// <param name="key">The key of the element to remove</param>
/// <returns>The element removed</returns>
public static Object HashtableRemove( Hashtable hashtable, Object key )
{
Object element = hashtable[key];
hashtable.Remove( key );
return element;
}
 
/*******************************/
/// <summary>
/// Converts an array of sbytes to an array of chars
/// </summary>
/// <param name="sByteArray">The array of sbytes to convert</param>
/// <returns>The new array of chars</returns>
public static char[] ToCharArray( sbyte[] sByteArray )
{
char[] charArray = new char[sByteArray.Length];
sByteArray.CopyTo( charArray, 0 );
return charArray;
}
 
/// <summary>
/// Converts an array of bytes to an array of chars
/// </summary>
/// <param name="byteArray">The array of bytes to convert</param>
/// <returns>The new array of chars</returns>
public static char[] ToCharArray( byte[] byteArray )
{
char[] charArray = new char[byteArray.Length];
byteArray.CopyTo( charArray, 0 );
return charArray;
}
 
/*******************************/
/// <summary>
/// Receives a byte array and returns it transformed in an sbyte array
/// </summary>
/// <param name="byteArray">Byte array to process</param>
/// <returns>The transformed array</returns>
public static sbyte[] ToSByteArray( byte[] byteArray )
{
sbyte[] sbyteArray = new sbyte[byteArray.Length];
for ( int index = 0; index < byteArray.Length; index++ )
sbyteArray[index] = (sbyte)byteArray[index];
return sbyteArray;
}
/*******************************/
/// <summary>
/// Returns the last element of an ArrayList instance.
/// </summary>
/// <param name="arrayList">The ArrayList instance</param>
/// <returns>The last element of the ArrayList</returns>
public static Object VectorLastElement( ArrayList arrayList )
{
return arrayList[arrayList.Count - 1];
}
 
/// <summary>
/// Returns the last element of a Stack instance.
/// </summary>
/// <param name="stack">The Stack instance</param>
/// <returns>The last element of the Stack</returns>
public static Object VectorLastElement( Stack stack )
{
return stack.ToArray()[0];
}
 
 
/*******************************/
/// <summary>
/// Adds an element to the top end of a Stack instance.
/// </summary>
/// <param name="stack">The Stack instance</param>
/// <param name="element">The element to add</param>
/// <returns>The element added</returns>
public static Object StackPush( Stack stack, Object element )
{
stack.Push( element );
return element;
}
 
/*******************************/
/// <summary>
/// Creates an instance of a received Type.
/// </summary>
/// <param name="classType">The Type of the new class instance to return.</param>
/// <returns>An Object containing the new instance.</returns>
public static Object CreateNewInstance( Type classType )
{
Object instance = null;
Type[] constructor = new Type[] { };
ConstructorInfo[] constructors = null;
 
constructors = classType.GetConstructors();
 
if ( constructors.Length == 0 )
throw new UnauthorizedAccessException();
else
{
for ( int i = 0; i < constructors.Length; i++ )
{
ParameterInfo[] parameters = constructors[i].GetParameters();
 
if ( parameters.Length == 0 )
{
instance = classType.GetConstructor( constructor ).Invoke( new Object[] { } );
break;
}
else if ( i == constructors.Length - 1 )
throw new MethodAccessException();
}
}
return instance;
}
 
 
/*******************************/
/// <summary>
/// Obtains the int value depending of the type of modifiers that the constructor have
/// </summary>
/// <param name="constructor">The ConstructorInfo used to obtain the int value</param>
/// <returns>The int value of the modifier present in the constructor. 1 if it's public, 2 if it's private, otherwise 4</returns>
public static int GetConstructorModifiers( ConstructorInfo constructor )
{
int temp;
if ( constructor.IsPublic )
temp = 1;
else if ( constructor.IsPrivate )
temp = 2;
else
temp = 4;
return temp;
}
 
/*******************************/
/// <summary>
/// Write an array of bytes int the FileStream specified.
/// </summary>
/// <param name="FileStreamWrite">FileStream that must be updated.</param>
/// <param name="Source">Array of bytes that must be written in the FileStream.</param>
public static void WriteOutput( FileStream FileStreamWrite, sbyte[] Source )
{
FileStreamWrite.Write( ToByteArray( Source ), 0, Source.Length );
}
 
 
}
/trunk/TCL/src/_tcl_Conversions.cs
@@ -0,0 +1,763 @@
using System;
using System.Collections;
using System.Diagnostics;
using System.Text;
 
using sqlite_int64 = System.Int64;
using i32 = System.Int32;
using i64 = System.Int64;
using u32 = System.UInt32;
 
namespace tcl.lang
{
#if TCLSH
using lang;
using Tcl_Channel = Channel;
using Tcl_DString = TclString;
using Tcl_Interp = Interp;
using Tcl_Obj = TclObject;
using Tcl_WideInt = System.Int64;
 
public partial class TCL
{
 
// -- Conversion from TCL to tclsharp coding
// Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
public static void Tcl_AppendElement( Interp interp, StringBuilder toAppend )
{
interp.appendElement( toAppend.ToString() );
}
 
public static void Tcl_AppendElement( Interp interp, string toAppend )
{
interp.appendElement( toAppend );
}
 
public static void Tcl_AppendResult( Interp interp, params object[] tos )
{
if ( tos != null )
{
StringBuilder result = new StringBuilder( 100 );
for ( int i = 0; i < tos.Length && tos[i] != null; i++ )
result.Append( tos[i].ToString() );
interp.appendElement( result.ToString() );
}
}
 
public static void Tcl_AppendResult( Interp interp, params string[] strings )
{
if ( strings != null )
{
StringBuilder result = new StringBuilder( 100 );
for ( int i = 0; i < strings.Length && strings[i] != null && strings[i] != ""; i++ )
result.Append( strings[i] );
interp.appendElement( result.ToString() );
}
}
 
public static void Tcl_BackgroundError( Interp interp )
{
interp.setErrorCode( TclInteger.newInstance( TCL_ERROR ) );
interp.addErrorInfo( "Background Error" );
}
 
public static void Tcl_CreateCommand( Interp interp, string cmdName, Interp.dxObjCmdProc ObjCmdProc, object ClientData, Interp.dxCmdDeleteProc DbDeleteCmd )
{
interp.createObjCommand( cmdName, ObjCmdProc, ClientData, DbDeleteCmd );
}
 
public static void Tcl_CreateObjCommand( Interp interp, string cmdName, Interp.dxObjCmdProc ObjCmdProc, object ClientData, Interp.dxCmdDeleteProc DbDeleteCmd )
{
interp.createObjCommand( cmdName, ObjCmdProc, ClientData, DbDeleteCmd );
}
 
 
public static bool Tcl_CreateCommandPointer( Interp interp, StringBuilder command, object clientData )
{
try
{
interp.createObjCommand( command.ToString(), null, clientData, null );
return false;
}
catch
{
return true;
}
}
 
public static bool Tcl_CreateCommandPointer( Interp interp, string command, object clientData )
{
try
{
interp.createObjCommand( command, null, clientData, null );
return false;
}
catch
{
return true;
}
}
 
public static void Tcl_DecrRefCount( ref TclObject to )
{
to.release();
if ( to.internalRep == null )
to = null;
}
 
public static int Tcl_DeleteCommand( Interp interp, string cmdName )
{
return interp.deleteCommand( cmdName );
}
 
public static void Tcl_DStringAppendElement( TclObject str, string append )
{
TclString.append( str, append );
}
 
public static void Tcl_DStringFree( ref TclObject str )
{
str.release();
}
 
public static void Tcl_DStringInit( out TclObject str )
{
str = TclString.newInstance( "" );
str.preserve();
}
 
public static int Tcl_DStringLength( TclObject str )
{
return str.ToString().Length;
}
 
public static TclObject Tcl_DuplicateObj( TclObject to )
{
return to.duplicate();
}
 
public static int Tcl_Eval( Interp interp, string s )
{
try
{
interp.eval( s );
return 0;
}
catch
{
return 1;
};
}
public static int Tcl_EvalObjEx( Interp interp, TclObject tobj, int flags )
{
try
{
interp.eval( tobj, flags );
return 0;
}
catch ( TclException e )
{
if ( e.getCompletionCode() == TCL.CompletionCode.RETURN )
return TCL_RETURN;
else if ( e.getCompletionCode() == TCL.CompletionCode.BREAK || interp.getResult().ToString() == "invoked \"break\" outside of a loop" )
return TCL_BREAK;
else
return TCL_ERROR;
};
}
 
public static void Tcl_Free( ref TclObject[] to )
{
if ( to != null )
for ( int i = 0; i < to.Length; i++ )
while ( to[i] != null && to[i].refCount > 0 )
to[i].release();
to = null;
}
 
public static void Tcl_Free( ref TclObject to )
{
while ( to.refCount > 0 )
to.release();
}
 
public static void Tcl_Free<T>( ref T x ) where T : class
{
x = null;
}
 
public static bool Tcl_GetBoolean( Interp interp, TclObject to, out int result )
{
try
{
result = ( TclBoolean.get( interp, to ) ? 1 : 0 );
return false;
}
catch
{
result = 0;
return true;
}
}
 
public static bool Tcl_GetBoolean( Interp interp, TclObject to, out bool result )
{
try
{
result = TclBoolean.get( interp, to );
return false;
}
catch
{
result = false;
return true;
}
}
 
public static bool Tcl_GetBooleanFromObj( Interp interp, TclObject to, out bool result )
{
try
{
result = TclBoolean.get( interp, to );
return false;
}
catch
{
result = false;
return true;
}
}
 
public static bool Tcl_GetCommandInfo( Interp interp, string command, out WrappedCommand value )
{
try
{
value = interp.getObjCommand( command );
return false;
}
catch
{
value = null;
return true;
}
}
 
public static byte[] Tcl_GetByteArrayFromObj( TclObject to, out int n )
{
n = TclByteArray.getLength( null, to );
return Encoding.UTF8.GetBytes( to.ToString() );
}
 
public static bool Tcl_GetDouble( Interp interp, TclObject to, out double value )
{
try
{
value = TclDouble.get( interp, to );
return false;
}
catch
{
value = 0;
return true;
}
}
 
public static bool Tcl_GetDoubleFromObj( Interp interp, TclObject to, out double value )
{
try
{
if ( to.ToString() == "NaN" )
value = Double.NaN;
else
value = TclDouble.get( interp, to );
return false;
}
catch
{
value = 0;
return true;
}
}
 
public static bool Tcl_GetIndexFromObj( Interp interp, TclObject to, string[] table, string msg, int flags, out int index )
{
try
{
index = TclIndex.get( interp, to, table, msg, flags );
return false;
}
catch
{
index = 0;
return true;
}
}
 
public static bool Tcl_GetInt( Interp interp, TclObject to, out int value )
{
try
{
value = TclInteger.get( interp, to );
return false;
}
catch
{
value = 0;
return true;
}
}
 
public static bool Tcl_GetInt( Interp interp, TclObject to, out u32 value )
{
try
{
value = (u32)TclInteger.get( interp, to );
return false;
}
catch
{
value = 0;
return true;
}
}
 
public static int Tcl_GetIntFromObj( Interp interp, TclObject to, out int value )
{
try
{
value = TclInteger.get( interp, to );
return TCL.TCL_OK;
}
catch
{
value = 0;
return TCL.TCL_ERROR;
}
}
 
public static bool Tcl_GetLong( Interp interp, TclObject to, out i64 value )
{
try
{
value = (i64)TclLong.get( interp, to );
return false;
}
catch
{
value = 0;
return true;
}
}
 
public static TclObject Tcl_GetObjResult( Interp interp )
{
TclObject toReturn = interp.getResult();
return toReturn;
}
 
public static string Tcl_GetString( TclObject to )
{
return to.ToString();
}
 
public static string Tcl_GetStringFromObj( TclObject to, int n )
{
Debug.Assert( n == 0, "Try calling by ref" );
return to.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;
}
 
public static string Tcl_GetStringResult( Interp interp )
{
return interp.getResult().ToString();
}
 
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;
};
}
 
public static TclObject Tcl_GetVar( Interp interp, string part, VarFlag flags )
{
try
{
TclObject to = interp.getVar( part, flags );
return to;
}
catch ( Exception e )
{
return TclObj.newInstance( "" );
};
}
 
 
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;
};
}
 
public static bool Tcl_GetWideIntFromObj( Interp interp, TclObject to, out sqlite_int64 value )
{
try
{
if ( to.ToString() == "NaN" )
unchecked
{
value = (long)Double.NaN;
}
else
value = TclLong.get( interp, to );
return false;
}
catch
{
value = 0;
return true;
};
}
 
public static void Tcl_IncrRefCount( TclObject to )
{
to.preserve();
}
 
public static void Tcl_LinkVar( Interp interp, string name, Object GetSet, VarFlags flags )
{
Debug.Assert( ( ( flags & VarFlags.SQLITE3_LINK_READ_ONLY ) != 0 ) || GetSet.GetType().Name == "SQLITE3_GETSET" );
Var[] linkvar = Var.lookupVar( interp, name, null, VarFlag.GLOBAL_ONLY, "define", true, false );
linkvar[0].flags |= VarFlags.SQLITE3_LINK | flags;
linkvar[0].sqlite3_get_set = GetSet;
linkvar[0].refCount++;
}
 
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_ListObjIndex( Interp interp, TclObject to, int nItem, out TclObject elmObj )
{
try
{
elmObj = TclList.index( interp, to, nItem );
}
catch
{
elmObj = null;
}
}
 
public static bool Tcl_ListObjGetElements( Interp interp, TclObject to, out int nItem, out TclObject[] elmObj )
{
try
{
elmObj = TclList.getElements( interp, to );
nItem = elmObj.Length;
return false;
}
catch
{
elmObj =null;
nItem = 0;
return true;
}
}
 
public static void Tcl_ListObjLength( Interp interp, TclObject to, out int nArg )
{
try
{
nArg = TclList.getLength( interp, to );
}
catch
{
nArg = 0;
}
}
 
public static TclObject Tcl_NewBooleanObj( int value )
{
return TclBoolean.newInstance( value != 0 );
}
 
public static TclObject Tcl_NewByteArrayObj( byte[] value, int bytes )
{
if ( value == null || value.Length == 0 || bytes == 0 )
return TclByteArray.newInstance();
else
return TclByteArray.newInstance( value, 0, bytes );
}
 
public static TclObject Tcl_NewByteArrayObj( string value, int bytes )
{
if ( value == null || bytes == 0 )
return TclByteArray.newInstance();
else
return TclByteArray.newInstance( System.Text.Encoding.UTF8.GetBytes( value.Substring( 0, bytes ) ) );
}
 
public static TclObject Tcl_NewDoubleObj( double value )
{
return TclDouble.newInstance( value );
}
 
public static TclObject Tcl_NewIntObj( int value )
{
return TclInteger.newInstance( value );
}
 
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;
}
 
public static TclObject Tcl_NewObj()
{
return TclString.newInstance( "" );
}
 
public static TclObject Tcl_NewStringObj( byte[] value, int iLength )
{
if ( iLength > 0 && iLength < value.Length )
return TclString.newInstance( Encoding.UTF8.GetString( value, 0, iLength ) );
else
return TclString.newInstance( Encoding.UTF8.GetString( value, 0, value.Length ) );
}
 
public static TclObject Tcl_NewStringObj( string value, int iLength )
{
if ( value == null )
value = "";
else
value = value.Split( '\0' )[0];
if ( iLength <= 0 )
iLength = value.Length;
return TclString.newInstance( value.Substring( 0, iLength ) );
}
 
public static TclObject Tcl_NewWideIntObj( long value )
{
return TclLong.newInstance( value );
}
 
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;
}
}
public static void Tcl_PkgProvide( Interp interp, string name, string version )
{
interp.pkgProvide( name, version );
}
 
public static void Tcl_ResetResult( Interp interp )
{
interp.resetResult();
}
 
public static void Tcl_SetBooleanObj( TclObject to, int result )
{
to.stringRep = TclBoolean.newInstance( result != 0 ).ToString();
to.preserve();
}
 
public static bool Tcl_SetCommandInfo( Interp interp, string command, WrappedCommand value )
{
try
{
value = interp.getObjCommand( command );
return false;
}
catch
{
return true;
}
}
 
public static void Tcl_SetIntObj( TclObject to, int result
)
{
while ( to.Shared )
to.release();
TclInteger.set( to, result );
to.preserve();
}
 
public static void Tcl_SetLongObj( TclObject to, long result )
{
while ( to.Shared )
to.release();
TclLong.set( to, result );
to.preserve();
}
 
public static void Tcl_SetObjResult( Interp interp, TclObject to )
{
interp.resetResult();
interp.setResult( to );
}
 
public static void Tcl_SetResult( Interp interp, StringBuilder result, int dummy )
{
interp.resetResult();
interp.setResult( result.ToString() );
}
 
public static void Tcl_SetResult( Interp interp, string result, int dummy )
{
interp.resetResult();
interp.setResult( result );
}
 
public static void Tcl_SetVar( Interp interp, string part, string value, int flags )
{
interp.setVar( part, value, (VarFlag)flags );
}
public static void Tcl_SetVar2( Interp interp, string part1, string part2, string value, int flags )
{
interp.setVar( part1, part2, value, (VarFlag)flags );
}
 
public static void Tcl_SetVar2( Interp interp, string part1, string part2, TclObject value, int flags )
{
interp.setVar( part1, part2, value, (VarFlag)flags );
}
 
public static void Tcl_UnregisterChannel( Interp interp, Channel chan )
{
TclIO.unregisterChannel( interp, chan );
}
 
public static int Tcl_VarEval( Interp interp, string Scriptname, params string[] argv )
{
try
{
//Tcl_Obj[] aArg = null;
int rc = 0;
Tcl_Obj pCmd = Tcl_NewStringObj( Scriptname, -1 );
Tcl_IncrRefCount( pCmd );
for ( int i = 0; i < argv.Length; i++ )
{
if ( argv[i] != null && argv[i] != " " )
rc = Tcl_ListObjAppendElement( interp, pCmd, Tcl_NewStringObj( argv[i], -1 ) ) ? 1 : 0;
if ( rc != 0 )
{
Tcl_DecrRefCount( ref pCmd );
return 1;
}
}
rc = Tcl_EvalObjEx( interp, pCmd, TCL_EVAL_DIRECT );
Tcl_DecrRefCount( ref pCmd );
return rc == TCL_BREAK ? 1 : 0;
}
catch
{
return 1;
}
}
 
public static void Tcl_WrongNumArgs( Interp interp, int argc, TclObject[] argv, string message )
{
throw new TclNumArgsException( interp, argc, argv, message == null ? "option ?arg ...?" : message );
}
 
public static Interp Tcl_GetSlave( Interp interp, string slaveInterp )
{
try
{
return ( (tcl.lang.InterpSlaveCmd)interp.slaveTable[slaveInterp] ).slaveInterp;
}
catch
{
return null;
}
}
}
#endif
}
/trunk/TCL/src/base/AssocData.cs
@@ -0,0 +1,31 @@
/*
* AssocData.java --
*
* The API for registering named data objects in the Tcl
* interpreter.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
* RCS @(#) $Id: AssocData.java,v 1.2 1999/05/11 23:10:03 dejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This interface is the API for registering named data objects in the
/// Tcl interpreter.
/// </summary>
 
public interface AssocData
{
 
void disposeAssocData( Interp interp ); // The interpreter in which this AssocData
// instance is registered in.
}
}
/trunk/TCL/src/base/BackSlashResult.cs
@@ -0,0 +1,37 @@
/*
* BackSlashResult.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
* RCS @(#) $Id: BackSlashResult.java,v 1.1.1.1 1998/10/14 21:09:19 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
class BackSlashResult
{
internal char c;
internal int nextIndex;
internal bool isWordSep;
internal BackSlashResult( char ch, int w )
{
c = ch;
nextIndex = w;
isWordSep = false;
}
internal BackSlashResult( char ch, int w, bool b )
{
c = ch;
nextIndex = w;
isWordSep = b;
}
}
}
/trunk/TCL/src/base/BgErrorMgr.cs
@@ -0,0 +1,280 @@
/*
* BgErrorMgr --
*
* This class manages the background errors for a Tcl interpreter.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: BgErrorMgr.java,v 1.6 2002/01/21 06:34:26 mdejong Exp $
*
*/
using System;
using System.Collections;
using System.IO;
 
namespace tcl.lang
{
 
/*
* This class manages the background errors for a Tcl interpreter. It
* stores the error information about the interpreter and use an idle
* handler to report the error when the notifier is idle.
*/
 
class BgErrorMgr : AssocData
{
private void InitBlock()
{
errors = new ArrayList( 10 );
}
 
/*
* We manage the background errors in this interp instance.
*/
 
internal Interp interp;
 
/*
* A TclObject for invoking the "bgerror" command. We use a TclObject
* instead of a String so that we don't need to look up the command
* every time.
*/
 
internal TclObject bgerrorCmdObj;
 
/*
* A list of the pending background error handlers.
*/
 
internal ArrayList errors;
 
internal BgErrorMgr( Interp i )
{
InitBlock();
interp = i;
bgerrorCmdObj = TclString.newInstance( "bgerror" );
bgerrorCmdObj.preserve();
 
errors = new ArrayList( 10 );
}
internal void addBgError()
{
BgError bgErr = new BgError( this, interp.getNotifier() );
 
// The addErrorInfo() call below (with an empty string)
// ensures that errorInfo gets properly set. It's needed in
// cases where the error came from a utility procedure like
// Interp.getVar() instead of Interp.eval(); in these cases
// errorInfo still won't have been set when this procedure is
// called.
 
interp.addErrorInfo( "" );
 
bgErr.errorMsg = interp.getResult();
bgErr.errorInfo = null;
try
{
bgErr.errorInfo = interp.getVar( "errorInfo", null, TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
// Do nothing if var does not exist.
}
 
bgErr.errorCode = null;
try
{
bgErr.errorCode = interp.getVar( "errorCode", null, TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
// Do nothing if var does not exist.
}
 
bgErr.errorMsg.preserve();
bgErr.errorInfo.preserve();
bgErr.errorCode.preserve();
 
errors.Add( bgErr );
}
public void disposeAssocData( Interp interp )
// The interpreter in which this AssocData
// instance is registered in.
{
for ( int i = errors.Count - 1; i >= 0; i-- )
{
BgError bgErr = (BgError)errors[i];
errors.RemoveAt( i );
bgErr.cancel();
 
bgErr.errorMsg.release();
bgErr.errorMsg = null;
bgErr.errorInfo.release();
bgErr.errorInfo = null;
bgErr.errorCode.release();
bgErr.errorCode = null;
}
 
bgerrorCmdObj.release();
bgerrorCmdObj = null;
}
internal class BgError : IdleHandler
{
private void InitBlock( BgErrorMgr enclosingInstance )
{
this.enclosingInstance = enclosingInstance;
}
private BgErrorMgr enclosingInstance;
public BgErrorMgr Enclosing_Instance
{
get
{
return enclosingInstance;
}
 
}
 
/*
* The interp's result, errorCode and errorInfo when the bgerror happened.
*/
 
internal TclObject errorMsg;
internal TclObject errorCode;
internal TclObject errorInfo;
 
internal BgError( BgErrorMgr enclosingInstance, Notifier n )
: base( n )
{
InitBlock( enclosingInstance );
}
public override void processIdleEvent()
{
 
// During the execution of this method, elements may be removed from
// the errors list (because a TCL.CompletionCode.BREAK was returned by the bgerror
// command, or because the interp was deleted). We remove this
// BgError instance from the list first so that this instance won't
// be deleted twice.
 
SupportClass.VectorRemoveElement( Enclosing_Instance.errors, this );
 
// Restore important state variables to what they were at
// the time the error occurred.
 
try
{
Enclosing_Instance.interp.setVar( "errorInfo", null, errorInfo, TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
 
// Ignore any TclException's, possibly caused by variable traces on
// the errorInfo variable. This is compatible with the behavior of
// the Tcl C API.
}
 
try
{
Enclosing_Instance.interp.setVar( "errorCode", null, errorCode, TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
 
// Ignore any TclException's, possibly caused by variable traces on
// the errorCode variable. This is compatible with the behavior of
// the Tcl C API.
}
 
// Make sure, that the interpreter will surive the invocation
// of the bgerror command.
 
Enclosing_Instance.interp.preserve();
 
try
{
 
// Invoke the bgerror command.
 
TclObject[] argv = new TclObject[2];
argv[0] = Enclosing_Instance.bgerrorCmdObj;
argv[1] = errorMsg;
 
Parser.evalObjv( Enclosing_Instance.interp, argv, 0, TCL.EVAL_GLOBAL );
}
catch ( TclException e )
{
switch ( e.getCompletionCode() )
{
 
case TCL.CompletionCode.ERROR:
try
{
Channel chan = TclIO.getStdChannel( StdChannel.STDERR );
 
if ( Enclosing_Instance.interp.getResult().ToString().Equals( "\"bgerror\" is an invalid command name or ambiguous abbreviation" ) )
{
chan.write( Enclosing_Instance.interp, errorInfo );
chan.write( Enclosing_Instance.interp, "\n" );
}
else
{
chan.write( Enclosing_Instance.interp, "bgerror failed to handle background error.\n" );
chan.write( Enclosing_Instance.interp, " Original error: " );
chan.write( Enclosing_Instance.interp, errorMsg );
chan.write( Enclosing_Instance.interp, "\n" );
chan.write( Enclosing_Instance.interp, " Error in bgerror: " );
chan.write( Enclosing_Instance.interp, Enclosing_Instance.interp.getResult() );
chan.write( Enclosing_Instance.interp, "\n" );
}
chan.flush( Enclosing_Instance.interp );
}
catch ( TclException e1 )
{
 
// Ignore.
}
catch ( IOException e2 )
{
 
// Ignore, too.
}
break;
 
 
case TCL.CompletionCode.BREAK:
 
for ( int i = Enclosing_Instance.errors.Count - 1; i >= 0; i-- )
{
BgError bgErr = (BgError)Enclosing_Instance.errors[i];
Enclosing_Instance.errors.RemoveAt( i );
bgErr.cancel();
 
bgErr.errorMsg.release();
bgErr.errorMsg = null;
bgErr.errorInfo.release();
bgErr.errorInfo = null;
bgErr.errorCode.release();
bgErr.errorCode = null;
}
break;
}
}
 
Enclosing_Instance.interp.release();
 
errorMsg.release();
errorMsg = null;
errorInfo.release();
errorInfo = null;
errorCode.release();
errorCode = null;
}
} // end BgErrorMgr.BgError
} // end BgErrorMgr
}
/trunk/TCL/src/base/CObject.cs
@@ -0,0 +1,62 @@
/*
* CObject.java --
*
* A stub class that represents objects created by the NativeTcl
* interpreter.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: CObject.java,v 1.2 2000/10/29 06:00:41 mdejong Exp $
*/
using System;
namespace tcl.lang
{
 
/*
* This is a stub class used in Jacl to represent objects created in
* the Tcl Blend interpreter. Actually CObjects will never appear inside
* Jacl. However, since TclObject (which is shared between the Tcl Blend
* and Jacl implementations) makes some references to CObject, we include
* a stub class here to make the compiler happy.
*
* None of the methods in this implementation will ever be called.
*/
 
class CObject : InternalRep
{
 
public void dispose()
{
throw new TclRuntimeError( "This shouldn't be called" );
}
 
public InternalRep duplicate()
{
throw new TclRuntimeError( "This shouldn't be called" );
}
 
internal void makeReference( TclObject tobj )
{
throw new TclRuntimeError( "This shouldn't be called" );
}
 
public override string ToString()
{
throw new TclRuntimeError( "This shouldn't be called" );
}
 
public long CObjectPtr;
public void decrRefCount()
{
}
public void incrRefCount()
{
}
} // end CObject
}
/trunk/TCL/src/base/CallFrame.cs
@@ -0,0 +1,409 @@
/*
* CallFrame.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: CallFrame.java,v 1.10 2003/01/08 02:10:17 mdejong Exp $
*
*/
using System.Collections;
using System.Text;
 
namespace tcl.lang
{
 
/// <summary> This class implements a frame in the call stack.
///
/// This class can be overridden to define new variable scoping rules for
/// the Tcl interpreter.
/// </summary>
 
public class CallFrame
{
internal ArrayList VarNames
{
// FIXME : need to port Tcl 8.1 implementation here
 
 
get
{
ArrayList vector = new ArrayList( 10 );
 
if ( varTable == null )
{
return vector;
}
 
for ( IEnumerator e1 = varTable.Values.GetEnumerator(); e1.MoveNext(); )
{
Var v = (Var)e1.Current;
if ( !v.isVarUndefined() )
{
vector.Add( v.hashKey );
}
}
return vector;
}
 
}
/// <returns> an Vector the names of the (defined) local variables
/// in this CallFrame (excluding upvar's)
/// </returns>
internal ArrayList LocalVarNames
{
 
 
get
{
ArrayList vector = new ArrayList( 10 );
 
if ( varTable == null )
{
return vector;
}
 
for ( IEnumerator e1 = varTable.Values.GetEnumerator(); e1.MoveNext(); )
{
Var v = (Var)e1.Current;
if ( !v.isVarUndefined() && !v.isVarLink() )
{
vector.Add( v.hashKey );
}
}
return vector;
}
 
}
/// <summary> The interpreter associated with this call frame.</summary>
 
protected internal Interp interp;
 
 
/// <summary> The Namespace this CallFrame is executing in.
/// Used to resolve commands and global variables.
/// </summary>
 
internal NamespaceCmd.Namespace ns;
 
/// <summary> If true, the frame was pushed to execute a Tcl procedure
/// and may have local vars. If false, the frame was pushed to execute
/// a namespace command and var references are treated as references
/// to namespace vars; varTable is ignored.
/// </summary>
 
internal bool isProcCallFrame;
 
/// <summary> Stores the arguments of the procedure associated with this CallFrame.
/// Is null for global level.
/// </summary>
 
internal TclObject[] objv;
 
/// <summary> Value of interp.frame when this procedure was invoked
/// (i.e. next in stack of all active procedures).
/// </summary>
 
protected internal CallFrame caller;
 
/// <summary> Value of interp.varFrame when this procedure was invoked
/// (i.e. determines variable scoping within caller; same as
/// caller unless an "uplevel" command or something equivalent
/// was active in the caller).
/// </summary>
 
protected internal CallFrame callerVar;
 
/// <summary> Level of recursion. = 0 for the global level.</summary>
 
protected internal int level;
 
/// <summary> Stores the variables of this CallFrame.</summary>
 
protected internal Hashtable varTable;
 
 
/// <summary> Creates a CallFrame for the global variables.</summary>
/// <param name="interp">current interpreter.
/// </param>
 
internal CallFrame( Interp i )
{
interp = i;
ns = i.globalNs;
varTable = new Hashtable();
caller = null;
callerVar = null;
objv = null;
level = 0;
isProcCallFrame = true;
}
 
/// <summary> Creates a CallFrame. It changes the following variables:
///
/// <ul>
/// <li> this.caller
/// <li> this.callerVar
/// <li> interp.frame
/// <li> interp.varFrame
/// </ul>
/// </summary>
/// <param name="i">current interpreter.
/// </param>
/// <param name="proc">the procedure to invoke in this call frame.
/// </param>
/// <param name="objv">the arguments to the procedure.
/// </param>
/// <exception cref=""> TclException if error occurs in parameter bindings.
/// </exception>
internal CallFrame( Interp i, Procedure proc, TclObject[] objv )
: this( i )
{
 
try
{
chain( proc, objv );
}
catch ( TclException e )
{
dispose();
throw;
}
}
 
/// <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 );
}
}
}
 
private string wrongNumProcArgs( TclObject name, Procedure proc )
{
int i;
StringBuilder sbuf = new 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() );
}
 
/// <param name="name">the name of the variable.
///
/// </param>
/// <returns> true if a variable exists and is defined inside this
/// CallFrame, false otherwise
/// </returns>
 
internal static bool exists( Interp interp, string name )
{
try
{
Var[] result = Var.lookupVar( interp, name, null, 0, "lookup", false, false );
if ( result == null )
{
return false;
}
if ( result[0].isVarUndefined() )
{
return false;
}
return true;
}
catch ( TclException e )
{
throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
}
}
 
/// <returns> an Vector the names of the (defined) variables
/// in this CallFrame.
/// </returns>
 
/// <summary> Tcl_GetFrame -> getFrame
///
/// Given a description of a procedure frame, such as the first
/// argument to an "uplevel" or "upvar" command, locate the
/// call frame for the appropriate level of procedure.
///
/// The return value is 1 if string was either a number or a number
/// preceded by "#" and it specified a valid frame. 0 is returned
/// if string isn't one of the two things above (in this case,
/// the lookup acts as if string were "1"). The frameArr[0] reference
/// will be filled by the reference of the desired frame (unless an
/// error occurs, in which case it isn't modified).
///
/// </summary>
/// <param name="string">a string that specifies the level.
/// </param>
/// <exception cref=""> TclException if s is a valid level specifier but
/// refers to a bad level that doesn't exist.
/// </exception>
 
internal static int getFrame( Interp interp, string inString, CallFrame[] frameArr )
{
int curLevel, level, result;
CallFrame frame;
 
// Parse string to figure out which level number to go to.
 
result = 1;
curLevel = ( interp.varFrame == null ) ? 0 : interp.varFrame.level;
 
if ( ( inString.Length > 0 ) && ( inString[0] == '#' ) )
{
level = Util.getInt( interp, inString.Substring( 1 ) );
if ( level < 0 )
{
throw new TclException( interp, "bad level \"" + inString + "\"" );
}
}
else if ( ( inString.Length > 0 ) && System.Char.IsDigit( inString[0] ) )
{
level = Util.getInt( interp, inString );
level = curLevel - level;
}
else
{
level = curLevel - 1;
result = 0;
}
 
// FIXME: is this a bad comment from some other proc?
// Figure out which frame to use, and modify the interpreter so
// its variables come from that frame.
 
if ( level == 0 )
{
frame = null;
}
else
{
for ( frame = interp.varFrame; frame != null; frame = frame.callerVar )
{
if ( frame.level == level )
{
break;
}
}
if ( frame == null )
{
throw new TclException( interp, "bad level \"" + inString + "\"" );
}
}
frameArr[0] = frame;
return result;
}
 
 
/// <summary> This method is called when this CallFrame is no longer needed.
/// Removes the reference of this object from the interpreter so
/// that this object can be garbage collected.
/// <p>
/// For this procedure to work correctly, it must not be possible
/// for any of the variable in the table to be accessed from Tcl
/// commands (e.g. from trace procedures).
/// </summary>
 
protected internal void dispose()
{
// Unchain this frame from the call stack.
 
interp.frame = caller;
interp.varFrame = callerVar;
caller = null;
callerVar = null;
 
if ( varTable != null )
{
Var.deleteVars( interp, varTable );
varTable.Clear();
varTable = null;
}
}
}
}
/trunk/TCL/src/base/CharPointer.cs
@@ -0,0 +1,67 @@
/*
* CharPointer.java --
*
* Used in the Parser, this class implements the functionality
* of a C character pointer. CharPointers referencing the same
* script share a reference to one array, while maintaining there
* own current index into the array.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: CharPointer.java,v 1.4 1999/08/05 03:33:44 mo Exp $
*/
using System;
 
namespace tcl.lang
{
public class CharPointer
{
 
// A string of characters.
 
public char[] array;
 
// The current index into the array.
 
public int index;
internal CharPointer()
{
this.array = null;
this.index = -1;
}
internal CharPointer( CharPointer c )
{
this.array = c.array;
this.index = c.index;
}
public CharPointer( string str )
{
int len = str.Length;
this.array = new char[len + 1];
SupportClass.GetCharsFromString( str, 0, len, ref this.array, 0 );
this.array[len] = '\x0000';
this.index = 0;
}
internal char charAt()
{
return ( array[index] );
}
internal char charAt( int x )
{
return ( array[index + x] );
}
public int length()
{
return ( array.Length - 1 );
}
public override string ToString()
{
return new string( array, 0, array.Length - 1 );
}
} // end CharPointer
}
/trunk/TCL/src/base/Command.cs
@@ -0,0 +1,29 @@
/*
* Command.java
*
* Interface for Commands that can be added to the Tcl Interpreter.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: Command.java,v 1.3 1999/08/05 03:43:27 mo Exp $
*/
using System;
namespace tcl.lang
{
 
/// <summary> The Command interface specifies the method that a new Tcl command
/// must implement. See the createCommand method of the Interp class
/// to see how to add a new command to an interperter.
/// </summary>
 
public interface Command
{
TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv ); // Tcl exceptions are thown for Tcl errors.
}
}
/trunk/TCL/src/base/CommandWithDispose.cs
@@ -0,0 +1,35 @@
/*
* CommandWithDispose.java --
*
* Interface for Commands that need to know when they are deleted
* from an interpreter.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: CommandWithDispose.java,v 1.2 1999/07/28 03:41:13 mo Exp $
*/
using System;
namespace tcl.lang
{
 
/// <summary> This interface is implemented by Commands that need to know when
/// they are deleted from an interpreter. Most commands do not need
/// to know when they are deleted in Java because Java will garbage
/// collect any allocations made by the command. However, sometimes
/// a command may hold onto resources that must be explicitly released.
/// This interface allows those commands to be notified when they are
/// being deleted from the interpreter.
/// </summary>
 
public interface CommandWithDispose : Command
{
void disposeCmd(); // The disposeCmd method is called when the
// interp is removing the Tcl command.
}
}
/trunk/TCL/src/base/DebugInfo.cs
@@ -0,0 +1,52 @@
#undef DEBUG
/*
* DebugInfo.java --
*
* This class stores debug information for the interpreter.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: DebugInfo.java,v 1.1.1.1 1998/10/14 21:09:18 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class stores debug information for the interpreter.
*/
 
public class DebugInfo
{
 
/*
* The name of the source file that contains code for a given debug
* stack level. May be null for an unknown source file (if the debug
* stack is activated by an "eval" command or if the Interp is running
* in non-debugging mode.)
*/
 
internal string fileName;
 
/*
* The beginning line of the current command under execution.
* 1 means the first line inside a file. 0 means the line number is
* unknown.
*/
 
internal int cmdLine;
 
internal DebugInfo( string fname, int line )
{
fileName = fname;
cmdLine = line;
}
} // end DebugInfo
}
/trunk/TCL/src/base/Env.cs
@@ -0,0 +1,99 @@
#undef DEBUG
/*
* Env.java --
*
* This class is used to create and manage the environment array
* used by the Tcl interpreter.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: Env.java,v 1.2 1999/08/07 05:46:26 mo Exp $
*/
using System;
using System.Collections;
 
namespace tcl.lang
{
 
/// <summary> This class manages the environment array for Tcl interpreters.</summary>
 
class Env
{
 
/*
*----------------------------------------------------------------------
*
* initialize --
*
* This method is called to initialize an interpreter with it's
* initial values for the env array.
*
* Results:
* None.
*
* Side effects:
* The env array in the interpreter is created and populated.
*
*----------------------------------------------------------------------
*/
 
internal static void initialize( Interp interp )
{
// For a few standrad environment vairables that Tcl users
// often assume aways exist (even if they shouldn't), we will
// try to create those expected variables with the common unix
// names.
 
try
{
interp.setVar( "env", "HOME", System.Environment.CurrentDirectory, TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
// Ignore errors.
}
 
try
{
interp.setVar( "env", "USER", System.Environment.UserName, TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
// Ignore errors.
}
 
// Now we will populate the rest of the env array with the
// properties recieved from the System classes. This makes for
// a nice shortcut for getting to these useful values.
 
try
{
 
 
for ( IDictionaryEnumerator search = System.Environment.GetEnvironmentVariables().GetEnumerator(); search.MoveNext(); )
{
interp.setVar( "env", search.Key.ToString(), search.Value.ToString(), TCL.VarFlag.GLOBAL_ONLY );
}
}
catch ( System.Security.SecurityException e2 )
{
// We are inside a browser and we can't access the list of
// property names. That's fine. Life goes on ....
}
catch ( System.Exception e3 )
{
// We are inside a browser and we can't access the list of
// property names. That's fine. Life goes on ....
 
System.Diagnostics.Debug.WriteLine( "Exception while initializing env array" );
System.Diagnostics.Debug.WriteLine( e3 );
System.Diagnostics.Debug.WriteLine( "" );
}
}
} // end Env
}
/trunk/TCL/src/base/EventDeleter.cs
@@ -0,0 +1,55 @@
/*
* EventDeleter.java --
*
* Interface for deleting events in the notifier's event queue.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: EventDeleter.java,v 1.1.1.1 1998/10/14 21:09:14 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This is the interface for deleting events in the notifier's event
* queue. It's used together with the Notifier.deleteEvents() method.
*
*/
 
public interface EventDeleter
{
 
/*
*----------------------------------------------------------------------
*
* deleteEvent --
*
* This method is called once for each event in the event
* queue. It returns 1 for all events that should be deleted and
* 0 for events that should remain in the queue.
*
* If this method determines that an event should be removed, it
* should perform appropriate clean up on the event object.
*
* Results:
* 1 means evt should be removed from the event queue. 0
* otherwise.
*
* Side effects:
* After this method returns 1, the event will be removed from the
* event queue and will not be processed.
*
*----------------------------------------------------------------------
*/
 
int deleteEvent( TclEvent evt ); // Check whether this event should be removed.
} // end EventDeleter
}
/trunk/TCL/src/base/EventuallyFreed.cs
@@ -0,0 +1,77 @@
/*
* EventuallyFreed.java --
*
* This class makes sure that certain objects
* aren't disposed when there are nested procedures that
* depend on their existence.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
* Copyright (c) 2000 Christian Krone.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: EventuallyFreed.java,v 1.2 2001/06/03 21:19:46 mdejong Exp $
*/
using System;
namespace tcl.lang
{
 
public abstract class EventuallyFreed
{
 
// Number of preserve() calls in effect for this object.
 
internal int refCount = 0;
 
// True means dispose() was called while a preserve()
// call was in effect, so the object must be disposed
// when refCount becomes zero.
 
internal bool mustFree = false;
 
// Procedure to call to dispose.
 
public abstract void eventuallyDispose();
internal void preserve()
{
// Just increment its reference count.
 
refCount++;
}
internal void release()
{
refCount--;
if ( refCount == 0 )
{
 
if ( mustFree )
{
dispose();
}
}
}
public void dispose()
{
// See if there is a reference for this pointer. If so, set its
// "mustFree" flag (the flag had better not be set already!).
 
if ( refCount >= 1 )
{
if ( mustFree )
{
throw new TclRuntimeError( "eventuallyDispose() called twice" );
}
mustFree = true;
return;
}
 
// No reference for this block. Free it now.
 
eventuallyDispose();
}
} // end EventuallyFreed
}
/trunk/TCL/src/base/ExprValue.cs
@@ -0,0 +1,68 @@
/*
* ExprValue.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ExprValue.java,v 1.2 1999/05/09 00:03:00 dejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> Describes an expression value, which can be either an integer (the
/// usual case), a double-precision floating-point value, or a string.
/// A given number has only one value at a time.
/// </summary>
 
class ExprValue
{
internal const int ERROR = 0;
internal const int INT = 1;
internal const int DOUBLE = 2;
internal const int STRING = 3;
 
/// <summary> Integer value, if any.</summary>
internal long intValue;
 
/// <summary> Floating-point value, if any.</summary>
internal double doubleValue;
 
/// <summary> Used to hold a string value, if any.</summary>
internal string stringValue;
 
/// <summary> Type of value: INT, DOUBLE, or STRING.</summary>
internal int type;
 
/// <summary> Constructors.</summary>
internal ExprValue()
{
type = ERROR;
}
 
internal ExprValue( long i )
{
intValue = i;
type = INT;
}
 
internal ExprValue( double d )
{
doubleValue = d;
type = DOUBLE;
}
 
internal ExprValue( string s )
{
stringValue = s;
type = STRING;
}
}
}
/trunk/TCL/src/base/Expression.cs
@@ -0,0 +1,2272 @@
/*
* Expression.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: Expression.java,v 1.10 2003/02/04 00:35:41 mdejong Exp $
*
*/
using System;
using System.Collections;
 
namespace tcl.lang
{
 
/// <summary> This class handles Tcl expressions.</summary>
class Expression
{
 
// The token types are defined below. In addition, there is a
// table associating a precedence with each operator. The order
// of types is important. Consult the code before changing it.
 
internal const int VALUE = 0;
internal const int OPEN_PAREN = 1;
internal const int CLOSE_PAREN = 2;
internal const int COMMA = 3;
internal const int END = 4;
internal const int UNKNOWN = 5;
 
// Binary operators:
 
internal const int MULT = 8;
internal const int DIVIDE = 9;
internal const int MOD = 10;
internal const int PLUS = 11;
internal const int MINUS = 12;
internal const int LEFT_SHIFT = 13;
internal const int RIGHT_SHIFT = 14;
internal const int LESS = 15;
internal const int GREATER = 16;
internal const int LEQ = 17;
internal const int GEQ = 18;
internal const int EQUAL = 19;
internal const int NEQ = 20;
internal const int BIT_AND = 21;
internal const int BIT_XOR = 22;
internal const int BIT_OR = 23;
internal const int AND = 24;
internal const int OR = 25;
internal const int QUESTY = 26;
internal const int COLON = 27;
 
// Unary operators:
 
internal const int UNARY_MINUS = 28;
internal const int UNARY_PLUS = 29;
internal const int NOT = 30;
internal const int BIT_NOT = 31;
internal const int EQ = 32;
internal const int NE = 33;
 
// Precedence table. The values for non-operator token types are ignored.
 
internal static int[] precTable = new int[] { 0, 0, 0, 0, 0, 0, 0, 0, 12, 12, 12, 11, 11, 10, 10, 9, 9, 9, 9, 8, 8, 7, 6, 5, 4, 3, 2, 1, 13, 13, 13, 13 };
 
// Mapping from operator numbers to strings; used for error messages.
 
internal static string[] operatorStrings = new string[] { "VALUE", "(", ")", ",", "END", "UNKNOWN", "6", "7", "*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=", ">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":", "-", "+", "!", "~", "eq", "ne" };
 
internal Hashtable mathFuncTable;
 
/// <summary> The entire expression, as originally passed to eval et al.</summary>
private string m_expr;
 
/// <summary> Length of the expression.</summary>
private int m_len;
 
/// <summary> Type of the last token to be parsed from the expression.
/// Corresponds to the characters just before expr.
/// </summary>
internal int m_token;
 
/// <summary> Position to the next character to be scanned from the expression
/// string.
/// </summary>
private int m_ind;
 
/// <summary> Evaluate a Tcl expression.
///
/// </summary>
/// <param name="interp">the context in which to evaluate the expression.
/// </param>
/// <param name="string">expression to evaluate.
/// </param>
/// <returns> the value of the expression.
/// </returns>
/// <exception cref=""> TclException for malformed expressions.
/// </exception>
 
internal TclObject eval( Interp interp, string inString )
{
ExprValue value = ExprTopLevel( interp, inString );
switch ( value.type )
{
 
case ExprValue.INT:
return TclInteger.newInstance( (int)value.intValue );
 
case ExprValue.DOUBLE:
return TclDouble.newInstance( value.doubleValue );
 
case ExprValue.STRING:
return TclString.newInstance( value.stringValue );
 
default:
throw new TclRuntimeError( "internal error: expression, unknown" );
 
}
}
 
/// <summary> Evaluate an Tcl expression.</summary>
/// <param name="interp">the context in which to evaluate the expression.
/// </param>
/// <param name="string">expression to evaluate.
/// </param>
/// <exception cref=""> TclException for malformed expressions.
/// </exception>
/// <returns> the value of the expression in boolean.
/// </returns>
internal bool evalBoolean( Interp interp, string inString )
{
ExprValue value = ExprTopLevel( interp, inString );
switch ( value.type )
{
 
case ExprValue.INT:
return ( value.intValue != 0 );
 
case ExprValue.DOUBLE:
return ( value.doubleValue != 0.0 );
 
case ExprValue.STRING:
return Util.getBoolean( interp, value.stringValue );
 
default:
throw new TclRuntimeError( "internal error: expression, unknown" );
 
}
}
 
/// <summary> Constructor.</summary>
internal Expression()
{
mathFuncTable = new Hashtable();
 
// rand -- needs testing
// srand -- needs testing
// hypot -- needs testing
// fmod -- needs testing
// try [expr fmod(4.67, 2.2)]
// the answer should be .27, but I got .2699999999999996
 
SupportClass.PutElement( mathFuncTable, "atan2", new Atan2Function() );
SupportClass.PutElement( mathFuncTable, "pow", new PowFunction() );
SupportClass.PutElement( mathFuncTable, "acos", new AcosFunction() );
SupportClass.PutElement( mathFuncTable, "asin", new AsinFunction() );
SupportClass.PutElement( mathFuncTable, "atan", new AtanFunction() );
SupportClass.PutElement( mathFuncTable, "ceil", new CeilFunction() );
SupportClass.PutElement( mathFuncTable, "cos", new CosFunction() );
SupportClass.PutElement( mathFuncTable, "cosh", new CoshFunction() );
SupportClass.PutElement( mathFuncTable, "exp", new ExpFunction() );
SupportClass.PutElement( mathFuncTable, "floor", new FloorFunction() );
SupportClass.PutElement( mathFuncTable, "fmod", new FmodFunction() );
SupportClass.PutElement( mathFuncTable, "hypot", new HypotFunction() );
SupportClass.PutElement( mathFuncTable, "log", new LogFunction() );
SupportClass.PutElement( mathFuncTable, "log10", new Log10Function() );
SupportClass.PutElement( mathFuncTable, "rand", new RandFunction() );
SupportClass.PutElement( mathFuncTable, "sin", new SinFunction() );
SupportClass.PutElement( mathFuncTable, "sinh", new SinhFunction() );
SupportClass.PutElement( mathFuncTable, "sqrt", new SqrtFunction() );
SupportClass.PutElement( mathFuncTable, "srand", new SrandFunction() );
SupportClass.PutElement( mathFuncTable, "tan", new TanFunction() );
SupportClass.PutElement( mathFuncTable, "tanh", new TanhFunction() );
 
SupportClass.PutElement( mathFuncTable, "abs", new AbsFunction() );
SupportClass.PutElement( mathFuncTable, "double", new DoubleFunction() );
SupportClass.PutElement( mathFuncTable, "int", new IntFunction() );
SupportClass.PutElement( mathFuncTable, "round", new RoundFunction() );
SupportClass.PutElement( mathFuncTable, "wide", new WideFunction() );
 
m_expr = null;
m_ind = 0;
m_len = 0;
m_token = UNKNOWN;
}
 
/// <summary> Provides top-level functionality shared by procedures like ExprInt,
/// ExprDouble, etc.
/// </summary>
/// <param name="interp">the context in which to evaluate the expression.
/// </param>
/// <param name="string">the expression.
/// </param>
/// <exception cref=""> TclException for malformed expressions.
/// </exception>
/// <returns> the value of the expression.
/// </returns>
private ExprValue ExprTopLevel( Interp interp, string inString )
{
 
// Saved the state variables so that recursive calls to expr
// can work:
// expr {[expr 1+2] + 3}
 
string m_expr_saved = m_expr;
int m_len_saved = m_len;
int m_token_saved = m_token;
int m_ind_saved = m_ind;
 
try
{
m_expr = inString;
m_ind = 0;
m_len = inString.Length;
m_token = UNKNOWN;
 
ExprValue val = ExprGetValue( interp, -1 );
if ( m_token != END )
{
SyntaxError( interp );
}
return val;
}
finally
{
m_expr = m_expr_saved;
m_len = m_len_saved;
m_token = m_token_saved;
m_ind = m_ind_saved;
}
}
 
internal static void IllegalType( Interp interp, int badType, int Operator )
{
throw new TclException( interp, "can't use " + ( ( badType == ExprValue.DOUBLE ) ? "floating-point value" : "non-numeric string" ) + " as operand of \"" + operatorStrings[Operator] + "\"" );
}
 
internal void SyntaxError( Interp interp )
{
throw new TclException( interp, "syntax error in expression \"" + m_expr + "\"" );
}
 
internal static void DivideByZero( Interp interp )
{
interp.setErrorCode( TclString.newInstance( "ARITH DIVZERO {divide by zero}" ) );
throw new TclException( interp, "divide by zero" );
}
 
internal static void IntegerTooLarge( Interp interp )
{
interp.setErrorCode( TclString.newInstance( "ARITH IOVERFLOW {integer value too large to represent}" ) );
throw new TclException( interp, "integer value too large to represent" );
}
 
internal static void WideTooLarge( Interp interp )
{
interp.setErrorCode( TclString.newInstance( "ARITH IOVERFLOW {wide value too large to represent}" ) );
throw new TclException( interp, "wide value too large to represent" );
}
 
internal static void DoubleTooLarge( Interp interp )
{
interp.setErrorCode( TclString.newInstance( "ARITH OVERFLOW {floating-point value too large to represent}" ) );
throw new TclException( interp, "floating-point value too large to represent" );
}
 
internal static void DoubleTooSmall( Interp interp )
{
interp.setErrorCode( TclString.newInstance( "ARITH UNDERFLOW {floating-point value too small to represent}" ) );
throw new TclException( interp, "floating-point value too small to represent" );
}
 
internal static void DomainError( Interp interp )
{
interp.setErrorCode( TclString.newInstance( "ARITH DOMAIN {domain error: argument not in valid range}" ) );
throw new TclException( interp, "domain error: argument not in valid range" );
}
 
/// <summary> Given a string (such as one coming from command or variable
/// substitution), make a Value based on the string. The value
/// be a floating-point or integer, if possible, or else it
/// just be a copy of the string.
///
/// </summary>
/// <param name="interp">the context in which to evaluate the expression.
/// </param>
/// <param name="s">the string to parse.
/// </param>
/// <exception cref=""> TclException for malformed expressions.
/// </exception>
/// <returns> the value of the expression.
/// </returns>
 
private ExprValue ExprParseString( Interp interp, string s )
{
 
int len = s.Length;
 
/*
System.out.println("now to ExprParseString ->" + s +
"<- of length " + len);*/
 
// Take shortcut when string is of length 0, as there is
// only a string rep for an empty string (no int or double rep)
// this will happend a lot so this shortcut will speed things up!
 
if ( len == 0 )
{
return new ExprValue( s );
}
 
// The strings "0" and "1" are going to occure a lot
// it might be wise to include shortcuts for these cases
 
 
int i;
if ( looksLikeInt( s, len, 0 ) )
{
//System.out.println("string looks like an int");
 
// Note: use strtoul instead of strtol for integer conversions
// to allow full-size unsigned numbers, but don't depend on
// strtoul to handle sign characters; it won't in some
// implementations.
 
for ( i = 0; System.Char.IsWhiteSpace( s[i] ); i++ )
{
// Empty loop body.
}
 
StrtoulResult res;
if ( s[i] == '-' )
{
i++;
res = Util.strtoul( s, i, 0 );
res.value = -res.value;
}
else if ( s[i] == '+' )
{
i++;
res = Util.strtoul( s, i, 0 );
}
else
{
res = Util.strtoul( s, i, 0 );
}
 
if ( res.errno == 0 )
{
// We treat this string as a number if all the charcters
// following the parsed number are a whitespace char
// E.g.: " 1", "1", "1 ", and " 1 " are all good numbers
 
bool trailing_blanks = true;
 
for ( i = res.index; i < len; i++ )
{
if ( !System.Char.IsWhiteSpace( s[i] ) )
{
trailing_blanks = false;
}
}
 
if ( trailing_blanks )
{
//System.out.println("string is an Integer of value " + res.value);
m_token = VALUE;
return new ExprValue( res.value );
}
}
else if ( res.errno == TCL.INTEGER_RANGE )
{
IntegerTooLarge( interp );
}
 
 
/*
if (res.index == len) {
// We treat this string as a number only if the number
// ends at the end of the string. E.g.: " 1", "1" are
// good numbers but "1 " is not.
if (res.errno == TCL.INTEGER_RANGE) {
IntegerTooLarge(interp);
} else {
m_token = VALUE;
return new ExprValue(res.value);
}
}*/
}
else
{
//System.out.println("string does not look like an int, checking for Double");
 
StrtodResult res = Util.strtod( s, 0 );
 
if ( res.errno == 0 )
{
// Trailing whitespaces are treated just like the Integer case
 
bool trailing_blanks = true;
 
for ( i = res.index; i < len; i++ )
{
if ( !System.Char.IsWhiteSpace( s[i] ) )
{
trailing_blanks = false;
}
}
 
if ( trailing_blanks )
{
//System.out.println("string is a Double of value " + res.value);
m_token = VALUE;
return new ExprValue( res.value );
}
}
else if ( res.errno == TCL.DOUBLE_RANGE )
{
if ( res.value != 0 )
{
DoubleTooLarge( interp );
}
else
{
DoubleTooSmall( interp );
}
}
// if res.errno is any other value (like TCL.INVALID_DOUBLE)
// just fall through and use the string rep
 
 
/*
if (res.index == len) {
if (res.errno == 0) {
//System.out.println("string is a Double of value " + res.value);
m_token = VALUE;
return new ExprValue(res.value);
} else if (res.errno == TCL.DOUBLE_RANGE) {
DoubleTooLarge(interp);
}
}*/
}
 
//System.out.println("string is not a valid number, returning as string");
 
// Not a valid number. Save a string value (but don't do anything
// if it's already the value).
 
return new ExprValue( s );
}
 
/// <summary> Parse a "value" from the remainder of the expression.
///
/// </summary>
/// <param name="interp">the context in which to evaluate the expression.
/// </param>
/// <param name="prec">treat any un-parenthesized operator with precedence
/// <= this as the end of the expression.
/// </param>
/// <exception cref=""> TclException for malformed expressions.
/// </exception>
/// <returns> the value of the expression.
/// </returns>
private ExprValue ExprGetValue( Interp interp, int prec )
{
int Operator;
bool gotOp = false; // True means already lexed the
// operator (while picking up value
// for unary operator). Don't lex
// again.
ExprValue value, value2;
 
// There are two phases to this procedure. First, pick off an
// initial value. Then, parse (binary operator, value) pairs
// until done.
 
value = ExprLex( interp );
 
if ( m_token == OPEN_PAREN )
{
 
// Parenthesized sub-expression.
 
value = ExprGetValue( interp, -1 );
if ( m_token != CLOSE_PAREN )
{
SyntaxError( interp );
}
}
else
{
if ( m_token == MINUS )
{
m_token = UNARY_MINUS;
}
if ( m_token == PLUS )
{
m_token = UNARY_PLUS;
}
if ( m_token >= UNARY_MINUS )
{
 
// Process unary operators.
 
Operator = m_token;
value = ExprGetValue( interp, precTable[m_token] );
 
if ( interp.noEval == 0 )
{
switch ( Operator )
{
 
case UNARY_MINUS:
if ( value.type == ExprValue.INT )
{
value.intValue = -value.intValue;
}
else if ( value.type == ExprValue.DOUBLE )
{
value.doubleValue = -value.doubleValue;
}
else
{
IllegalType( interp, value.type, Operator );
}
break;
 
case UNARY_PLUS:
if ( ( value.type != ExprValue.INT ) && ( value.type != ExprValue.DOUBLE ) )
{
IllegalType( interp, value.type, Operator );
}
break;
 
case NOT:
if ( value.type == ExprValue.INT )
{
if ( value.intValue != 0 )
{
value.intValue = 0;
}
else
{
value.intValue = 1;
}
}
else if ( value.type == ExprValue.DOUBLE )
{
if ( value.doubleValue == 0.0 )
{
value.intValue = 1;
}
else
{
value.intValue = 0;
}
value.type = ExprValue.INT;
}
else
{
IllegalType( interp, value.type, Operator );
}
break;
 
case BIT_NOT:
if ( value.type == ExprValue.INT )
{
value.intValue = ~value.intValue;
}
else
{
IllegalType( interp, value.type, Operator );
}
break;
}
}
gotOp = true;
}
else if ( m_token == CLOSE_PAREN )
{
// Caller needs to deal with close paren token.
return null;
}
else if ( m_token != VALUE )
{
SyntaxError( interp );
}
}
if ( value == null )
{
SyntaxError( interp );
}
 
// Got the first operand. Now fetch (operator, operand) pairs.
 
if ( !gotOp )
{
value2 = ExprLex( interp );
}
 
while ( true )
{
Operator = m_token;
if ( ( Operator < MULT ) || ( Operator >= UNARY_MINUS ) )
{
if ( ( Operator == END ) || ( Operator == CLOSE_PAREN ) || ( Operator == COMMA ) )
{
return value; // Goto Done
}
else
{
SyntaxError( interp );
}
}
if ( precTable[Operator] <= prec )
{
return value; // (goto done)
}
 
// If we're doing an AND or OR and the first operand already
// determines the result, don't execute anything in the
// second operand: just parse. Same style for ?: pairs.
 
if ( ( Operator == AND ) || ( Operator == OR ) || ( Operator == QUESTY ) )
{
 
if ( value.type == ExprValue.DOUBLE )
{
value.intValue = ( value.doubleValue != 0 ) ? 1 : 0;
value.type = ExprValue.INT;
}
else if ( value.type == ExprValue.STRING )
{
try
{
bool b = Util.getBoolean( null, value.stringValue );
value = new ExprValue( b ? 1 : 0 );
}
catch ( TclException e )
{
if ( interp.noEval == 0 )
{
IllegalType( interp, ExprValue.STRING, Operator );
}
 
// Must set value.intValue to avoid referencing
// uninitialized memory in the "if" below; the actual
// value doesn't matter, since it will be ignored.
 
value.intValue = 0;
}
}
if ( ( ( Operator == AND ) && ( value.intValue == 0 ) ) || ( ( Operator == OR ) && ( value.intValue != 0 ) ) )
{
interp.noEval++;
try
{
value2 = ExprGetValue( interp, precTable[Operator] );
}
finally
{
interp.noEval--;
}
if ( Operator == OR )
{
value.intValue = 1;
}
continue;
}
else if ( Operator == QUESTY )
{
// Special note: ?: operators must associate right to
// left. To make this happen, use a precedence one lower
// than QUESTY when calling ExprGetValue recursively.
 
if ( value.intValue != 0 )
{
value = ExprGetValue( interp, precTable[QUESTY] - 1 );
if ( m_token != COLON )
{
SyntaxError( interp );
}
 
interp.noEval++;
try
{
value2 = ExprGetValue( interp, precTable[QUESTY] - 1 );
}
finally
{
interp.noEval--;
}
}
else
{
interp.noEval++;
try
{
value2 = ExprGetValue( interp, precTable[QUESTY] - 1 );
}
finally
{
interp.noEval--;
}
if ( m_token != COLON )
{
SyntaxError( interp );
}
value = ExprGetValue( interp, precTable[QUESTY] - 1 );
}
continue;
}
else
{
value2 = ExprGetValue( interp, precTable[Operator] );
}
}
else
{
value2 = ExprGetValue( interp, precTable[Operator] );
}
 
 
if ( ( m_token < MULT ) && ( m_token != VALUE ) && ( m_token != END ) && ( m_token != COMMA ) && ( m_token != CLOSE_PAREN ) )
{
SyntaxError( interp );
}
 
if ( interp.noEval != 0 )
{
continue;
}
 
// At this point we've got two values and an operator. Check
// to make sure that the particular data types are appropriate
// for the particular operator, and perform type conversion
// if necessary.
 
switch ( Operator )
{
 
 
// For the operators below, no strings are allowed and
// ints get converted to floats if necessary.
case MULT:
case DIVIDE:
case PLUS:
case MINUS:
if ( ( value.type == ExprValue.STRING ) || ( value2.type == ExprValue.STRING ) )
{
IllegalType( interp, ExprValue.STRING, Operator );
}
if ( value.type == ExprValue.DOUBLE )
{
if ( value2.type == ExprValue.INT )
{
value2.doubleValue = value2.intValue;
value2.type = ExprValue.DOUBLE;
}
}
else if ( value2.type == ExprValue.DOUBLE )
{
if ( value.type == ExprValue.INT )
{
value.doubleValue = value.intValue;
value.type = ExprValue.DOUBLE;
}
}
break;
 
// For the operators below, only integers are allowed.
 
 
case MOD:
case LEFT_SHIFT:
case RIGHT_SHIFT:
case BIT_AND:
case BIT_XOR:
case BIT_OR:
if ( value.type != ExprValue.INT )
{
IllegalType( interp, value.type, Operator );
}
else if ( value2.type != ExprValue.INT )
{
IllegalType( interp, value2.type, Operator );
}
break;
 
// For the operators below, any type is allowed but the
// two operands must have the same type. Convert integers
// to floats and either to strings, if necessary.
 
 
case LESS:
case GREATER:
case LEQ:
case GEQ:
case EQUAL:
case EQ:
case NEQ:
case NE:
if ( value.type == ExprValue.STRING )
{
if ( value2.type != ExprValue.STRING )
{
ExprMakeString( interp, value2 );
}
}
else if ( value2.type == ExprValue.STRING )
{
if ( value.type != ExprValue.STRING )
{
ExprMakeString( interp, value );
}
}
else if ( value.type == ExprValue.DOUBLE )
{
if ( value2.type == ExprValue.INT )
{
value2.doubleValue = value2.intValue;
value2.type = ExprValue.DOUBLE;
}
}
else if ( value2.type == ExprValue.DOUBLE )
{
if ( value.type == ExprValue.INT )
{
value.doubleValue = value.intValue;
value.type = ExprValue.DOUBLE;
}
}
break;
 
// For the operators below, no strings are allowed, but
// no int->double conversions are performed.
 
 
case AND:
case OR:
if ( value.type == ExprValue.STRING )
{
IllegalType( interp, value.type, Operator );
}
if ( value2.type == ExprValue.STRING )
{
try
{
bool b = Util.getBoolean( null, value2.stringValue );
value2 = new ExprValue( b ? 1 : 0 );
}
catch ( TclException e )
{
IllegalType( interp, value2.type, Operator );
}
}
break;
 
// For the operators below, type and conversions are
// irrelevant: they're handled elsewhere.
 
 
case QUESTY:
case COLON:
break;
 
// Any other operator is an error.
 
 
default:
throw new TclException( interp, "unknown operator in expression" );
 
}
 
// Carry out the function of the specified operator.
 
switch ( Operator )
{
 
case MULT:
if ( value.type == ExprValue.INT )
{
value.intValue = value.intValue * value2.intValue;
}
else
{
value.doubleValue *= value2.doubleValue;
}
break;
 
case DIVIDE:
case MOD:
if ( value.type == ExprValue.INT )
{
long divisor, quot, rem;
bool negative;
 
if ( value2.intValue == 0 )
{
DivideByZero( interp );
}
 
// The code below is tricky because C doesn't guarantee
// much about the properties of the quotient or
// remainder, but Tcl does: the remainder always has
// the same sign as the divisor and a smaller absolute
// value.
 
divisor = value2.intValue;
negative = false;
if ( divisor < 0 )
{
divisor = -divisor;
value.intValue = -value.intValue;
negative = true;
}
quot = value.intValue / divisor;
rem = value.intValue % divisor;
if ( rem < 0 )
{
rem += divisor;
quot -= 1;
}
if ( negative )
{
rem = -rem;
}
value.intValue = ( Operator == DIVIDE ) ? quot : rem;
}
else
{
if ( value2.doubleValue == 0.0 )
{
DivideByZero( interp );
}
value.doubleValue /= value2.doubleValue;
}
break;
 
case PLUS:
if ( value.type == ExprValue.INT )
{
value.intValue = value.intValue + value2.intValue;
}
else
{
value.doubleValue += value2.doubleValue;
}
break;
 
case MINUS:
if ( value.type == ExprValue.INT )
{
value.intValue = value.intValue - value2.intValue;
}
else
{
value.doubleValue -= value2.doubleValue;
}
break;
 
case LEFT_SHIFT:
value.intValue <<= (int)value2.intValue;
break;
 
case RIGHT_SHIFT:
 
if ( value.intValue < 0 )
{
value.intValue = ~( ( ~value.intValue ) >> (int)value2.intValue );
}
else
{
value.intValue >>= (int)value2.intValue;
}
break;
 
case LESS:
if ( value.type == ExprValue.INT )
{
value.intValue = ( value.intValue < value2.intValue ) ? 1 : 0;
}
else if ( value.type == ExprValue.DOUBLE )
{
value.intValue = ( value.doubleValue < value2.doubleValue ) ? 1 : 0;
}
else
{
value.intValue = ( value.stringValue.CompareTo( value2.stringValue ) < 0 ) ? 1 : 0;
}
value.type = ExprValue.INT;
break;
 
case GREATER:
if ( value.type == ExprValue.INT )
{
value.intValue = ( value.intValue > value2.intValue ) ? 1 : 0;
}
else if ( value.type == ExprValue.DOUBLE )
{
value.intValue = ( value.doubleValue > value2.doubleValue ) ? 1 : 0;
}
else
{
value.intValue = ( value.stringValue.CompareTo( value2.stringValue ) > 0 ) ? 1 : 0;
}
value.type = ExprValue.INT;
break;
 
case LEQ:
if ( value.type == ExprValue.INT )
{
value.intValue = ( value.intValue <= value2.intValue ) ? 1 : 0;
}
else if ( value.type == ExprValue.DOUBLE )
{
value.intValue = ( value.doubleValue <= value2.doubleValue ) ? 1 : 0;
}
else
{
value.intValue = ( value.stringValue.CompareTo( value2.stringValue ) <= 0 ) ? 1 : 0;
}
value.type = ExprValue.INT;
break;
 
case GEQ:
if ( value.type == ExprValue.INT )
{
value.intValue = ( value.intValue >= value2.intValue ) ? 1 : 0;
}
else if ( value.type == ExprValue.DOUBLE )
{
value.intValue = ( value.doubleValue >= value2.doubleValue ) ? 1 : 0;
}
else
{
value.intValue = ( value.stringValue.CompareTo( value2.stringValue ) >= 0 ) ? 1 : 0;
}
value.type = ExprValue.INT;
break;
 
case EQUAL:
case EQ:
if ( value.type == ExprValue.INT )
{
value.intValue = ( value.intValue == value2.intValue ) ? 1 : 0;
}
else if ( value.type == ExprValue.DOUBLE )
{
value.intValue = ( value.doubleValue == value2.doubleValue ) ? 1 : 0;
}
else
{
value.intValue = ( value.stringValue.CompareTo( value2.stringValue ) == 0 ) ? 1 : 0;
}
value.type = ExprValue.INT;
break;
 
case NEQ:
case NE:
if ( value.type == ExprValue.INT )
{
value.intValue = ( value.intValue != value2.intValue ) ? 1 : 0;
}
else if ( value.type == ExprValue.DOUBLE )
{
value.intValue = ( value.doubleValue != value2.doubleValue ) ? 1 : 0;
}
else
{
value.intValue = ( value.stringValue.CompareTo( value2.stringValue ) != 0 ) ? 1 : 0;
}
value.type = ExprValue.INT;
break;
 
case BIT_AND:
value.intValue &= value2.intValue;
break;
 
case BIT_XOR:
value.intValue ^= value2.intValue;
break;
 
case BIT_OR:
value.intValue |= value2.intValue;
break;
 
// For AND and OR, we know that the first value has already
// been converted to an integer. Thus we need only consider
// the possibility of int vs. double for the second value.
 
 
case AND:
if ( value2.type == ExprValue.DOUBLE )
{
value2.intValue = ( value2.doubleValue != 0 ) ? 1 : 0;
value2.type = ExprValue.INT;
}
value.intValue = ( ( value.intValue != 0 ) && ( value2.intValue != 0 ) ) ? 1 : 0;
break;
 
case OR:
if ( value2.type == ExprValue.DOUBLE )
{
value2.intValue = ( value2.doubleValue != 0 ) ? 1 : 0;
value2.type = ExprValue.INT;
}
value.intValue = ( ( value.intValue != 0 ) || ( value2.intValue != 0 ) ) ? 1 : 0;
break;
 
 
case COLON:
SyntaxError( interp );
break;
}
}
}
 
/// <summary> GetLexeme -> ExprLex
///
/// Lexical analyzer for expression parser: parses a single value,
/// operator, or other syntactic element from an expression string.
///
/// Size effects: the "m_token" member variable is set to the value of
/// the current token.
///
/// </summary>
/// <param name="interp">the context in which to evaluate the expression.
/// </param>
/// <exception cref=""> TclException for malformed expressions.
/// </exception>
/// <returns> the value of the expression.
/// </returns>
private ExprValue ExprLex( Interp interp )
{
char c, c2;
 
while ( m_ind < m_len && System.Char.IsWhiteSpace( m_expr[m_ind] ) )
{
m_ind++;
}
if ( m_ind >= m_len )
{
m_token = END;
return null;
}
 
// First try to parse the token as an integer or
// floating-point number. Don't want to check for a number if
// the first character is "+" or "-". If we do, we might
// treat a binary operator as unary by
// mistake, which will eventually cause a syntax error.
 
c = m_expr[m_ind];
if ( m_ind < m_len - 1 )
{
c2 = m_expr[m_ind + 1];
}
else
{
c2 = '\x0000';
}
 
if ( ( c != '+' ) && ( c != '-' ) )
{
bool startsWithDigit = System.Char.IsDigit( c );
if ( startsWithDigit && looksLikeInt( m_expr, m_len, m_ind ) )
{
StrtoulResult res = Util.strtoul( m_expr, m_ind, 0 );
 
if ( res.errno == 0 )
{
m_ind = res.index;
m_token = VALUE;
return new ExprValue( res.value );
}
else
{
if ( res.errno == TCL.INTEGER_RANGE )
{
IntegerTooLarge( interp );
}
}
}
else if ( startsWithDigit || ( c == '.' ) || ( c == 'n' ) || ( c == 'N' ) )
{
StrtodResult res = Util.strtod( m_expr, m_ind );
if ( res.errno == 0 )
{
m_ind = res.index;
m_token = VALUE;
return new ExprValue( res.value );
}
else
{
if ( res.errno == TCL.DOUBLE_RANGE )
{
if ( res.value != 0 )
{
DoubleTooLarge( interp );
}
else
{
DoubleTooSmall( interp );
}
}
}
}
}
 
ParseResult pres;
ExprValue retval;
m_ind += 1; // ind is advanced to point to the next token
 
switch ( c )
{
 
case '$':
m_token = VALUE;
pres = ParseAdaptor.parseVar( interp, m_expr, m_ind, m_len );
m_ind = pres.nextIndex;
 
if ( interp.noEval != 0 )
{
retval = new ExprValue( 0 );
}
else
{
 
retval = ExprParseString( interp, pres.value.ToString() );
}
pres.release();
return retval;
 
case '[':
m_token = VALUE;
pres = ParseAdaptor.parseNestedCmd( interp, m_expr, m_ind, m_len );
m_ind = pres.nextIndex;
 
if ( interp.noEval != 0 )
{
retval = new ExprValue( 0 );
}
else
{
 
retval = ExprParseString( interp, pres.value.ToString() );
}
pres.release();
return retval;
 
case '"':
m_token = VALUE;
 
 
//System.out.println("now to parse from ->" + m_expr + "<- at index "
// + m_ind);
 
pres = ParseAdaptor.parseQuotes( interp, m_expr, m_ind, m_len );
m_ind = pres.nextIndex;
 
// System.out.println("after parse next index is " + m_ind);
 
if ( interp.noEval != 0 )
{
// System.out.println("returning noEval zero value");
retval = new ExprValue( 0 );
}
else
{
// System.out.println("returning value string ->" + pres.value.toString() + "<-" );
 
retval = ExprParseString( interp, pres.value.ToString() );
}
pres.release();
return retval;
 
case '{':
m_token = VALUE;
pres = ParseAdaptor.parseBraces( interp, m_expr, m_ind, m_len );
m_ind = pres.nextIndex;
if ( interp.noEval != 0 )
{
retval = new ExprValue( 0 );
}
else
{
 
retval = ExprParseString( interp, pres.value.ToString() );
}
pres.release();
return retval;
 
case '(':
m_token = OPEN_PAREN;
return null;
 
 
case ')':
m_token = CLOSE_PAREN;
return null;
 
 
case ',':
m_token = COMMA;
return null;
 
 
case '*':
m_token = MULT;
return null;
 
 
case '/':
m_token = DIVIDE;
return null;
 
 
case '%':
m_token = MOD;
return null;
 
 
case '+':
m_token = PLUS;
return null;
 
 
case '-':
m_token = MINUS;
return null;
 
 
case '?':
m_token = QUESTY;
return null;
 
 
case ':':
m_token = COLON;
return null;
 
 
case '<':
switch ( c2 )
{
 
case '<':
m_ind += 1;
m_token = LEFT_SHIFT;
break;
 
case '=':
m_ind += 1;
m_token = LEQ;
break;
 
default:
m_token = LESS;
break;
 
}
return null;
 
 
case '>':
switch ( c2 )
{
 
case '>':
m_ind += 1;
m_token = RIGHT_SHIFT;
break;
 
case '=':
m_ind += 1;
m_token = GEQ;
break;
 
default:
m_token = GREATER;
break;
 
}
return null;
 
 
case '=':
if ( c2 == '=' )
{
m_ind += 1;
m_token = EQUAL;
}
else
{
m_token = UNKNOWN;
}
return null;
 
 
case 'e':
if ( c2 == 'q' )
{
m_ind += 1;
m_token = EQUAL;
}
else
{
m_token = UNKNOWN;
}
return null;
 
 
case 'n':
if ( c2 == 'e' )
{
m_ind += 1;
m_token = NEQ;
}
else
{
m_token = UNKNOWN;
}
return null;
 
 
case '!':
if ( c2 == '=' )
{
m_ind += 1;
m_token = NEQ;
}
else
{
m_token = NOT;
}
return null;
 
 
case '&':
if ( c2 == '&' )
{
m_ind += 1;
m_token = AND;
}
else
{
m_token = BIT_AND;
}
return null;
 
 
case '^':
m_token = BIT_XOR;
return null;
 
 
case '|':
if ( c2 == '|' )
{
m_ind += 1;
m_token = OR;
}
else
{
m_token = BIT_OR;
}
return null;
 
 
case '~':
m_token = BIT_NOT;
return null;
 
 
default:
if ( System.Char.IsLetter( c ) )
{
// Oops, re-adjust m_ind so that it points to the beginning
// of the function name.
 
m_ind--;
return mathFunction( interp );
}
m_token = UNKNOWN;
return null;
 
}
}
 
/// <summary> Parses a math function from an expression string, carry out the
/// function, and return the value computed.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <returns> the value computed by the math function.
/// </returns>
/// <exception cref=""> TclException if any error happens.
/// </exception>
internal ExprValue mathFunction( Interp interp )
{
int startIdx = m_ind;
ExprValue value;
string funcName;
MathFunction mathFunc;
TclObject[] argv = null;
int numArgs;
 
// Find the end of the math function's name and lookup the MathFunc
// record for the function. Search until the char at m_ind is not
// alphanumeric or '_'
 
for ( ; m_ind < m_len; m_ind++ )
{
if ( !( System.Char.IsLetterOrDigit( m_expr[m_ind] ) || m_expr[m_ind] == '_' ) )
{
break;
}
}
 
// Get the funcName BEFORE calling ExprLex, so the funcName
// will not have trailing whitespace.
 
funcName = m_expr.Substring( startIdx, ( m_ind ) - ( startIdx ) );
 
// Parse errors are thrown BEFORE unknown function names
 
ExprLex( interp );
if ( m_token != OPEN_PAREN )
{
SyntaxError( interp );
}
 
// Now test for unknown funcName. Doing the above statements
// out of order will cause some tests to fail.
 
mathFunc = (MathFunction)mathFuncTable[funcName];
if ( mathFunc == null )
{
throw new TclException( interp, "unknown math function \"" + funcName + "\"" );
}
 
// Scan off the arguments for the function, if there are any.
 
numArgs = mathFunc.argTypes.Length;
 
if ( numArgs == 0 )
{
ExprLex( interp );
if ( m_token != CLOSE_PAREN )
{
SyntaxError( interp );
}
}
else
{
argv = new TclObject[numArgs];
 
for ( int i = 0; ; i++ )
{
value = ExprGetValue( interp, -1 );
 
// Handle close paren with no value
// % expr {srand()}
 
if ( ( value == null ) && ( m_token == CLOSE_PAREN ) )
{
if ( i == numArgs )
break;
else
throw new TclException( interp, "too few arguments for math function" );
}
 
if ( value.type == ExprValue.STRING )
{
throw new TclException( interp, "argument to math function didn't have numeric value" );
}
 
// Copy the value to the argument record, converting it if
// necessary.
 
if ( value.type == ExprValue.INT )
{
if ( mathFunc.argTypes[i] == MathFunction.DOUBLE )
{
argv[i] = TclDouble.newInstance( (int)value.intValue );
}
else
{
argv[i] = TclLong.newInstance( value.intValue );
}
}
else
{
if ( mathFunc.argTypes[i] == MathFunction.INT )
{
 
argv[i] = TclInteger.newInstance( (int)value.doubleValue );
}
else
{
argv[i] = TclDouble.newInstance( value.doubleValue );
}
}
 
// Check for a comma separator between arguments or a
// close-paren to end the argument list.
 
if ( i == ( numArgs - 1 ) )
{
if ( m_token == CLOSE_PAREN )
{
break;
}
if ( m_token == COMMA )
{
throw new TclException( interp, "too many arguments for math function" );
}
else
{
SyntaxError( interp );
}
}
if ( m_token != COMMA )
{
if ( m_token == CLOSE_PAREN )
{
throw new TclException( interp, "too few arguments for math function" );
}
else
{
SyntaxError( interp );
}
}
}
}
 
m_token = VALUE;
if ( interp.noEval != 0 )
{
return new ExprValue( 0 );
}
else
{
/*
* Invoke the function and copy its result back into valuePtr.
*/
return mathFunc.apply( interp, argv );
}
}
 
/// <summary> This procedure decides whether the leading characters of a
/// string look like an integer or something else (such as a
/// floating-point number or string).
/// </summary>
/// <returns> a boolean value indicating if the string looks like an integer.
/// </returns>
 
internal static bool looksLikeInt( string s, int len, int i )
{
while ( i < len && System.Char.IsWhiteSpace( s[i] ) )
{
i++;
}
if ( i >= len )
{
return false;
}
char c = s[i];
if ( ( c == '+' ) || ( c == '-' ) )
{
i++;
if ( i >= len )
{
return false;
}
c = s[i];
}
if ( !System.Char.IsDigit( c ) )
{
return false;
}
while ( i < len && System.Char.IsDigit( s[i] ) )
{
//System.out.println("'" + s.charAt(i) + "' is a digit");
i++;
}
if ( i >= len )
{
return true;
}
 
//ported from C code
c = s[i];
if ( ( c != '.' ) && ( c != 'e' ) && ( c != 'E' ) )
{
return true;
}
 
//original
/*
if (i < len) {
c = s.charAt(i);
if ((c == '.') || (c == 'e') || (c == 'E')) {
return false;
}
}*/
 
return false;
}
 
/// <summary> Converts a value from int or double representation to a string.</summary>
/// <param name="interp">interpreter to use for precision information.
/// </param>
/// <param name="value">Value to be converted.
/// </param>
 
internal static void ExprMakeString( Interp interp, ExprValue value )
{
if ( value.type == ExprValue.INT )
{
value.stringValue = System.Convert.ToString( value.intValue );
}
else if ( value.type == ExprValue.DOUBLE )
{
value.stringValue = value.doubleValue.ToString();
}
value.type = ExprValue.STRING;
}
 
internal static void checkIntegerRange( Interp interp, double d )
{
if ( d < 0 )
{
 
if ( d < ( (double)TCL.INT_MIN ) )
{
Expression.IntegerTooLarge( interp );
}
}
else
{
 
if ( d > ( (double)TCL.INT_MAX ) )
{
Expression.IntegerTooLarge( interp );
}
}
}
internal static void checkWideRange( Interp interp, double d )
{
if ( d < 0 )
{
if ( d < Int64.MinValue )
{
Expression.WideTooLarge( interp );
}
}
else
{
if ( d > Int64.MaxValue )
{
Expression.WideTooLarge( interp );
}
}
}
 
internal static void checkDoubleRange( Interp interp, double d )
{
if ( ( d == System.Double.NaN ) || ( d == System.Double.NegativeInfinity ) || ( d == System.Double.PositiveInfinity ) )
{
Expression.DoubleTooLarge( interp );
}
}
}
 
abstract class MathFunction
{
internal const int INT = 0;
internal const int DOUBLE = 1;
internal const int EITHER = 2;
 
internal int[] argTypes;
 
internal abstract ExprValue apply( Interp interp, TclObject[] argv );
}
 
abstract class UnaryMathFunction : MathFunction
{
internal UnaryMathFunction()
{
argTypes = new int[1];
argTypes[0] = DOUBLE;
}
}
 
abstract class BinaryMathFunction : MathFunction
{
internal BinaryMathFunction()
{
argTypes = new int[2];
argTypes[0] = DOUBLE;
argTypes[1] = DOUBLE;
}
}
 
 
abstract class NoArgMathFunction : MathFunction
{
internal NoArgMathFunction()
{
argTypes = new int[0];
}
}
 
 
class Atan2Function : BinaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( System.Math.Atan2( TclDouble.get( interp, argv[0] ), TclDouble.get( interp, argv[1] ) ) );
}
}
 
class AbsFunction : MathFunction
{
internal AbsFunction()
{
argTypes = new int[1];
argTypes[0] = EITHER;
}
 
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
if ( argv[0].InternalRep is TclDouble )
{
double d = TclDouble.get( interp, argv[0] );
if ( d > 0 )
{
return new ExprValue( d );
}
else
{
return new ExprValue( -d );
}
}
else
{
int i = TclInteger.get( interp, argv[0] );
if ( i > 0 )
{
return new ExprValue( i );
}
else
{
return new ExprValue( -i );
}
}
}
}
 
class DoubleFunction : MathFunction
{
internal DoubleFunction()
{
argTypes = new int[1];
argTypes[0] = EITHER;
}
 
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( TclDouble.get( interp, argv[0] ) );
}
}
 
class IntFunction : MathFunction
{
internal IntFunction()
{
argTypes = new int[1];
argTypes[0] = EITHER;
}
 
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
double d = TclDouble.get( interp, argv[0] );
Expression.checkIntegerRange( interp, d );
return new ExprValue( (int)d );
}
}
 
class WideFunction : MathFunction
{
internal WideFunction()
{
argTypes = new int[1];
argTypes[0] = EITHER;
}
 
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
double d = TclDouble.get( interp, argv[0] );
Expression.checkWideRange( interp, d );
return new ExprValue( (long)d );
}
}
class RoundFunction :
MathFunction
{
internal RoundFunction()
{
argTypes = new int[1];
argTypes[0] = EITHER;
}
 
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
if ( argv[0].InternalRep is TclDouble )
{
double d = TclDouble.get( interp, argv[0] );
if ( d < 0 )
{
Expression.checkIntegerRange( interp, d - 0.5 );
 
return new ExprValue( (int)( d - 0.5 ) );
}
else
{
Expression.checkIntegerRange( interp, d + 0.5 );
 
return new ExprValue( (int)( d + 0.5 ) );
}
}
else
{
return new ExprValue( TclInteger.get( interp, argv[0] ) );
}
}
}
 
class PowFunction : BinaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
double d = System.Math.Pow( TclDouble.get( interp, argv[0] ), TclDouble.get( interp, argv[1] ) );
Expression.checkDoubleRange( interp, d );
return new ExprValue( d );
}
}
 
/*
* The following section is generated by this script.
*
set missing {fmod}
set byhand {atan2 pow}
foreach func {Acos Asin Atan Ceil Cos Exp Floor Log Sin
Sqrt Tan} {
puts "
class $func\Function extends UnaryMathFunction {
ExprValue apply(Interp interp, TclObject argv\[\])
throws TclException {
return new ExprValue(Math.[string tolower $func](TclDouble.get(interp, argv\[0\])));
}
}
"
}
*/
 
class AcosFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
double d = TclDouble.get( interp, argv[0] );
if ( ( d < -1 ) || ( d > 1 ) )
{
Expression.DomainError( interp );
}
return new ExprValue( System.Math.Acos( d ) );
}
}
 
class AsinFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( System.Math.Asin( TclDouble.get( interp, argv[0] ) ) );
}
}
 
class AtanFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( System.Math.Atan( TclDouble.get( interp, argv[0] ) ) );
}
}
 
 
class CeilFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( System.Math.Ceiling( TclDouble.get( interp, argv[0] ) ) );
}
}
 
 
class CosFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( System.Math.Cos( TclDouble.get( interp, argv[0] ) ) );
}
}
 
 
class CoshFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
double x = TclDouble.get( interp, argv[0] );
double d1 = System.Math.Pow( System.Math.E, x );
double d2 = System.Math.Pow( System.Math.E, -x );
 
Expression.checkDoubleRange( interp, d1 );
Expression.checkDoubleRange( interp, d2 );
return new ExprValue( ( d1 + d2 ) / 2 );
}
}
 
class ExpFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
double d = System.Math.Exp( TclDouble.get( interp, argv[0] ) );
if ( ( d == System.Double.NaN ) || ( d == System.Double.NegativeInfinity ) || ( d == System.Double.PositiveInfinity ) )
{
Expression.DoubleTooLarge( interp );
}
return new ExprValue( d );
}
}
 
 
class FloorFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( System.Math.Floor( TclDouble.get( interp, argv[0] ) ) );
}
}
 
 
class FmodFunction : BinaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( System.Math.IEEERemainder( TclDouble.get( interp, argv[0] ), TclDouble.get( interp, argv[1] ) ) );
}
}
 
class HypotFunction : BinaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
double x = TclDouble.get( interp, argv[0] );
double y = TclDouble.get( interp, argv[1] );
return new ExprValue( System.Math.Sqrt( ( ( x * x ) + ( y * y ) ) ) );
}
}
 
 
class LogFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( System.Math.Log( TclDouble.get( interp, argv[0] ) ) );
}
}
 
 
class Log10Function : UnaryMathFunction
{
private static readonly double log10;
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( System.Math.Log( TclDouble.get( interp, argv[0] ) ) / log10 );
}
static Log10Function()
{
log10 = System.Math.Log( 10 );
}
}
 
 
class SinFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( System.Math.Sin( TclDouble.get( interp, argv[0] ) ) );
}
}
 
 
class SinhFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
double x = TclDouble.get( interp, argv[0] );
 
double d1 = System.Math.Pow( System.Math.E, x );
double d2 = System.Math.Pow( System.Math.E, -x );
 
Expression.checkDoubleRange( interp, d1 );
Expression.checkDoubleRange( interp, d2 );
 
return new ExprValue( ( d1 - d2 ) / 2 );
}
}
 
 
class SqrtFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( System.Math.Sqrt( TclDouble.get( interp, argv[0] ) ) );
}
}
 
 
class TanFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return new ExprValue( System.Math.Tan( TclDouble.get( interp, argv[0] ) ) );
}
}
 
class TanhFunction : UnaryMathFunction
{
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
double x = TclDouble.get( interp, argv[0] );
if ( x == 0 )
{
return new ExprValue( 0.0 );
}
 
double d1 = System.Math.Pow( System.Math.E, x );
double d2 = System.Math.Pow( System.Math.E, -x );
 
Expression.checkDoubleRange( interp, d1 );
Expression.checkDoubleRange( interp, d2 );
 
return new ExprValue( ( d1 - d2 ) / ( d1 + d2 ) );
}
}
 
class RandFunction : NoArgMathFunction
{
 
// Generate the random number using the linear congruential
// generator defined by the following recurrence:
// seed = ( IA * seed ) mod IM
// where IA is 16807 and IM is (2^31) - 1. In order to avoid
// potential problems with integer overflow, the code uses
// additional constants IQ and IR such that
// IM = IA*IQ + IR
// For details on how this algorithm works, refer to the following
// papers:
//
// S.K. Park & K.W. Miller, "Random number generators: good ones
// are hard to find," Comm ACM 31(10):1192-1201, Oct 1988
//
// W.H. Press & S.A. Teukolsky, "Portable random number
// generators," Computers in Physics 6(5):522-524, Sep/Oct 1992.
 
 
private const int randIA = 16807;
private const int randIM = 2147483647;
private const int randIQ = 127773;
private const int randIR = 2836;
private static readonly System.DateTime date = System.DateTime.Now;
 
/// <summary> Srand calls the main algorithm for rand after it sets the seed.
/// To facilitate this call, the method is static and can be used
/// w/o creating a new object. But we also need to maintain the
/// inheritance hierarchy, thus the dynamic apply() calls the static
/// statApply().
/// </summary>
 
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
return ( statApply( interp, argv ) );
}
 
 
internal static ExprValue statApply( Interp interp, TclObject[] argv )
{
 
int tmp;
 
if ( !( interp.randSeedInit ) )
{
interp.randSeedInit = true;
interp.randSeed = (int)date.Ticks;
}
 
if ( interp.randSeed == 0 )
{
// Don't allow a 0 seed, since it breaks the generator. Shift
// it to some other value.
 
interp.randSeed = 123459876;
}
 
tmp = (int)( interp.randSeed / randIQ );
interp.randSeed = ( ( randIA * ( interp.randSeed - tmp * randIQ ) ) - randIR * tmp );
 
if ( interp.randSeed < 0 )
{
interp.randSeed += randIM;
}
 
return new ExprValue( interp.randSeed * ( 1.0 / randIM ) );
}
}
 
 
class SrandFunction : UnaryMathFunction
{
 
internal override ExprValue apply( Interp interp, TclObject[] argv )
{
 
// Reset the seed.
 
interp.randSeedInit = true;
 
interp.randSeed = (long)TclDouble.get( interp, argv[0] );
 
// To avoid duplicating the random number generation code we simply
// call the static random number generator in the RandFunction
// class.
 
return ( RandFunction.statApply( interp, null ) );
}
}
}
/trunk/TCL/src/base/Extension.cs
@@ -0,0 +1,160 @@
/*
* Extension.java --
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: Extension.java,v 1.2 1999/05/09 21:18:54 dejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> Base class for all Tcl Extensions. A Tcl Extension defines a set of
/// commands that can be loaded into an Interp as a single unit.
///
/// When a Tcl Extension is loaded into an Interp, either statically
/// (using the "new" operator inside Java code) or dynamically (using
/// the java::load command in Tcl scripts), it usually creates a set of
/// commands inside the interpreter. Occasionally, loading an Extension
/// may lead to additional side effects. For example, a communications
/// Extension may open network connections when it's loaded. Please
/// refer to the documentation of the specific Extension for details.
/// </summary>
 
abstract public class Extension
{
 
/// <summary> Default constructor. Does nothing. The purpose of this
/// constructor is to make sure instances of this Extension can be
/// loaded dynamically using the "java::load" command, which calls
/// Class.newInstance().
/// </summary>
 
public Extension()
{
}
 
/// <summary> Initialize the Extension to run in a normal (unsafe)
/// interpreter. This usually means creating all the commands
/// provided by this class. A particular implementation can arrange
/// the commands to be loaded on-demand using the loadOnDemand()
/// function.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
 
abstract public void init( Interp interp );
 
/// <summary> Initialize the Extension to run in a safe interpreter. This
/// method should be written carefully, so that it initializes the
/// safe interpreter only with partial functionality provided by
/// the Extension that is safe for use by untrusted code.
///
/// The default implementation always throws a TclException, so that
/// a subclass of Extension cannot be loaded into a safe interpreter
/// unless it has overridden the safeInit() method.
///
/// </summary>
/// <param name="safeInterp">the safe interpreter in which the Extension should
/// be initialized.
/// </param>
 
public void safeInit( Interp safeInterp )
{
throw new TclException( safeInterp, "Extension \"" + GetType().ToString() + "\" cannot be loaded into a safe interpreter" );
}
 
/// <summary> Create a stub command which autoloads the real command the first time
/// the stub command is invoked. Register the stub command in the
/// interpreter.
///
/// </summary>
/// <param name="interp">current interp.
/// </param>
/// <param name="cmdName">name of the command, e.g., "after".
/// </param>
/// <param name="clsName">name of the Java class that implements this command,
/// e.g. "tcl.lang.AfterCmd"
/// </param>
 
public static void loadOnDemand( Interp interp, string cmdName, string clsName )
{
interp.createCommand( cmdName, new AutoloadStub( clsName ) );
}
}
 
/// <summary> The purpose of AutoloadStub is to load-on-demand the classes that
/// implement Tcl commands. This reduces Jacl start up time and, when
/// running Jacl off a web page, reduces download time significantly.
/// </summary>
 
class AutoloadStub : Command
{
internal string className;
 
/// <summary> Create a stub command which autoloads the real command the first time
/// the stub command is invoked.
///
/// </summary>
/// <param name="clsName">name of the Java class that implements this command,
/// e.g. "tcl.lang.AfterCmd"
/// </param>
internal AutoloadStub( string clsName )
{
className = clsName;
}
 
/// <summary> Load the class that implements the given command and execute it.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="argv">command arguments.
/// </param>
/// <exception cref=""> TclException if error happens inside the real command proc.
/// </exception>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
Type cmdClass = null;
Command cmd;
try
{
cmdClass = System.Type.GetType( className, true );
}
catch ( System.Exception e )
{
throw new TclException( interp, "ClassNotFoundException for class \"" + className + "\"" );
}
 
try
{
cmd = (Command)SupportClass.CreateNewInstance( cmdClass );
}
catch ( System.UnauthorizedAccessException e1 )
{
throw new TclException( interp, "IllegalAccessException for class \"" + cmdClass.FullName + "\"" );
}
catch ( System.InvalidCastException e3 )
{
throw new TclException( interp, "ClassCastException for class \"" + cmdClass.FullName + "\"" );
}
catch ( System.Exception e2 )
{
throw new TclException( interp, "InstantiationException for class \"" + cmdClass.FullName + "\"" );
}
 
interp.createCommand( argv[0].ToString(), cmd );
TCL.CompletionCode rc = cmd.cmdProc( interp, argv );
return rc == TCL.CompletionCode.EXIT ? TCL.CompletionCode.EXIT : TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/base/FindElemResult.cs
@@ -0,0 +1,52 @@
/*
* FindElemResult.java --
*
* Result returned by Util.findElement().
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: FindElemResult.java,v 1.1.1.1 1998/10/14 21:09:21 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* Result returned by Util.findElement().
*/
 
class FindElemResult
{
 
/*
* The end of the element in the original string -- the index of the
* character immediately behind the element.
*/
 
internal int elemEnd;
 
/*
* The element itself.
*/
 
internal string elem;
internal bool brace;
internal int size;
 
internal FindElemResult( int i, string s, int b )
{
elemEnd = i;
elem = s;
brace = b!=0;
size = s.Length;
}
} // end FindElemResult
}
/trunk/TCL/src/base/IdleHandler.cs
@@ -0,0 +1,114 @@
/*
* IdleHandler.java --
*
* The API for defining idle event handler.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: IdleHandler.java,v 1.1.1.1 1998/10/14 21:09:21 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This abstract class is used to define idle handlers.
*/
 
public abstract class IdleHandler
{
 
/*
* Back pointer to the notifier that will fire this idle.
*/
 
internal Notifier notifier;
 
/*
* True if the cancel() method has been called.
*/
 
internal bool isCancelled;
 
/*
* Used to distinguish older idle handlers from recently-created ones.
*/
 
internal int generation;
 
public IdleHandler( Notifier n )
{
notifier = (Notifier)n;
isCancelled = false;
 
lock ( notifier )
{
notifier.idleList.Add( this );
generation = notifier.idleGeneration;
if ( System.Threading.Thread.CurrentThread != notifier.primaryThread )
{
System.Threading.Monitor.PulseAll( notifier );
}
}
}
public void cancel()
{
lock ( this )
{
if ( isCancelled )
{
return;
}
 
isCancelled = true;
 
lock ( notifier )
{
for ( int i = 0; i < notifier.idleList.Count; i++ )
{
if ( notifier.idleList[i] == this )
{
notifier.idleList.RemoveAt( i );
 
/*
* We can return now because the same idle handler can
* be registered only once in the list of idles.
*/
 
return;
}
}
}
}
}
internal int invoke()
{
lock ( this )
{
/*
* The idle handler may be cancelled after it was registered in
* the notifier. Check the isCancelled field to make sure it's not
* cancelled.
*/
 
if ( !isCancelled )
{
processIdleEvent();
return 1;
}
else
{
return 0;
}
}
}
abstract public void processIdleEvent();
} // end IdleHandler
}
/trunk/TCL/src/base/ImportRef.cs
@@ -0,0 +1,40 @@
/*
* ImportRef.java
*
* An ImportRef is a member of the list of imported commands
* which is part of the WrappedCommand class.
*
* Copyright (c) 1999 Mo DeJong.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ImportRef.java,v 1.1 1999/08/05 03:42:49 mo Exp $
*/
using System;
namespace tcl.lang
{
 
/// <summary> An imported command is created in an namespace when it imports a "real"
/// command from another namespace. An imported command has a Command
/// structure that points (via its ClientData value) to the "real" Command
/// structure in the source namespace's command table. The real command
/// records all the imported commands that refer to it in a list of ImportRef
/// structures so that they can be deleted when the real command is deleted.
/// </summary>
 
class ImportRef
{
internal WrappedCommand importedCmd; // Points to the imported command created in
// an importing namespace; this command
// redirects its invocations to the "real" cmd.
internal ImportRef next; // Next element on the linked list of
// imported commands that refer to the
// "real" command. The real command deletes
// these imported commands on this list when
// it is deleted.
}
}
/trunk/TCL/src/base/ImportedCmdData.cs
@@ -0,0 +1,59 @@
/*
* ImportedCmdData.java
*
* An ImportedCmdData instance is used as the Command implementation
* (the cmd member of the WrappedCommand class).
*
* Copyright (c) 1999 Mo DeJong.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ImportedCmdData.java,v 1.1 1999/08/05 03:42:54 mo Exp $
*/
using System;
namespace tcl.lang
{
 
 
/// <summary> Class which is used as the Command implementation inside a WrappedCommand
/// that has been imported into another namespace. The cmd member of a Wrapped
/// command will be set to an instance of this class when a command is imported.
/// From this ImportedCmdData reference, we can find the "real" command from
/// another namespace.
/// </summary>
 
class ImportedCmdData : Command, CommandWithDispose
{
internal WrappedCommand realCmd; // "Real" command that this imported command
// refers to.
internal WrappedCommand self; // Pointer to this imported WrappedCommand. Needed
// only when deleting it in order to remove
// it from the real command's linked list of
// imported commands that refer to it.
 
public override string ToString()
{
 
return "ImportedCmd for " + realCmd;
}
 
/// <summary> Called when the command is invoked in the interp.</summary>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
NamespaceCmd.invokeImportedCmd( interp, this, objv );
return TCL.CompletionCode.RETURN;
}
 
/// <summary> Called when the command is deleted from the interp.</summary>
 
public void disposeCmd()
{
NamespaceCmd.deleteImportedCmd( this );
}
}
}
/trunk/TCL/src/base/InternalRep.cs
@@ -0,0 +1,44 @@
/*
* InternalRep.java
*
* This file contains the abstract class declaration for the
* internal representations of TclObjects.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: InternalRep.java,v 1.4 2000/10/29 06:00:42 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This is the interface for implementing internal representation of Tcl
/// objects. A class that implements InternalRep should define the
/// following:
///
/// (1) the two abstract methods specified in this base class:
/// dispose()
/// duplicate()
///
/// (2) The method toString()
///
/// (3) class method(s) newInstance() if appropriate
///
/// (4) class method set<Type>FromAny() if appropriate
///
/// (5) class method get() if appropriate
/// </summary>
 
public interface InternalRep
{
void dispose();
InternalRep duplicate();
} // end InternalRep
}
/trunk/TCL/src/base/Interp.cs
@@ -0,0 +1,2609 @@
#undef DEBUG
/*
* Interp.java --
*
* Implements the core Tcl interpreter.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: Interp.java,v 1.44 2003/07/25 16:38:35 mdejong Exp $
*
*/
using System;
using System.Collections;
using System.IO;
using System.Text;
 
namespace tcl.lang
{
 
/// <summary> The Tcl interpreter class.</summary>
 
public class Interp : EventuallyFreed
{
private void InitBlock()
{
reflectObjTable = new Hashtable();
reflectConflictTable = new Hashtable();
importTable = new Hashtable[] { new Hashtable(), new Hashtable() };
}
/// <summary> Returns the name of the script file currently under execution.
///
/// </summary>
/// <returns> the name of the script file currently under execution.
/// </returns>
internal string ScriptFile
{
get
{
return dbg.fileName;
}
 
}
 
// The following three variables are used to maintain a translation
// table between ReflectObject's and their string names. These
// variables are accessed by the ReflectObject class, they
// are defined here be cause we need them to be per interp data.
 
// Translates Object to ReflectObject. This makes sure we have only
// one ReflectObject internalRep for the same Object -- this
// way Object identity can be done by string comparison.
 
internal Hashtable reflectObjTable;
 
// Number of reflect objects created so far inside this Interp
// (including those that have be freed)
 
internal long reflectObjCount = 0;
 
// Table used to store reflect hash index conflicts, see
// ReflectObject implementation for more details
 
internal Hashtable reflectConflictTable;
 
// The number of chars to copy from an offending command into error
// message.
 
private const int MAX_ERR_LENGTH = 200;
 
 
// We pretend this is Tcl 8.0, patch level 0.
 
internal const string TCL_VERSION = "8.0";
internal const string TCL_PATCH_LEVEL = "8.0";
 
 
// Total number of times a command procedure
// has been called for this interpreter.
 
protected internal int cmdCount;
 
// FIXME : remove later
// Table of commands for this interpreter.
//Hashtable cmdTable;
 
// Table of channels currently registered in this interp.
 
internal Hashtable interpChanTable;
 
// The Notifier associated with this Interp.
 
private Notifier notifier;
 
// Hash table for associating data with this interpreter. Cleaned up
// when this interpreter is deleted.
 
internal Hashtable assocData;
 
// Current working directory.
 
private FileInfo workingDir;
 
// Points to top-most in stack of all nested procedure
// invocations. null means there are no active procedures.
 
internal CallFrame frame;
 
// Points to the call frame whose variables are currently in use
// (same as frame unless an "uplevel" command is being
// executed). null means no procedure is active or "uplevel 0" is
// being exec'ed.
 
internal CallFrame varFrame;
 
// The interpreter's global namespace.
 
internal NamespaceCmd.Namespace globalNs;
 
// Hash table used to keep track of hidden commands on a per-interp basis.
 
internal Hashtable hiddenCmdTable;
 
// Information used by InterpCmd.java to keep
// track of master/slave interps on a per-interp basis.
 
// Keeps track of all interps for which this interp is the Master.
// First, slaveTable (a hashtable) maps from names of commands to
// slave interpreters. This hashtable is used to store information
// about slave interpreters of this interpreter, to map over all slaves, etc.
 
internal Hashtable slaveTable;
 
// Hash table for Target Records. Contains all Target records which denote
// aliases from slaves or sibling interpreters that direct to commands in
// this interpreter. This table is used to remove dangling pointers
// from the slave (or sibling) interpreters when this interpreter is deleted.
 
internal Hashtable targetTable;
 
// Information necessary for this interp to function as a slave.
internal InterpSlaveCmd slave;
 
// Table which maps from names of commands in slave interpreter to
// InterpAliasCmd objects.
 
internal Hashtable aliasTable;
 
// FIXME : does globalFrame need to be replaced by globalNs?
// Points to the global variable frame.
 
//CallFrame globalFrame;
 
// The script file currently under execution. Can be null if the
// interpreter is not evaluating any script file.
 
internal string scriptFile;
 
// Number of times the interp.eval() routine has been recursively
// invoked.
 
internal int nestLevel;
 
// Used to catch infinite loops in Parser.eval2.
 
internal int maxNestingDepth;
 
// Flags used when evaluating a command.
 
internal int evalFlags;
 
// Flags used when evaluating a command.
 
public int flags;
 
// Is this interpreted marked as safe?
 
internal bool isSafe;
 
// Offset of character just after last one compiled or executed
// by Parser.eval2().
 
internal int termOffset;
 
// List of name resolution schemes added to this interpreter.
// Schemes are added/removed by calling addInterpResolver and
// removeInterpResolver.
 
internal ArrayList resolvers;
 
// The expression parser for this interp.
 
internal Expression expr;
 
// Used by the Expression class. If it is equal to zero, then the
// parser will evaluate commands and retrieve variable values from
// the interp.
 
internal int noEval;
 
// Used in the Expression.java file for the
// SrandFunction.class and RandFunction.class.
// Set to true if a seed has been set.
 
internal bool randSeedInit;
 
// Used in the Expression.java file for the SrandFunction.class and
// RandFunction.class. Stores the value of the seed.
 
internal long randSeed;
 
// If returnCode is TCL.CompletionCode.ERROR, stores the errorInfo.
 
internal string errorInfo;
 
// If returnCode is TCL.CompletionCode.ERROR, stores the errorCode.
 
internal string errorCode;
 
// Completion code to return if current procedure exits with a
// TCL_RETURN code.
 
protected internal TCL.CompletionCode returnCode;
 
// True means the interpreter has been deleted: don't process any
// more commands for it, and destroy the structure as soon as all
// nested invocations of eval() are done.
 
protected internal bool deleted;
 
// True means an error unwind is already in progress. False
// means a command proc has been invoked since last error occurred.
 
protected internal bool errInProgress;
 
// True means information has already been logged in $errorInfo
// for the current eval() instance, so eval() needn't log it
// (used to implement the "error" command).
 
protected internal bool errAlreadyLogged;
 
// True means that addErrorInfo has been called to record
// information for the current error. False means Interp.eval
// must clear the errorCode variable if an error is returned.
 
protected internal bool errCodeSet;
 
// When TCL_ERROR is returned, this gives the line number within
// the command where the error occurred (1 means first line).
 
 
internal int errorLine;
 
// Stores the current result in the interpreter.
 
private TclObject m_result;
 
// Value m_result is set to when resetResult() is called.
 
private TclObject m_nullResult;
 
// Used ONLY by PackageCmd.
 
internal Hashtable packageTable;
internal string packageUnknown;
 
 
// Used ONLY by the Parser.
 
internal TclObject[][][] parserObjv;
internal int[] parserObjvUsed;
 
internal TclToken[] parserTokens;
internal int parserTokensUsed;
 
 
// Used ONLY by JavaImportCmd
internal Hashtable[] importTable;
 
// List of unsafe commands:
 
internal static readonly string[] unsafeCmds = new string[] { "encoding", "exit", "load", "cd", "fconfigure", "file", "glob", "open", "pwd", "socket", "beep", "echo", "ls", "resource", "source", "exec", "source" };
 
// Flags controlling the call of invoke.
 
internal const int INVOKE_HIDDEN = 1;
internal const int INVOKE_NO_UNKNOWN = 2;
internal const int INVOKE_NO_TRACEBACK = 4;
 
public Interp()
{
InitBlock();
 
//freeProc = null;
errorLine = 0;
 
// An empty result is used pretty often. We will use a shared
// TclObject instance to represent the empty result so that we
// don't need to create a new TclObject instance every time the
// interpreter result is set to empty.
 
m_nullResult = TclString.newInstance( "" );
m_nullResult.preserve(); // Increment refCount to 1
m_nullResult.preserve(); // Increment refCount to 2 (shared)
m_result = TclString.newInstance( "" ); //m_nullResult; // correcponds to iPtr->objResultPtr
m_result.preserve();
 
expr = new Expression();
nestLevel = 0;
maxNestingDepth = 1000;
 
frame = null;
varFrame = null;
 
returnCode = TCL.CompletionCode.OK;
errorInfo = null;
errorCode = null;
 
packageTable = new Hashtable();
packageUnknown = null;
cmdCount = 0;
termOffset = 0;
resolvers = null;
evalFlags = 0;
scriptFile = null;
flags = 0;
isSafe = false;
assocData = null;
 
 
globalNs = null; // force creation of global ns below
globalNs = NamespaceCmd.createNamespace( this, null, null );
if ( globalNs == null )
{
throw new TclRuntimeError( "Interp(): can't create global namespace" );
}
 
 
// Init things that are specific to the Jacl implementation
 
workingDir = new FileInfo( System.Environment.CurrentDirectory );
noEval = 0;
 
notifier = Notifier.getNotifierForThread( System.Threading.Thread.CurrentThread );
notifier.preserve();
 
randSeedInit = false;
 
deleted = false;
errInProgress = false;
errAlreadyLogged = false;
errCodeSet = false;
 
dbg = initDebugInfo();
 
slaveTable = new Hashtable();
targetTable = new Hashtable();
aliasTable = new Hashtable();
 
// init parser variables
Parser.init( this );
TclParse.init( this );
 
// Initialize the Global (static) channel table and the local
// interp channel table.
 
interpChanTable = TclIO.getInterpChanTable( this );
 
// Sets up the variable trace for tcl_precision.
 
Util.setupPrecisionTrace( this );
 
// Create the built-in commands.
 
createCommands();
 
try
{
// Set up tcl_platform, tcl_version, tcl_library and other
// global variables.
 
setVar( "tcl_platform", "platform", "windows", TCL.VarFlag.GLOBAL_ONLY );
setVar( "tcl_platform", "byteOrder", "bigEndian", TCL.VarFlag.GLOBAL_ONLY );
 
setVar( "tcl_platform", "os", Environment.OSVersion.Platform.ToString(), TCL.VarFlag.GLOBAL_ONLY );
setVar( "tcl_platform", "osVersion", Environment.OSVersion.Version.ToString(), TCL.VarFlag.GLOBAL_ONLY );
setVar( "tcl_platform", "machine", Util.tryGetSystemProperty( "os.arch", "?" ), TCL.VarFlag.GLOBAL_ONLY );
 
setVar( "tcl_version", TCL_VERSION, TCL.VarFlag.GLOBAL_ONLY );
setVar( "tcl_patchLevel", TCL_PATCH_LEVEL, TCL.VarFlag.GLOBAL_ONLY );
setVar( "tcl_library", "resource:/tcl/lang/library", TCL.VarFlag.GLOBAL_ONLY );
if ( Util.Windows )
{
setVar( "tcl_platform", "host_platform", "windows", TCL.VarFlag.GLOBAL_ONLY );
}
else if ( Util.Mac )
{
setVar( "tcl_platform", "host_platform", "macintosh", TCL.VarFlag.GLOBAL_ONLY );
}
else
{
setVar( "tcl_platform", "host_platform", "unix", TCL.VarFlag.GLOBAL_ONLY );
}
 
// Create the env array an populated it with proper
// values.
 
Env.initialize( this );
 
// Register Tcl's version number. Note: This MUST be
// done before the call to evalResource, otherwise
// calls to "package require tcl" will fail.
 
pkgProvide( "Tcl", TCL_VERSION );
 
// Source the init.tcl script to initialize auto-loading.
 
evalResource( "/tcl/lang/library/init.tcl" );
}
catch ( TclException e )
{
System.Diagnostics.Debug.WriteLine( getResult().ToString() );
SupportClass.WriteStackTrace( e, Console.Error );
throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
}
}
public override void eventuallyDispose()
{
if ( deleted )
{
return;
}
 
deleted = true;
 
if ( nestLevel > 0 )
{
//-- TODO -- Determine why this is an error throw new TclRuntimeError("dispose() called with active evals");
}
 
// Remove our association with the notifer (if we had one).
 
if ( notifier != null )
{
notifier.release();
notifier = null;
}
 
// Dismantle everything in the global namespace except for the
// "errorInfo" and "errorCode" variables. These might be needed
// later on if errors occur while deleting commands. We are careful
// to destroy and recreate the "errorInfo" and "errorCode"
// variables, in case they had any traces on them.
//
// Dismantle the namespace here, before we clear the assocData. If any
// background errors occur here, they will be deleted below.
 
 
// FIXME : check impl of TclTeardownNamespace
NamespaceCmd.teardownNamespace( globalNs );
 
// Delete all variables.
 
TclObject errorInfoObj = null, errorCodeObj = null;
 
try
{
errorInfoObj = getVar( "errorInfo", null, TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
// Do nothing when var does not exist.
}
 
if ( errorInfoObj != null )
{
errorInfoObj.preserve();
}
 
try
{
errorCodeObj = getVar( "errorCode", null, TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
// Do nothing when var does not exist.
}
 
if ( errorCodeObj != null )
{
errorCodeObj.preserve();
}
 
frame = null;
varFrame = null;
 
try
{
if ( errorInfoObj != null )
{
setVar( "errorInfo", null, errorInfoObj, TCL.VarFlag.GLOBAL_ONLY );
errorInfoObj.release();
}
if ( errorCodeObj != null )
{
setVar( "errorCode", null, errorCodeObj, TCL.VarFlag.GLOBAL_ONLY );
errorCodeObj.release();
}
}
catch ( TclException e )
{
// Ignore it -- same behavior as Tcl 8.0.
}
 
// Tear down the math function table.
 
expr = null;
 
// Remove all the assoc data tied to this interp and invoke
// deletion callbacks; note that a callback can create new
// callbacks, so we iterate.
 
// ATK The java code was somethink strong
if ( assocData != null )
{
foreach ( AssocData data in assocData.Values )
{
data.disposeAssocData( this );
}
assocData.Clear();
}
 
// Close any remaining channels
 
for ( IDictionaryEnumerator e = interpChanTable.GetEnumerator(); e.MoveNext(); )
{
Object key = e.Key;
Channel chan = (Channel)e.Value;
try
{
chan.close();
}
catch ( IOException ex )
{
// Ignore any IO errors
}
}
 
// Finish deleting the global namespace.
 
// FIXME : check impl of Tcl_DeleteNamespace
NamespaceCmd.deleteNamespace( globalNs );
globalNs = null;
 
// Free up the result *after* deleting variables, since variable
// deletion could have transferred ownership of the result string
// to Tcl.
 
frame = null;
varFrame = null;
resolvers = null;
 
resetResult();
}
~Interp()
{
dispose();
}
protected internal void createCommands()
{
Extension.loadOnDemand( this, "after", "tcl.lang.AfterCmd" );
Extension.loadOnDemand( this, "append", "tcl.lang.AppendCmd" );
Extension.loadOnDemand( this, "array", "tcl.lang.ArrayCmd" );
Extension.loadOnDemand( this, "binary", "tcl.lang.BinaryCmd" );
Extension.loadOnDemand( this, "break", "tcl.lang.BreakCmd" );
Extension.loadOnDemand( this, "case", "tcl.lang.CaseCmd" );
Extension.loadOnDemand( this, "catch", "tcl.lang.CatchCmd" );
Extension.loadOnDemand( this, "cd", "tcl.lang.CdCmd" );
Extension.loadOnDemand( this, "clock", "tcl.lang.ClockCmd" );
Extension.loadOnDemand( this, "close", "tcl.lang.CloseCmd" );
Extension.loadOnDemand( this, "continue", "tcl.lang.ContinueCmd" );
Extension.loadOnDemand( this, "concat", "tcl.lang.ConcatCmd" );
Extension.loadOnDemand( this, "encoding", "tcl.lang.EncodingCmd" );
Extension.loadOnDemand( this, "eof", "tcl.lang.EofCmd" );
Extension.loadOnDemand( this, "eval", "tcl.lang.EvalCmd" );
Extension.loadOnDemand( this, "error", "tcl.lang.ErrorCmd" );
if ( !Util.Mac )
{
Extension.loadOnDemand( this, "exec", "tcl.lang.ExecCmd" );
}
Extension.loadOnDemand( this, "exit", "tcl.lang.ExitCmd" );
Extension.loadOnDemand( this, "expr", "tcl.lang.ExprCmd" );
Extension.loadOnDemand( this, "fblocked", "tcl.lang.FblockedCmd" );
Extension.loadOnDemand( this, "fconfigure", "tcl.lang.FconfigureCmd" );
Extension.loadOnDemand( this, "file", "tcl.lang.FileCmd" );
Extension.loadOnDemand( this, "flush", "tcl.lang.FlushCmd" );
Extension.loadOnDemand( this, "for", "tcl.lang.ForCmd" );
Extension.loadOnDemand( this, "foreach", "tcl.lang.ForeachCmd" );
Extension.loadOnDemand( this, "format", "tcl.lang.FormatCmd" );
Extension.loadOnDemand( this, "gets", "tcl.lang.GetsCmd" );
Extension.loadOnDemand( this, "global", "tcl.lang.GlobalCmd" );
Extension.loadOnDemand( this, "glob", "tcl.lang.GlobCmd" );
Extension.loadOnDemand( this, "if", "tcl.lang.IfCmd" );
Extension.loadOnDemand( this, "incr", "tcl.lang.IncrCmd" );
Extension.loadOnDemand( this, "info", "tcl.lang.InfoCmd" );
Extension.loadOnDemand( this, "interp", "tcl.lang.InterpCmd" );
Extension.loadOnDemand( this, "list", "tcl.lang.ListCmd" );
Extension.loadOnDemand( this, "join", "tcl.lang.JoinCmd" );
Extension.loadOnDemand( this, "lappend", "tcl.lang.LappendCmd" );
Extension.loadOnDemand( this, "lindex", "tcl.lang.LindexCmd" );
Extension.loadOnDemand( this, "linsert", "tcl.lang.LinsertCmd" );
Extension.loadOnDemand( this, "llength", "tcl.lang.LlengthCmd" );
Extension.loadOnDemand( this, "lrange", "tcl.lang.LrangeCmd" );
Extension.loadOnDemand( this, "lreplace", "tcl.lang.LreplaceCmd" );
Extension.loadOnDemand( this, "lsearch", "tcl.lang.LsearchCmd" );
Extension.loadOnDemand( this, "lset", "tcl.lang.LsetCmd" );
Extension.loadOnDemand( this, "lsort", "tcl.lang.LsortCmd" );
Extension.loadOnDemand( this, "namespace", "tcl.lang.NamespaceCmd" );
Extension.loadOnDemand( this, "open", "tcl.lang.OpenCmd" );
Extension.loadOnDemand( this, "package", "tcl.lang.PackageCmd" );
Extension.loadOnDemand( this, "proc", "tcl.lang.ProcCmd" );
Extension.loadOnDemand( this, "puts", "tcl.lang.PutsCmd" );
Extension.loadOnDemand( this, "pwd", "tcl.lang.PwdCmd" );
Extension.loadOnDemand( this, "read", "tcl.lang.ReadCmd" );
Extension.loadOnDemand( this, "regsub", "tcl.lang.RegsubCmd" );
Extension.loadOnDemand( this, "rename", "tcl.lang.RenameCmd" );
Extension.loadOnDemand( this, "return", "tcl.lang.ReturnCmd" );
Extension.loadOnDemand( this, "scan", "tcl.lang.ScanCmd" );
Extension.loadOnDemand( this, "seek", "tcl.lang.SeekCmd" );
Extension.loadOnDemand( this, "set", "tcl.lang.SetCmd" );
Extension.loadOnDemand( this, "socket", "tcl.lang.SocketCmd" );
Extension.loadOnDemand( this, "source", "tcl.lang.SourceCmd" );
Extension.loadOnDemand( this, "split", "tcl.lang.SplitCmd" );
Extension.loadOnDemand( this, "string", "tcl.lang.StringCmd" );
Extension.loadOnDemand( this, "subst", "tcl.lang.SubstCmd" );
Extension.loadOnDemand( this, "switch", "tcl.lang.SwitchCmd" );
Extension.loadOnDemand( this, "tell", "tcl.lang.TellCmd" );
Extension.loadOnDemand( this, "time", "tcl.lang.TimeCmd" );
Extension.loadOnDemand( this, "trace", "tcl.lang.TraceCmd" );
Extension.loadOnDemand( this, "unset", "tcl.lang.UnsetCmd" );
Extension.loadOnDemand( this, "update", "tcl.lang.UpdateCmd" );
Extension.loadOnDemand( this, "uplevel", "tcl.lang.UplevelCmd" );
Extension.loadOnDemand( this, "upvar", "tcl.lang.UpvarCmd" );
Extension.loadOnDemand( this, "variable", "tcl.lang.VariableCmd" );
Extension.loadOnDemand( this, "vwait", "tcl.lang.VwaitCmd" );
Extension.loadOnDemand( this, "while", "tcl.lang.WhileCmd" );
 
 
// Add "regexp" and related commands to this interp.
RegexpCmd.init( this );
 
 
// The Java package is only loaded when the user does a
// "package require java" in the interp. We need to create a small
// command that will load when "package require java" is called.
 
Extension.loadOnDemand( this, "jaclloadjava", "tcl.lang.JaclLoadJavaCmd" );
 
try
{
eval( "package ifneeded java 1.3.1 jaclloadjava" );
}
catch ( TclException e )
{
System.Diagnostics.Debug.WriteLine( getResult().ToString() );
SupportClass.WriteStackTrace( e, Console.Error );
throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
}
 
}
public void setAssocData( string name, AssocData data )
// Object associated with the name.
{
if ( assocData == null )
{
assocData = new Hashtable();
}
SupportClass.PutElement( assocData, name, data );
}
public void deleteAssocData( string name )
// Name of association.
{
if ( assocData == null )
{
return;
}
 
SupportClass.HashtableRemove( assocData, name );
}
public AssocData getAssocData( string name )
// Name of association.
{
if ( assocData == null )
{
return null;
}
else
{
return (AssocData)assocData[name];
}
}
 
public void backgroundError()
{
BgErrorMgr mgr = (BgErrorMgr)getAssocData( "tclBgError" );
if ( mgr == null )
{
mgr = new BgErrorMgr( this );
setAssocData( "tclBgError", mgr );
}
mgr.addBgError();
}
 
/*-----------------------------------------------------------------
*
* VARIABLES
*
*-----------------------------------------------------------------
*/
public TclObject setVar( TclObject nameObj, TclObject value, TCL.VarFlag flags )
{
return Var.setVar( this, nameObj, value, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
}
public TclObject setVar( string name, TclObject value, TCL.VarFlag flags )
{
return Var.setVar( this, name, value, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
}
public TclObject setVar( string name1, string name2, TclObject value, TCL.VarFlag flags )
{
return Var.setVar( this, name1, name2, value, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
}
public void setVar( string name, string strValue, TCL.VarFlag flags )
{
Var.setVar( this, name, TclString.newInstance( strValue ), ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
}
public void setVar( string name1, string name2, string strValue, TCL.VarFlag flags )
{
Var.setVar( this, name1, name2, TclString.newInstance( strValue ), ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
}
public TclObject getVar( TclObject nameObj, TCL.VarFlag flags )
{
return Var.getVar( this, nameObj, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
}
public TclObject getVar( string name, TCL.VarFlag flags )
{
return Var.getVar( this, name, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
}
public TclObject getVar( string name1, string name2, TCL.VarFlag flags )
{
return Var.getVar( this, name1, name2, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
}
public void unsetVar( TclObject nameObj, TCL.VarFlag flags )
{
Var.unsetVar( this, nameObj, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
}
public void unsetVar( string name, TCL.VarFlag flags )
{
Var.unsetVar( this, name, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
}
public void unsetVar( string name1, string name2, TCL.VarFlag flags )
{
Var.unsetVar( this, name1, name2, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
}
public void traceVar( TclObject nameObj, VarTrace trace, TCL.VarFlag flags )
{
Var.traceVar( this, nameObj, flags, trace );
}
public void traceVar( string name, VarTrace trace, TCL.VarFlag flags )
{
Var.traceVar( this, name, flags, trace );
}
public void traceVar( string part1, string part2, VarTrace trace, TCL.VarFlag flags )
{
Var.traceVar( this, part1, part2, flags, trace );
}
public void untraceVar( TclObject nameObj, VarTrace trace, TCL.VarFlag flags )
// OR-ed collection of bits describing current
// trace, including any of TCL.VarFlag.TRACE_READS,
// TCL.VarFlag.TRACE_WRITES, TCL.VarFlag.TRACE_UNSETS,
// TCL.VarFlag.GLOBAL_ONLY and TCL.VarFlag.NAMESPACE_ONLY.
{
Var.untraceVar( this, nameObj, flags, trace );
}
public void untraceVar( string name, VarTrace trace, TCL.VarFlag flags )
// OR-ed collection of bits describing current
// trace, including any of TCL.VarFlag.TRACE_READS,
// TCL.VarFlag.TRACE_WRITES, TCL.VarFlag.TRACE_UNSETS,
// TCL.VarFlag.GLOBAL_ONLY and TCL.VarFlag.NAMESPACE_ONLY.
{
Var.untraceVar( this, name, flags, trace );
}
public void untraceVar( string part1, string part2, VarTrace trace, TCL.VarFlag flags )
// OR-ed collection of bits describing current
// trace, including any of TCL.VarFlag.TRACE_READS,
// TCL.VarFlag.TRACE_WRITES, TCL.VarFlag.TRACE_UNSETS,
// TCL.VarFlag.GLOBAL_ONLY and TCL.VarFlag.NAMESPACE_ONLY.
{
Var.untraceVar( this, part1, part2, flags, trace );
}
public void createCommand( string cmdName, Command cmdImpl )
// Command object to associate with
// cmdName.
{
ImportRef oldRef = null;
NamespaceCmd.Namespace ns;
WrappedCommand cmd, refCmd;
string tail;
ImportedCmdData data;
 
if ( deleted )
{
// The interpreter is being deleted. Don't create any new
// commands; it's not safe to muck with the interpreter anymore.
 
return;
}
 
// Determine where the command should reside. If its name contains
// namespace qualifiers, we put it in the specified namespace;
// otherwise, we always put it in the global namespace.
 
if ( cmdName.IndexOf( "::" ) != -1 )
{
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
NamespaceCmd.Namespace[] nsArr = new NamespaceCmd.Namespace[1];
NamespaceCmd.Namespace[] dummyArr = new NamespaceCmd.Namespace[1];
string[] tailArr = new string[1];
 
NamespaceCmd.getNamespaceForQualName( this, cmdName, null, TCL.VarFlag.CREATE_NS_IF_UNKNOWN, nsArr, dummyArr, dummyArr, tailArr );
 
ns = nsArr[0];
tail = tailArr[0];
 
if ( ( ns == null ) || ( (System.Object)tail == null ) )
{
return;
}
}
else
{
ns = globalNs;
tail = cmdName;
}
 
cmd = (WrappedCommand)ns.cmdTable[tail];
if ( cmd != null )
{
// Command already exists. Delete the old one.
// Be careful to preserve any existing import links so we can
// restore them down below. That way, you can redefine a
// command and its import status will remain intact.
 
oldRef = cmd.importRef;
cmd.importRef = null;
 
deleteCommandFromToken( cmd );
 
// FIXME : create a test case for this condition!
 
cmd = (WrappedCommand)ns.cmdTable[tail];
if ( cmd != null )
{
// If the deletion callback recreated the command, just throw
// away the new command (if we try to delete it again, we
// could get stuck in an infinite loop).
 
SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
}
}
 
cmd = new WrappedCommand();
ns.cmdTable.Add( tail, cmd );
cmd.table = ns.cmdTable;
cmd.hashKey = tail;
cmd.ns = ns;
cmd.cmd = cmdImpl;
cmd.deleted = false;
// FIXME : import feature not implemented
//cmd.importRef = null;
 
// Plug in any existing import references found above. Be sure
// to update all of these references to point to the new command.
 
if ( oldRef != null )
{
cmd.importRef = oldRef;
while ( oldRef != null )
{
refCmd = oldRef.importedCmd;
data = (ImportedCmdData)refCmd.cmd;
data.realCmd = cmd;
oldRef = oldRef.next;
}
}
 
// There are no shadowed commands in Jacl because they are only
// used in the 8.0 compiler
 
return;
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateObjCommand --
*
* Define a new object-based command in a command table.
*
* Results:
* The return value is a token for the command, which can
* be used in future calls to Tcl_GetCommandName.
*
* Side effects:
* If no command named "cmdName" already exists for interp, one is
* created. Otherwise, if a command does exist, then if the
* object-based Tcl_ObjCmdProc is TclInvokeStringCommand, we assume
* Tcl_CreateCommand was called previously for the same command and
* just set its Tcl_ObjCmdProc to the argument "proc"; otherwise, we
* delete the old command.
*
* In the future, during bytecode evaluation when "cmdName" is seen as
* the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
* Tcl_ObjCmdProc proc will be called. When the command is deleted from
* the table, deleteProc will be called. See the manual entry for
* details on the calling sequence.
*
*----------------------------------------------------------------------
*/
 
public delegate int dxObjCmdProc( object clientData, Interp interp, int argc, TclObject[] argv );
public delegate void dxCmdDeleteProc( ref object clientData );
 
public void createObjCommand( string cmdName, dxObjCmdProc proc, object clientData, dxCmdDeleteProc deleteProc )
// Command object to associate with cmdName.
{
ImportRef oldRef = null;
NamespaceCmd.Namespace ns;
WrappedCommand cmd, refCmd;
string tail;
ImportedCmdData data;
int _new;
 
if ( deleted )
{
// The interpreter is being deleted. Don't create any new
// commands; it's not safe to muck with the interpreter anymore.
 
return;
}
 
// Determine where the command should reside. If its name contains
// namespace qualifiers, we put it in the specified namespace;
// otherwise, we always put it in the global namespace.
 
if ( cmdName.IndexOf( "::" ) != -1 )
{
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
NamespaceCmd.Namespace[] nsArr = new NamespaceCmd.Namespace[1];
NamespaceCmd.Namespace[] dummyArr = new NamespaceCmd.Namespace[1];
string[] tailArr = new string[1];
 
NamespaceCmd.getNamespaceForQualName( this, cmdName, null, TCL.VarFlag.CREATE_NS_IF_UNKNOWN, nsArr, dummyArr, dummyArr, tailArr );
 
ns = nsArr[0];
tail = tailArr[0];
 
if ( ( ns == null ) || ( (System.Object)tail == null ) )
{
return;
}
}
else
{
ns = globalNs;
tail = cmdName;
}
 
cmd = (WrappedCommand)ns.cmdTable[tail];
if ( cmd != null )
{
/*
* Command already exists. If its object-based Tcl_ObjCmdProc is
* TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the
* argument "proc". Otherwise, we delete the old command.
*/
if ( cmd.objProc != null && cmd.objProc.GetType().Name == "TclInvokeStringCommand" )
{
cmd.objProc = proc;
cmd.objClientData = clientData;
cmd.deleteProc = deleteProc;
cmd.deleteData = clientData;
return;
}
/*
* Otherwise, we delete the old command. Be careful to preserve
* any existing import links so we can restore them down below.
* That way, you can redefine a command and its import status
* will remain intact.
*/
oldRef = cmd.importRef;
cmd.importRef = null;
 
deleteCommandFromToken( cmd );
 
// FIXME : create a test case for this condition!
 
cmd = (WrappedCommand)ns.cmdTable[tail];
if ( cmd != null )
{
// If the deletion callback recreated the command, just throw
// away the new command (if we try to delete it again, we
// could get stuck in an infinite loop).
 
SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
}
}
 
cmd = new WrappedCommand();
ns.cmdTable.Add( tail, cmd );
cmd.table = ns.cmdTable;
cmd.hashKey = tail;
cmd.ns = ns;
cmd.cmd = null;
cmd.deleted = false;
// FIXME : import feature not implemented
//cmd.importRef = null;
 
// TODO -- Determine if this is all correct
cmd.objProc = proc;
cmd.objClientData = clientData;
//cmd.proc = TclInvokeObjectCommand;
cmd.clientData = (object)cmd;
cmd.deleteProc = deleteProc;
cmd.deleteData = clientData;
cmd.flags = 0;
 
 
// Plug in any existing import references found above. Be sure
// to update all of these references to point to the new command.
 
if ( oldRef != null )
{
cmd.importRef = oldRef;
while ( oldRef != null )
{
refCmd = oldRef.importedCmd;
data = (ImportedCmdData)refCmd.cmd;
data.realCmd = cmd;
oldRef = oldRef.next;
}
}
 
// There are no shadowed commands in Jacl because they are only
// used in the 8.0 compiler
 
return;
}
internal string getCommandFullName( WrappedCommand cmd )
// Token for the command.
{
Interp interp = this;
StringBuilder name = new StringBuilder();
 
// Add the full name of the containing namespace, followed by the "::"
// separator, and the command name.
 
if ( cmd != null )
{
if ( cmd.ns != null )
{
name.Append( cmd.ns.fullName );
if ( cmd.ns != interp.globalNs )
{
name.Append( "::" );
}
}
if ( cmd.table != null )
{
name.Append( cmd.hashKey );
}
}
 
return name.ToString();
}
public int deleteCommand( string cmdName )
// Name of command to remove.
{
WrappedCommand cmd;
 
// Find the desired command and delete it.
 
try
{
cmd = NamespaceCmd.findCommand( this, cmdName, null, 0 );
}
catch ( TclException e )
{
throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
}
if ( cmd == null )
{
return -1;
}
if ( cmd.deleteProc != null )
cmd.deleteProc( ref cmd.deleteData );
return deleteCommandFromToken( cmd );
}
protected internal int deleteCommandFromToken( WrappedCommand cmd )
// Wrapper Token for command to delete.
{
if ( cmd == null )
{
return -1;
}
 
ImportRef ref_Renamed, nextRef;
WrappedCommand importCmd;
 
// The code here is tricky. We can't delete the hash table entry
// before invoking the deletion callback because there are cases
// where the deletion callback needs to invoke the command (e.g.
// object systems such as OTcl). However, this means that the
// callback could try to delete or rename the command. The deleted
// flag allows us to detect these cases and skip nested deletes.
 
if ( cmd.deleted )
{
// Another deletion is already in progress. Remove the hash
// table entry now, but don't invoke a callback or free the
// command structure.
 
if ( (System.Object)cmd.hashKey != null && cmd.table != null )
{
SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
cmd.table = null;
cmd.hashKey = null;
}
return 0;
}
 
cmd.deleted = true;
if ( cmd.cmd is CommandWithDispose )
{
( (CommandWithDispose)cmd.cmd ).disposeCmd();
}
if ( cmd.deleteProc != null )
{
cmd.deleteProc( ref cmd.objClientData );
}
// If this command was imported into other namespaces, then imported
// commands were created that refer back to this command. Delete these
// imported commands now.
 
for ( ref_Renamed = cmd.importRef; ref_Renamed != null; ref_Renamed = nextRef )
{
nextRef = ref_Renamed.next;
importCmd = ref_Renamed.importedCmd;
deleteCommandFromToken( importCmd );
}
 
// FIXME : what does this mean? Is this a mistake in the C comment?
 
// Don't use hPtr to delete the hash entry here, because it's
// possible that the deletion callback renamed the command.
// Instead, use cmdPtr->hptr, and make sure that no-one else
// has already deleted the hash entry.
 
if ( cmd.table != null )
{
SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
cmd.table = null;
cmd.hashKey = null;
}
 
// Drop the reference to the Command instance inside the WrappedCommand
 
cmd.cmd = null;
 
// We do not need to cleanup the WrappedCommand because GC will get it.
 
return 0;
}
protected internal void renameCommand( string oldName, string newName )
{
Interp interp = this;
string newTail;
NamespaceCmd.Namespace cmdNs, newNs;
WrappedCommand cmd;
Hashtable table, oldTable;
string hashKey, oldHashKey;
 
// Find the existing command. An error is returned if cmdName can't
// be found.
 
cmd = NamespaceCmd.findCommand( interp, oldName, null, 0 );
if ( cmd == null )
{
throw new TclException( interp, "can't " + ( ( ( (System.Object)newName == null ) || ( newName.Length == 0 ) ) ? "delete" : "rename" ) + " \"" + oldName + "\": command doesn't exist" );
}
cmdNs = cmd.ns;
 
// If the new command name is NULL or empty, delete the command. Do this
// with Tcl_DeleteCommandFromToken, since we already have the command.
 
if ( ( (System.Object)newName == null ) || ( newName.Length == 0 ) )
{
deleteCommandFromToken( cmd );
return;
}
 
// Make sure that the destination command does not already exist.
// The rename operation is like creating a command, so we should
// automatically create the containing namespaces just like
// Tcl_CreateCommand would.
 
NamespaceCmd.Namespace[] newNsArr = new NamespaceCmd.Namespace[1];
NamespaceCmd.Namespace[] dummyArr = new NamespaceCmd.Namespace[1];
string[] newTailArr = new string[1];
 
NamespaceCmd.getNamespaceForQualName( interp, newName, null, TCL.VarFlag.CREATE_NS_IF_UNKNOWN, newNsArr, dummyArr, dummyArr, newTailArr );
 
newNs = newNsArr[0];
newTail = newTailArr[0];
 
if ( ( newNs == null ) || ( (System.Object)newTail == null ) )
{
throw new TclException( interp, "can't rename to \"" + newName + "\": bad command name" );
}
if ( newNs.cmdTable[newTail] != null )
{
throw new TclException( interp, "can't rename to \"" + newName + "\": command already exists" );
}
 
// Warning: any changes done in the code here are likely
// to be needed in Tcl_HideCommand() code too.
// (until the common parts are extracted out) --dl
 
// Put the command in the new namespace so we can check for an alias
// loop. Since we are adding a new command to a namespace, we must
// handle any shadowing of the global commands that this might create.
 
oldTable = cmd.table;
oldHashKey = cmd.hashKey;
newNs.cmdTable.Add( newTail, cmd );
cmd.table = newNs.cmdTable;
cmd.hashKey = newTail;
cmd.ns = newNs;
 
// FIXME : this is a nasty hack that fixes renaming for Procedures
// that move from one namespace to another, but the real problem
// is that a rename does not work for Command instances in general
 
if ( cmd.cmd is Procedure )
{
Procedure p = (Procedure)cmd.cmd;
p.ns = cmd.ns;
}
 
// Now check for an alias loop. If we detect one, put everything back
// the way it was and report the error.
 
try
{
interp.preventAliasLoop( interp, cmd );
}
catch ( TclException e )
{
newNs.cmdTable.Remove( newTail );
cmd.table = oldTable;
cmd.hashKey = oldHashKey;
cmd.ns = cmdNs;
throw;
}
 
// The new command name is okay, so remove the command from its
// current namespace. This is like deleting the command, so bump
// the cmdEpoch to invalidate any cached references to the command.
 
SupportClass.HashtableRemove( oldTable, oldHashKey );
 
return;
}
internal void preventAliasLoop( Interp cmdInterp, WrappedCommand cmd )
{
// If we are not creating or renaming an alias, then it is
// always OK to create or rename the command.
 
if ( !( cmd.cmd is InterpAliasCmd ) )
{
return;
}
 
// OK, we are dealing with an alias, so traverse the chain of aliases.
// If we encounter the alias we are defining (or renaming to) any in
// the chain then we have a loop.
 
InterpAliasCmd alias = (InterpAliasCmd)cmd.cmd;
InterpAliasCmd nextAlias = alias;
while ( true )
{
 
// If the target of the next alias in the chain is the same as
// the source alias, we have a loop.
 
WrappedCommand aliasCmd = nextAlias.getTargetCmd( this );
if ( aliasCmd == null )
{
return;
}
if ( aliasCmd.cmd == cmd.cmd )
{
 
throw new TclException( this, "cannot define or rename alias \"" + alias.name + "\": would create a loop" );
}
 
// Otherwise, follow the chain one step further. See if the target
// command is an alias - if so, follow the loop to its target
// command. Otherwise we do not have a loop.
 
if ( !( aliasCmd.cmd is InterpAliasCmd ) )
{
return;
}
nextAlias = (InterpAliasCmd)aliasCmd.cmd;
}
}
public Command getCommand( string cmdName )
// String name of the command.
{
// Find the desired command and return it.
 
WrappedCommand cmd;
 
try
{
cmd = NamespaceCmd.findCommand( this, cmdName, null, 0 );
}
catch ( TclException e )
{
throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
}
 
return ( ( cmd == null ) ? null : cmd.cmd );
}
public WrappedCommand getObjCommand( string cmdName )
// String name of the command.
{
// Find the desired command and return it.
 
WrappedCommand cmd;
 
try
{
cmd = NamespaceCmd.findCommand( this, cmdName, null, 0 );
}
catch ( TclException e )
{
throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
}
 
return ( ( cmd == null ) ? null : cmd );
}
public static bool commandComplete( string inString )
// The string to check.
{
return Parser.commandComplete( inString, inString.Length );
}
 
 
/*-----------------------------------------------------------------
*
* EVAL
*
*-----------------------------------------------------------------
*/
 
public TclObject getResult()
{
return m_result;
}
public void setResult( TclObject r )
// A Tcl Object to be set as the result.
{
if ( r == null )
{
throw new System.NullReferenceException( "Interp.setResult() called with null TclObject argument." );
}
 
if ( r == m_result )
{
// Setting to current value (including m_nullResult) is a no-op.
return;
}
 
if ( m_result != m_nullResult )
{
m_result.release();
}
 
m_result = r;
 
if ( m_result != m_nullResult )
{
m_result.preserve();
}
}
public void setResult( string r )
// A string result.
{
if ( (System.Object)r == null )
{
resetResult();
}
else
{
setResult( TclString.newInstance( r ) );
}
}
public void setResult( int r )
// An int result.
{
setResult( TclInteger.newInstance( r ) );
}
public void setResult( double r )
// A double result.
{
setResult( TclDouble.newInstance( r ) );
}
public void setResult( bool r )
// A boolean result.
{
setResult( TclBoolean.newInstance( r ) );
}
public void resetResult()
{
if ( m_result != m_nullResult )
{
m_result.release();
m_result = TclString.newInstance( "" ); //m_nullResult;
m_result.preserve();
if ( !m_nullResult.Shared )
{
throw new TclRuntimeError( "m_nullResult is not shared" );
}
}
errAlreadyLogged = false;
errInProgress = false;
errCodeSet = false;
returnCode = TCL.CompletionCode.OK;
}
public void appendElement( object Element )
{
TclObject result;
 
result = getResult();
if ( result.Shared )
{
result = result.duplicate();
}
TclList.append( this, result, TclObj.newInstance( Element ) );
setResult( result );
}
 
public void appendElement(
string Element )
{
TclObject result;
 
result = getResult();
if ( result.Shared )
{
result = result.duplicate();
}
TclList.append( this, result, TclString.newInstance( Element ) );
setResult( result );
}
public void eval( string inString, int flags )
{
int evalFlags = this.evalFlags;
this.evalFlags &= ~Parser.TCL_ALLOW_EXCEPTIONS;
 
CharPointer script = new CharPointer( inString );
try
{
Parser.eval2( this, script.array, script.index, script.length(), flags );
}
catch ( TclException e )
{
 
if ( nestLevel != 0 )
{
throw;
}
 
// Update the interpreter's evaluation level count. If we are again at
// the top level, process any unusual return code returned by the
// evaluated code. Note that we don't propagate an exception that
// has a TCL.CompletionCode.RETURN error code when updateReturnInfo() returns TCL.CompletionCode.OK.
 
TCL.CompletionCode result = e.getCompletionCode();
 
if ( result == TCL.CompletionCode.RETURN )
{
result = updateReturnInfo();
}
if ( result != TCL.CompletionCode.EXIT && result != TCL.CompletionCode.OK && result != TCL.CompletionCode.ERROR && ( evalFlags & Parser.TCL_ALLOW_EXCEPTIONS ) == 0 )
{
processUnexpectedResult( result );
}
if ( result != TCL.CompletionCode.OK )
{
e.setCompletionCode( result );
throw;
}
}
}
public void eval( string script )
{
eval( script, 0 );
}
public void eval( TclObject tobj, int flags )
{
 
eval( tobj.ToString(), flags );
}
public void recordAndEval( TclObject script, int flags )
{
// Append the script to the event list by calling "history add <script>".
// We call the eval method with the command of type TclObject, so that
// we don't have to deal with funny chars ("{}[]$\) in the script.
 
TclObject cmd = null;
try
{
cmd = TclList.newInstance();
TclList.append( this, cmd, TclString.newInstance( "history" ) );
TclList.append( this, cmd, TclString.newInstance( "add" ) );
TclList.append( this, cmd, script );
cmd.preserve();
eval( cmd, TCL.EVAL_GLOBAL );
}
catch ( System.Exception e )
{
}
finally
{
cmd.release();
}
 
// Execute the command.
 
if ( ( flags & TCL.NO_EVAL ) == 0 )
{
eval( script, flags & TCL.EVAL_GLOBAL );
}
}
public void evalFile( string sFilename )
{
string fileContent; // Contains the content of the file.
 
fileContent = readScriptFromFile( sFilename );
 
if ( (System.Object)fileContent == null )
{
throw new TclException( this, "couldn't read file \"" + sFilename + "\"" );
}
 
string oldScript = scriptFile;
scriptFile = sFilename;
 
try
{
pushDebugStack( sFilename, 1 );
eval( fileContent, 0 );
}
catch ( TclException e )
{
if ( e.getCompletionCode() == TCL.CompletionCode.ERROR )
{
addErrorInfo( "\n (file \"" + sFilename + "\" line " + errorLine + ")" );
}
throw;
}
finally
{
scriptFile = oldScript;
popDebugStack();
}
}
internal void evalURL( System.Uri context, string s )
{
string fileContent; // Contains the content of the file.
 
fileContent = readScriptFromURL( context, s );
if ( (System.Object)fileContent == null )
{
throw new TclException( this, "cannot read URL \"" + s + "\"" );
}
 
string oldScript = scriptFile;
scriptFile = s;
 
try
{
eval( fileContent, 0 );
}
finally
{
scriptFile = oldScript;
}
}
private string readScriptFromFile( string sFilename )
// The name of the file.
{
FileInfo sourceFile;
StreamReader fs;
try
{
sourceFile = FileUtil.getNewFileObj( this, sFilename );
}
catch ( TclException e )
{
resetResult();
return null;
}
catch ( FileNotFoundException e )
{
return null;
}
catch ( System.Security.SecurityException sec_e )
{
return null;
}
try
{
// HACK only UTF8 will be read
using ( fs = new StreamReader( sourceFile.FullName, System.Text.Encoding.UTF8 ) )
{
// read all an do the new line conversations
return fs.ReadToEnd().Replace( "\r\n", "\n" );
}
}
catch ( IOException )
{
return null;
}
}
private string readScriptFromURL( System.Uri context, string s )
{
Object content = null;
System.Uri url;
 
try
{
url = new System.Uri( context, s );
}
catch ( System.UriFormatException e )
{
return null;
}
 
try
{
 
// ATK content = url.getContent();
content = url.ToString();
}
catch ( System.Exception e )
{
Type jar_class;
 
try
{
jar_class = System.Type.GetType( "java.net.JarURLConnection" );
}
catch ( System.Exception e2 )
{
return null;
}
 
Object jar;
try
{
jar = (System.Net.HttpWebRequest)System.Net.WebRequest.Create( url );
}
catch ( IOException e2 )
{
return null;
}
 
if ( jar == null )
{
return null;
}
 
// We must call JarURLConnection.getInputStream() dynamically
// Because the class JarURLConnection does not exist in JDK1.1
 
try
{
System.Reflection.MethodInfo m = jar_class.GetMethod( "openConnection", (System.Type[])null );
content = m.Invoke( jar, (System.Object[])null );
}
catch ( System.Exception e2 )
{
return null;
}
}
// HACK
// catch (IOException e)
// {
// return null;
// }
// catch (System.Security.SecurityException e)
// {
// return null;
// }
 
if ( content is string )
{
return (string)content;
}
else if ( content is Stream )
{
// FIXME : use custom stream handler
Stream fs = (Stream)content;
 
try
{
// FIXME : read does not check return values
long available;
available = fs.Length - fs.Position;
byte[] charArray = new byte[(int)available];
SupportClass.ReadInput( fs, ref charArray, 0, charArray.Length );
return new string( SupportClass.ToCharArray( charArray ) );
}
catch ( IOException e2 )
{
return null;
}
finally
{
closeInputStream( fs );
}
}
else
{
return null;
}
}
private void closeInputStream( Stream fs )
{
try
{
fs.Close();
}
catch ( IOException e )
{
;
}
}
internal void evalResource( string resName )
{
// Stream stream = null;
//
// try
// {
//
// stream = typeof(Interp).getResourceAsStream(resName);
// }
// catch (System.Security.SecurityException e2)
// {
// // This catch is necessary if Jacl is to work in an applet
// // at all. Note that java::new will not work from within Jacl
// // in an applet.
//
// System.Console.Error.WriteLine("evalResource: Ignoring SecurityException, " + "it is likely we are running in an applet: " + "cannot read resource \"" + resName + "\"" + e2);
//
// return ;
// }
//
// if (stream == null)
// {
// throw new TclException(this, "cannot read resource \"" + resName + "\"");
// }
//
// try
// {
// // FIXME : ugly JDK 1.2 only hack
// // Ugly workaround for compressed files BUG in JDK1.2
// // this bug first showed up in JDK1.2beta4. I have sent
// // a number of emails to Sun but they have deemed this a "feature"
// // of 1.2. This is flat out wrong but I do not seem to change thier
// // minds. Because of this, there is no way to do non blocking IO
// // on a compressed Stream in Java. (mo)
//
//
// if (System_Renamed.getProperty("java.version").StartsWith("1.2") && stream.GetType().FullName.Equals("java.util.zip.ZipFile$1"))
// {
//
MemoryStream baos = new MemoryStream( 1024 );
byte[] buffer = new byte[1024];
// int numRead;
//
// // Read all data from the stream into a resizable buffer
// while ((numRead = SupportClass.ReadInput(stream, ref buffer, 0, buffer.Length)) != - 1)
// {
// baos.Write(SupportClass.ToByteArray(buffer), 0, numRead);
// }
//
// // Convert bytes into a String and eval them
// eval(new string(SupportClass.ToCharArray(SupportClass.ToByteArray(SupportClass.ToSByteArray(baos.ToArray())))), 0);
// }
// else
// {
// // Other systems do not need the compressed jar hack
//
// long available;
// available = stream.Length - stream.Position;
// int num = (int) available;
// byte[] byteArray = new byte[num];
// int offset = 0;
// while (num > 0)
// {
// int readLen = SupportClass.ReadInput(stream, ref byteArray, offset, num);
// offset += readLen;
// num -= readLen;
// }
//
// eval(new string(SupportClass.ToCharArray(SupportClass.ToByteArray(byteArray))), 0);
// }
// }
// catch (IOException e)
// {
// return ;
// }
// finally
// {
// closeInputStream(stream);
// }
}
internal static BackSlashResult backslash( string s, int i, int len )
{
CharPointer script = new CharPointer( s.Substring( 0, ( len ) - ( 0 ) ) );
script.index = i;
return Parser.backslash( script.array, script.index );
}
 
 
public void setErrorCode( TclObject code )
// The errorCode object.
{
try
{
setVar( "errorCode", null, code, TCL.VarFlag.GLOBAL_ONLY );
errCodeSet = true;
}
catch ( TclException excp )
{
// Ignore any TclException's, possibly caused by variable traces on
// the errorCode variable. This is compatible with the behavior of
// the Tcl C API.
}
}
 
 
public void addErrorInfo( string message )
// The message to record.
{
if ( !errInProgress )
{
errInProgress = true;
 
try
{
 
setVar( "errorInfo", null, getResult().ToString(), TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e1 )
{
// Ignore (see try-block above).
}
 
// If the errorCode variable wasn't set by the code
// that generated the error, set it to "NONE".
 
if ( !errCodeSet )
{
try
{
setVar( "errorCode", null, "NONE", TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e1 )
{
// Ignore (see try-block above).
}
}
}
 
try
{
setVar( "errorInfo", null, message, TCL.VarFlag.APPEND_VALUE | TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e1 )
{
// Ignore (see try-block above).
}
}
internal void processUnexpectedResult( TCL.CompletionCode returnCode )
{
resetResult();
if ( returnCode == TCL.CompletionCode.BREAK )
{
throw new TclException( this, "invoked \"break\" outside of a loop" );
}
else if ( returnCode == TCL.CompletionCode.CONTINUE )
{
throw new TclException( this, "invoked \"continue\" outside of a loop" );
}
else
{
throw new TclException( this, "command returned bad code: " + returnCode );
}
}
public TCL.CompletionCode updateReturnInfo()
{
TCL.CompletionCode code;
 
code = returnCode;
returnCode = TCL.CompletionCode.OK;
 
if ( code == TCL.CompletionCode.ERROR )
{
try
{
setVar( "errorCode", null, ( (System.Object)errorCode != null ) ? errorCode : "NONE", TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
// An error may happen during a trace to errorCode. We ignore it.
// This may leave error messages inside Interp.result (which
// is compatible with Tcl 8.0 behavior.
}
errCodeSet = true;
 
if ( (System.Object)errorInfo != null )
{
try
{
setVar( "errorInfo", null, errorInfo, TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
// An error may happen during a trace to errorInfo. We
// ignore it. This may leave error messages inside
// Interp.result (which is compatible with Tcl 8.0
// behavior.
}
errInProgress = true;
}
}
 
return code;
}
protected internal CallFrame newCallFrame( Procedure proc, TclObject[] objv )
{
return new CallFrame( this, proc, objv );
}
protected internal CallFrame newCallFrame()
{
return new CallFrame( this );
}
internal FileInfo getWorkingDir()
{
if ( workingDir == null )
{
try
{
 
string dirName = getVar( "env", "HOME", 0 ).ToString();
workingDir = FileUtil.getNewFileObj( this, dirName );
}
catch ( TclException e )
{
resetResult();
}
workingDir = new FileInfo( Util.tryGetSystemProperty( "user.home", "." ) );
}
return workingDir;
}
internal void setWorkingDir( string dirName )
{
FileInfo dirObj = FileUtil.getNewFileObj( this, dirName );
 
// Use the canonical name of the path, if possible.
 
try
{
dirObj = new FileInfo( dirObj.FullName );
}
catch ( IOException e )
{
}
 
 
if ( Directory.Exists( dirObj.FullName ) )
{
workingDir = dirObj;
}
else
{
throw new TclException( this, "couldn't change working directory to \"" + dirObj.Name + "\": no such file or directory" );
}
}
 
public Notifier getNotifier()
{
return notifier;
}
public void pkgProvide( string name, string version )
{
PackageCmd.pkgProvide( this, name, version );
}
public string pkgRequire( string pkgname, string version, bool exact )
{
return PackageCmd.pkgRequire( this, pkgname, version, exact );
}
 
/*
* Debugging API.
*
* The following section defines two debugging API functions for
* logging information about the point of execution of Tcl scripts:
*
* - pushDebugStack() is called when a procedure body is
* executed, or when a file is source'd.
* - popDebugStack() is called when the flow of control is about
* to return from a procedure body, or from a source'd file.
*
* Two other API functions are used to determine the current point of
* execution:
*
* - getScriptFile() returns the script file current being executed.
* - getArgLineNumber(i) returns the line number of the i-th argument
* of the current command.
*
* Note: The point of execution is automatically maintained for
* control structures such as while, if, for and foreach,
* as long as they use Interp.eval(argv[?]) to evaluate control
* blocks.
*
* The case and switch commands need to set dbg.cmdLine explicitly
* because they may evaluate control blocks that are not elements
* inside the argv[] array. ** This feature not yet implemented. **
*
* The proc command needs to call getScriptFile() and
* getArgLineNumber(3) to find out the location of the proc
* body.
*
* The debugging API functions in the Interp class are just dummy stub
* functions. These functions are usually implemented in a subclass of
* Interp (e.g. DbgInterp) that has real debugging support.
*
*/
 
protected internal DebugInfo dbg;
 
/// <summary> Initialize the debugging information.</summary>
/// <returns> a DebugInfo object used by Interp in non-debugging mode.
/// </returns>
protected internal DebugInfo initDebugInfo()
{
return new DebugInfo( null, 1 );
}
 
/// <summary> Add more more level at the top of the debug stack.
///
/// </summary>
/// <param name="fileName">the filename for the new stack level
/// </param>
/// <param name="lineNumber">the line number at which the execution of the
/// new stack level begins.
/// </param>
internal void pushDebugStack( string fileName, int lineNumber )
{
// do nothing.
}
 
/// <summary> Remove the top-most level of the debug stack.</summary>
internal void popDebugStack()
{
// do nothing
}
/// <summary> Returns the line number where the given command argument begins. E.g, if
/// the following command is at line 10:
///
/// foo {a
/// b } c
///
/// getArgLine(0) = 10
/// getArgLine(1) = 10
/// getArgLine(2) = 11
///
/// </summary>
/// <param name="index">specifies an argument.
/// </param>
/// <returns> the line number of the given argument.
/// </returns>
internal int getArgLineNumber( int index )
{
return 0;
}
internal void transferResult( Interp sourceInterp, TCL.CompletionCode result )
{
if ( sourceInterp == this )
{
return;
}
 
if ( result == TCL.CompletionCode.ERROR )
{
TclObject obj;
 
// An error occurred, so transfer error information from the source
// interpreter to the target interpreter. Setting the flags tells
// the target interp that it has inherited a partial traceback
// chain, not just a simple error message.
 
if ( !sourceInterp.errAlreadyLogged )
{
sourceInterp.addErrorInfo( "" );
}
sourceInterp.errAlreadyLogged = true;
 
resetResult();
 
obj = sourceInterp.getVar( "errorInfo", TCL.VarFlag.GLOBAL_ONLY );
setVar( "errorInfo", obj, TCL.VarFlag.GLOBAL_ONLY );
 
obj = sourceInterp.getVar( "errorCode", TCL.VarFlag.GLOBAL_ONLY );
setVar( "errorCode", obj, TCL.VarFlag.GLOBAL_ONLY );
 
errInProgress = true;
errCodeSet = true;
}
 
returnCode = result;
setResult( sourceInterp.getResult() );
sourceInterp.resetResult();
 
if ( result != TCL.CompletionCode.OK )
{
 
throw new TclException( this, getResult().ToString(), result );
}
}
internal void hideCommand( string cmdName, string hiddenCmdToken )
{
WrappedCommand cmd;
 
if ( deleted )
{
// The interpreter is being deleted. Do not create any new
// structures, because it is not safe to modify the interpreter.
return;
}
 
// Disallow hiding of commands that are currently in a namespace or
// renaming (as part of hiding) into a namespace.
//
// (because the current implementation with a single global table
// and the needed uniqueness of names cause problems with namespaces)
//
// we don't need to check for "::" in cmdName because the real check is
// on the nsPtr below.
//
// hiddenCmdToken is just a string which is not interpreted in any way.
// It may contain :: but the string is not interpreted as a namespace
// qualifier command name. Thus, hiding foo::bar to foo::bar and then
// trying to expose or invoke ::foo::bar will NOT work; but if the
// application always uses the same strings it will get consistent
// behavior.
//
// But as we currently limit ourselves to the global namespace only
// for the source, in order to avoid potential confusion,
// lets prevent "::" in the token too. --dl
 
if ( hiddenCmdToken.IndexOf( "::" ) >= 0 )
{
throw new TclException( this, "cannot use namespace qualifiers as " + "hidden commandtoken (rename)" );
}
 
// Find the command to hide. An error is returned if cmdName can't
// be found. Look up the command only from the global namespace.
// Full path of the command must be given if using namespaces.
 
cmd = NamespaceCmd.findCommand( this, cmdName, null, TCL.VarFlag.LEAVE_ERR_MSG | TCL.VarFlag.GLOBAL_ONLY );
 
// Check that the command is really in global namespace
 
if ( cmd.ns != globalNs )
{
throw new TclException( this, "can only hide global namespace commands" + " (use rename then hide)" );
}
 
// Initialize the hidden command table if necessary.
 
if ( hiddenCmdTable == null )
{
hiddenCmdTable = new Hashtable();
}
 
// It is an error to move an exposed command to a hidden command with
// hiddenCmdToken if a hidden command with the name hiddenCmdToken already
// exists.
 
if ( hiddenCmdTable.ContainsKey( hiddenCmdToken ) )
{
throw new TclException( this, "hidden command named \"" + hiddenCmdToken + "\" already exists" );
}
 
// Nb : This code is currently 'like' a rename to a specialy set apart
// name table. Changes here and in TclRenameCommand must
// be kept in synch untill the common parts are actually
// factorized out.
 
// Remove the hash entry for the command from the interpreter command
// table. This is like deleting the command, so bump its command epoch;
// this invalidates any cached references that point to the command.
 
if ( cmd.table.ContainsKey( cmd.hashKey ) )
{
SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
}
 
// Now link the hash table entry with the command structure.
// We ensured above that the nsPtr was right.
 
cmd.table = hiddenCmdTable;
cmd.hashKey = hiddenCmdToken;
SupportClass.PutElement( hiddenCmdTable, hiddenCmdToken, cmd );
}
internal void exposeCommand( string hiddenCmdToken, string cmdName )
{
WrappedCommand cmd;
 
if ( deleted )
{
// The interpreter is being deleted. Do not create any new
// structures, because it is not safe to modify the interpreter.
return;
}
 
// Check that we have a regular name for the command
// (that the user is not trying to do an expose and a rename
// (to another namespace) at the same time)
 
if ( cmdName.IndexOf( "::" ) >= 0 )
{
throw new TclException( this, "can not expose to a namespace " + "(use expose to toplevel, then rename)" );
}
 
// Get the command from the hidden command table:
 
if ( hiddenCmdTable == null || !hiddenCmdTable.ContainsKey( hiddenCmdToken ) )
{
throw new TclException( this, "unknown hidden command \"" + hiddenCmdToken + "\"" );
}
cmd = (WrappedCommand)hiddenCmdTable[hiddenCmdToken];
 
// Check that we have a true global namespace
// command (enforced by Tcl_HideCommand() but let's double
// check. (If it was not, we would not really know how to
// handle it).
 
if ( cmd.ns != globalNs )
{
 
// This case is theoritically impossible,
// we might rather panic() than 'nicely' erroring out ?
 
throw new TclException( this, "trying to expose " + "a non global command name space command" );
}
 
// This is the global table
NamespaceCmd.Namespace ns = cmd.ns;
 
// It is an error to overwrite an existing exposed command as a result
// of exposing a previously hidden command.
 
if ( ns.cmdTable.ContainsKey( cmdName ) )
{
throw new TclException( this, "exposed command \"" + cmdName + "\" already exists" );
}
 
// Remove the hash entry for the command from the interpreter hidden
// command table.
 
if ( (System.Object)cmd.hashKey != null )
{
SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
cmd.table = ns.cmdTable;
cmd.hashKey = cmdName;
}
 
// Now link the hash table entry with the command structure.
// This is like creating a new command, so deal with any shadowing
// of commands in the global namespace.
 
ns.cmdTable.Add( cmdName, cmd );
 
// Not needed as we are only in the global namespace
// (but would be needed again if we supported namespace command hiding)
 
// TclResetShadowedCmdRefs(interp, cmdPtr);
}
internal void hideUnsafeCommands()
{
for ( int ix = 0; ix < unsafeCmds.Length; ix++ )
{
try
{
hideCommand( unsafeCmds[ix], unsafeCmds[ix] );
}
catch ( TclException e )
{
if ( !e.Message.StartsWith( "unknown command" ) )
{
throw;
}
}
}
}
internal TCL.CompletionCode invokeGlobal( TclObject[] objv, int flags )
{
CallFrame savedVarFrame = varFrame;
 
try
{
varFrame = null;
return invoke( objv, flags );
}
finally
{
varFrame = savedVarFrame;
}
}
internal TCL.CompletionCode invoke( TclObject[] objv, int flags )
{
if ( ( objv.Length < 1 ) || ( objv == null ) )
{
throw new TclException( this, "illegal argument vector" );
}
 
 
string cmdName = objv[0].ToString();
WrappedCommand cmd;
TclObject[] localObjv = null;
 
if ( ( flags & INVOKE_HIDDEN ) != 0 )
{
 
// We never invoke "unknown" for hidden commands.
 
if ( hiddenCmdTable == null || !hiddenCmdTable.ContainsKey( cmdName ) )
{
throw new TclException( this, "invalid hidden command name \"" + cmdName + "\"" );
}
cmd = (WrappedCommand)hiddenCmdTable[cmdName];
}
else
{
cmd = NamespaceCmd.findCommand( this, cmdName, null, TCL.VarFlag.GLOBAL_ONLY );
if ( cmd == null )
{
if ( ( flags & INVOKE_NO_UNKNOWN ) == 0 )
{
cmd = NamespaceCmd.findCommand( this, "unknown", null, TCL.VarFlag.GLOBAL_ONLY );
if ( cmd != null )
{
localObjv = new TclObject[objv.Length + 1];
localObjv[0] = TclString.newInstance( "unknown" );
localObjv[0].preserve();
for ( int i = 0; i < objv.Length; i++ )
{
localObjv[i + 1] = objv[i];
}
objv = localObjv;
}
}
 
// Check again if we found the command. If not, "unknown" is
// not present and we cannot help, or the caller said not to
// call "unknown" (they specified TCL_INVOKE_NO_UNKNOWN).
 
if ( cmd == null )
{
throw new TclException( this, "invalid command name \"" + cmdName + "\"" );
}
}
}
 
// Invoke the command procedure. First reset the interpreter's string
// and object results to their default empty values since they could
// have gotten changed by earlier invocations.
 
resetResult();
cmdCount++;
 
TCL.CompletionCode result = TCL.CompletionCode.OK;
try
{
cmd.cmd.cmdProc( this, objv );
}
catch ( TclException e )
{
result = e.getCompletionCode();
}
 
// If we invoke a procedure, which was implemented as AutoloadStub,
// it was entered into the ordinary cmdTable. But here we know
// for sure, that this command belongs into the hiddenCmdTable.
// So if we can find an entry in cmdTable with the cmdName, just
// move it into the hiddenCmdTable.
 
if ( ( flags & INVOKE_HIDDEN ) != 0 )
{
cmd = NamespaceCmd.findCommand( this, cmdName, null, TCL.VarFlag.GLOBAL_ONLY );
if ( cmd != null )
{
// Basically just do the same as in hideCommand...
SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
cmd.table = hiddenCmdTable;
cmd.hashKey = cmdName;
SupportClass.PutElement( hiddenCmdTable, cmdName, cmd );
}
}
 
// If an error occurred, record information about what was being
// executed when the error occurred.
 
if ( ( result == TCL.CompletionCode.ERROR ) && ( ( flags & INVOKE_NO_TRACEBACK ) == 0 ) && !errAlreadyLogged )
{
StringBuilder ds;
 
if ( errInProgress )
{
ds = new StringBuilder( "\n while invoking\n\"" );
}
else
{
ds = new StringBuilder( "\n invoked from within\n\"" );
}
for ( int i = 0; i < objv.Length; i++ )
{
 
ds.Append( objv[i].ToString() );
if ( i < ( objv.Length - 1 ) )
{
ds.Append( " " );
}
else if ( ds.Length > 100 )
{
ds.Append( "..." );
break;
}
}
ds.Append( "\"" );
addErrorInfo( ds.ToString() );
errInProgress = true;
}
 
// Free any locally allocated storage used to call "unknown".
 
if ( localObjv != null )
{
localObjv[0].release();
}
 
return result;
}
internal void allowExceptions()
{
evalFlags |= Parser.TCL_ALLOW_EXCEPTIONS;
}
 
internal class ResolverScheme
{
private void InitBlock( Interp enclosingInstance )
{
this.enclosingInstance = enclosingInstance;
}
private Interp enclosingInstance;
public Interp Enclosing_Instance
{
get
{
return enclosingInstance;
}
 
}
 
internal string name; // Name identifying this scheme.
internal Resolver resolver;
 
internal ResolverScheme( Interp enclosingInstance, string name, Resolver resolver )
{
InitBlock( enclosingInstance );
this.name = name;
this.resolver = resolver;
}
}
 
public void addInterpResolver( string name, Resolver resolver )
// Object to resolve commands/variables.
{
IEnumerator enum_Renamed;
ResolverScheme res;
 
// Look for an existing scheme with the given name.
// If found, then replace its rules.
 
if ( resolvers != null )
{
for ( enum_Renamed = resolvers.GetEnumerator(); enum_Renamed.MoveNext(); )
{
res = (ResolverScheme)enum_Renamed.Current;
if ( name.Equals( res.name ) )
{
res.resolver = resolver;
return;
}
}
}
 
if ( resolvers == null )
{
resolvers = new ArrayList( 10 );
}
 
// Otherwise, this is a new scheme. Add it to the FRONT
// of the linked list, so that it overrides existing schemes.
 
res = new ResolverScheme( this, name, resolver );
 
resolvers.Insert( 0, res );
}
public Resolver getInterpResolver( string name )
// Look for a scheme with this name.
{
//IEnumerator enum;
 
// Look for an existing scheme with the given name. If found,
// then return pointers to its procedures.
 
if ( resolvers != null )
{
foreach ( ResolverScheme res in resolvers )
{
if ( name.Equals( res.name ) )
{
return res.resolver;
}
}
}
 
return null;
}
internal bool removeInterpResolver( string name )
// Name of the scheme to be removed.
{
ResolverScheme res;
IEnumerator enum_Renamed;
bool found = false;
 
// Look for an existing scheme with the given name.
 
if ( resolvers != null )
{
enum_Renamed = resolvers.GetEnumerator();
while ( !found && enum_Renamed.MoveNext() )
{
res = (ResolverScheme)enum_Renamed.Current;
if ( name.Equals( res.name ) )
{
found = true;
}
}
}
 
// If we found the scheme, delete it.
 
if ( found )
{
SupportClass.VectorRemoveElement( resolvers, name );
}
 
return found;
}
 
} // end Interp
}
/trunk/TCL/src/base/JACL.cs
@@ -0,0 +1,43 @@
/*
* JACL.java --
*
* This class stores all the Jacl-specific package protected constants.
* The exact values should match those in tcl.h.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: JACL.java,v 1.1.1.1 1998/10/14 21:09:21 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class holds all the Jacl-specific package protected constants.
*/
 
public class JACL
{
 
/*
* Platform constants. PLATFORM is not final because we may change it for
* testing purposes only.
*/
 
public const int PLATFORM_UNIX = 0;
public const int PLATFORM_WINDOWS = 1;
public const int PLATFORM_MAC = 2;
public static int PLATFORM;
static JACL()
{
PLATFORM = Util.ActualPlatform;
}
} // end JACL class
}
/trunk/TCL/src/base/Notifier.cs
@@ -0,0 +1,604 @@
/*
* Notifier.java --
*
* Implements the Jacl version of the Notifier class.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: Notifier.java,v 1.8 2003/03/11 02:21:14 mdejong Exp $
*
*/
using System;
using System.Collections;
 
namespace tcl.lang
{
 
// Implements the Jacl version of the Notifier class. The Notifier is
// the lowest-level part of the event system. It is used by
// higher-level event sources such as file, JavaBean and timer
// events. The Notifier manages an event queue that holds TclEvent
// objects.
//
// The Jacl notifier is designed to run in a multi-threaded
// environment. Each notifier instance is associated with a primary
// thread. Any thread can queue (or dequeue) events using the
// queueEvent (or deleteEvents) call. However, only the primary thread
// may process events in the queue using the doOneEvent()
// call. Attepmts to call doOneEvent from a non-primary thread will
// cause a TclRuntimeError.
//
// This class does not have a public constructor and thus cannot be
// instantiated. The only way to for a Tcl extension to get an
// Notifier is to call Interp.getNotifier() (or
// Notifier.getNotifierForThread() ), which returns the Notifier for that
// interpreter (thread).
 
public class Notifier : EventDeleter
{
 
// First pending event, or null if none.
 
private TclEvent firstEvent;
 
// Last pending event, or null if none.
 
private TclEvent lastEvent;
 
// Last high-priority event in queue, or null if none.
 
private TclEvent markerEvent;
 
// Event that was just processed by serviceEvent
 
private TclEvent servicedEvent = null;
 
// The primary thread of this notifier. Only this thread should process
// events from the event queue.
 
internal System.Threading.Thread primaryThread;
 
// Stores the Notifier for each thread.
 
private static Hashtable notifierTable;
 
// List of registered timer handlers.
 
internal ArrayList timerList;
 
// Used to distinguish older timer handlers from recently-created ones.
 
internal int timerGeneration;
 
// True if there is a pending timer event in the event queue, false
// otherwise.
 
internal bool timerPending;
 
// List of registered idle handlers.
 
internal ArrayList idleList;
 
// Used to distinguish older idle handlers from recently-created ones.
 
internal int idleGeneration;
 
// Reference count of the notifier. It's used to tell when a notifier
// is no longer needed.
 
internal int refCount;
 
private Notifier( System.Threading.Thread primaryTh )
{
primaryThread = primaryTh;
firstEvent = null;
lastEvent = null;
markerEvent = null;
 
timerList = new ArrayList( 10 );
timerGeneration = 0;
idleList = new ArrayList( 10 );
idleGeneration = 0;
timerPending = false;
refCount = 0;
}
public static Notifier getNotifierForThread( System.Threading.Thread thread )
// The thread that owns this Notifier.
{
lock ( typeof( tcl.lang.Notifier ) )
{
Notifier notifier = (Notifier)notifierTable[thread];
if ( notifier == null )
{
notifier = new Notifier( thread );
SupportClass.PutElement( notifierTable, thread, notifier );
}
 
return notifier;
}
}
public void preserve()
{
lock ( this )
{
if ( refCount < 0 )
{
throw new TclRuntimeError( "Attempting to preserve a freed Notifier" );
}
++refCount;
}
}
public void release()
{
lock ( this )
{
if ( ( refCount == 0 ) && ( primaryThread != null ) )
{
throw new TclRuntimeError( "Attempting to release a Notifier before it's preserved" );
}
if ( refCount <= 0 )
{
throw new TclRuntimeError( "Attempting to release a freed Notifier" );
}
--refCount;
if ( refCount == 0 )
{
SupportClass.HashtableRemove( notifierTable, primaryThread );
primaryThread = null;
}
}
}
public void queueEvent( TclEvent evt, int position )
// One of TCL.QUEUE_TAIL,
// TCL.QUEUE_HEAD or TCL.QUEUE_MARK.
{
lock ( this )
{
evt.notifier = this;
 
if ( position == TCL.QUEUE_TAIL )
{
// Append the event on the end of the queue.
 
evt.next = null;
 
if ( firstEvent == null )
{
firstEvent = evt;
}
else
{
lastEvent.next = evt;
}
lastEvent = evt;
}
else if ( position == TCL.QUEUE_HEAD )
{
// Push the event on the head of the queue.
 
evt.next = firstEvent;
if ( firstEvent == null )
{
lastEvent = evt;
}
firstEvent = evt;
}
else if ( position == TCL.QUEUE_MARK )
{
// Insert the event after the current marker event and advance
// the marker to the new event.
 
if ( markerEvent == null )
{
evt.next = firstEvent;
firstEvent = evt;
}
else
{
evt.next = markerEvent.next;
markerEvent.next = evt;
}
markerEvent = evt;
if ( evt.next == null )
{
lastEvent = evt;
}
}
else
{
// Wrong flag.
 
throw new TclRuntimeError( "wrong position \"" + position + "\", must be TCL.QUEUE_HEAD, TCL.QUEUE_TAIL or TCL.QUEUE_MARK" );
}
 
if ( System.Threading.Thread.CurrentThread != primaryThread )
{
System.Threading.Monitor.PulseAll( this );
}
}
}
public void deleteEvents( EventDeleter deleter )
// The deleter that checks whether an event
// should be removed.
{
lock ( this )
{
TclEvent evt, prev;
TclEvent servicedEvent = null;
 
// Handle the special case of deletion of a single event that was just
// processed by the serviceEvent() method.
 
if ( deleter == this )
{
servicedEvent = this.servicedEvent;
if ( servicedEvent == null )
throw new TclRuntimeError( "servicedEvent was not set by serviceEvent()" );
this.servicedEvent = null;
}
 
for ( prev = null, evt = firstEvent; evt != null; evt = evt.next )
{
if ( ( ( servicedEvent == null ) && ( deleter.deleteEvent( evt ) == 1 ) ) || ( evt == servicedEvent ) )
{
if ( evt == firstEvent )
{
firstEvent = evt.next;
}
else
{
prev.next = evt.next;
}
if ( evt.next == null )
{
lastEvent = prev;
}
if ( evt == markerEvent )
{
markerEvent = prev;
}
if ( evt == servicedEvent )
{
servicedEvent = null;
break; // Just service this one event in the special case
}
}
else
{
prev = evt;
}
}
if ( servicedEvent != null )
{
throw new TclRuntimeError( "servicedEvent was not removed from the queue" );
}
}
}
public int deleteEvent( TclEvent evt )
{
throw new TclRuntimeError( "The Notifier.deleteEvent() method should not be called" );
}
internal int serviceEvent( int flags )
// Indicates what events should be processed.
// May be any combination of TCL.WINDOW_EVENTS
// TCL.FILE_EVENTS, TCL.TIMER_EVENTS, or other
// flags defined elsewhere. Events not
// matching this will be skipped for processing
// later.
{
TclEvent evt;
 
// No event flags is equivalent to TCL_ALL_EVENTS.
 
if ( ( flags & TCL.ALL_EVENTS ) == 0 )
{
flags |= TCL.ALL_EVENTS;
}
 
// Loop through all the events in the queue until we find one
// that can actually be handled.
 
evt = null;
while ( ( evt = getAvailableEvent( evt ) ) != null )
{
// Call the handler for the event. If it actually handles the
// event then free the storage for the event. There are two
// tricky things here, both stemming from the fact that the event
// code may be re-entered while servicing the event:
//
// 1. Set the "isProcessing" field to true. This is a signal to
// ourselves that we shouldn't reexecute the handler if the
// event loop is re-entered.
// 2. When freeing the event, must search the queue again from the
// front to find it. This is because the event queue could
// change almost arbitrarily while handling the event, so we
// can't depend on pointers found now still being valid when
// the handler returns.
 
evt.isProcessing = true;
 
if ( evt.processEvent( flags ) != 0 )
{
evt.isProcessed = true;
// Don't allocate/grab the monitor for the event unless sync()
// has been called in another thread. This is thread safe
// since sync() checks the isProcessed flag before calling wait.
if ( evt.needsNotify )
{
lock ( evt )
{
System.Threading.Monitor.PulseAll( evt );
}
}
// Remove this specific event from the queue
servicedEvent = evt;
deleteEvents( this );
return 1;
}
else
{
// The event wasn't actually handled, so we have to
// restore the isProcessing field to allow the event to be
// attempted again.
 
evt.isProcessing = false;
}
 
// The handler for this event asked to defer it. Just go on to
// the next event.
 
continue;
}
return 0;
}
private TclEvent getAvailableEvent( TclEvent skipEvent )
// Indicates that the given event should not
// be returned. This argument can be null.
{
lock ( this )
{
TclEvent evt;
 
for ( evt = firstEvent; evt != null; evt = evt.next )
{
if ( ( evt.isProcessing == false ) && ( evt.isProcessed == false ) && ( evt != skipEvent ) )
{
return evt;
}
}
return null;
}
}
public int doOneEvent( int flags )
// Miscellaneous flag values: may be any
// combination of TCL.DONT_WAIT,
// TCL.WINDOW_EVENTS, TCL.FILE_EVENTS,
// TCL.TIMER_EVENTS, TCL.IDLE_EVENTS,
// or others defined by event sources.
{
int result = 0;
 
// No event flags is equivalent to TCL_ALL_EVENTS.
 
if ( ( flags & TCL.ALL_EVENTS ) == 0 )
{
flags |= TCL.ALL_EVENTS;
}
 
// The core of this procedure is an infinite loop, even though
// we only service one event. The reason for this is that we
// may be processing events that don't do anything inside of Tcl.
 
while ( true )
{
// If idle events are the only things to service, skip the
// main part of the loop and go directly to handle idle
// events (i.e. don't wait even if TCL_DONT_WAIT isn't set).
 
if ( ( flags & TCL.ALL_EVENTS ) == TCL.IDLE_EVENTS )
{
return serviceIdle();
}
 
long sysTime = ( System.DateTime.Now.Ticks - 621355968000000000 ) / 10000;
 
// If some timers have been expired, queue them into the
// event queue. We can't process expired times right away,
// because there may already be other events on the queue.
 
if ( !timerPending && ( timerList.Count > 0 ) )
{
TimerHandler h = (TimerHandler)timerList[0];
 
if ( h.atTime <= sysTime )
{
TimerEvent Tevent = new TimerEvent();
Tevent.notifier = this;
queueEvent( Tevent, TCL.QUEUE_TAIL );
timerPending = true;
}
}
 
// Service a queued event, if there are any.
 
if ( serviceEvent( flags ) != 0 )
{
result = 1;
break;
}
 
// There is no event on the queue. Check for idle events.
 
if ( ( flags & TCL.IDLE_EVENTS ) != 0 )
{
if ( serviceIdle() != 0 )
{
result = 1;
break;
}
}
 
if ( ( flags & TCL.DONT_WAIT ) != 0 )
{
break;
}
 
// We don't have any event to service. We'll wait if
// TCL.DONT_WAIT. When the following wait() call returns,
// one of the following things may happen:
//
// (1) waitTime milliseconds has elasped (if waitTime != 0);
//
// (2) The primary notifier has been notify()'ed by other threads:
// (a) an event is queued by queueEvent().
// (b) a timer handler was created by new TimerHandler();
// (c) an idle handler was created by new IdleHandler();
// (3) We receive an InterruptedException.
//
 
try
{
// Don't acquire the monitor until we are about to wait
// for notification from another thread. It is critical
// that this entire method not be synchronized since
// a call to processEvent via serviceEvent could take
// a very long time. We don't want the monitor held
// during that time since that would force calls to
// queueEvent in other threads to wait.
 
lock ( this )
{
if ( timerList.Count > 0 )
{
TimerHandler h = (TimerHandler)timerList[0];
long waitTime = h.atTime - sysTime;
if ( waitTime > 0 )
{
System.Threading.Monitor.Wait( this, TimeSpan.FromMilliseconds( waitTime ) );
}
}
else
{
System.Threading.Monitor.Wait( this );
}
} // synchronized (this)
}
catch ( System.Threading.ThreadInterruptedException e )
{
// We ignore any InterruptedException and loop continuously
// until we receive an event.
}
}
 
return result;
}
private int serviceIdle()
{
int result = 0;
int gen = idleGeneration;
idleGeneration++;
 
// The code below is trickier than it may look, for the following
// reasons:
//
// 1. New handlers can get added to the list while the current
// one is being processed. If new ones get added, we don't
// want to process them during this pass through the list (want
// to check for other work to do first). This is implemented
// using the generation number in the handler: new handlers
// will have a different generation than any of the ones currently
// on the list.
// 2. The handler can call doOneEvent, so we have to remove
// the handler from the list before calling it. Otherwise an
// infinite loop could result.
 
while ( idleList.Count > 0 )
{
IdleHandler h = (IdleHandler)idleList[0];
if ( h.generation > gen )
{
break;
}
idleList.RemoveAt( 0 );
if ( h.invoke() != 0 )
{
result = 1;
}
}
 
return result;
}
static Notifier()
{
notifierTable = new Hashtable();
}
} // end Notifier
 
class TimerEvent : TclEvent
{
 
// The notifier what owns this TimerEvent.
 
new internal Notifier notifier;
 
public override int processEvent( int flags )
// Same as flags passed to Notifier.doOneEvent.
{
if ( ( flags & TCL.TIMER_EVENTS ) == 0 )
{
return 0;
}
 
long sysTime = ( System.DateTime.Now.Ticks - 621355968000000000 ) / 10000;
int gen = notifier.timerGeneration;
notifier.timerGeneration++;
 
// The code below is trickier than it may look, for the following
// reasons:
//
// 1. New handlers can get added to the list while the current
// one is being processed. If new ones get added, we don't
// want to process them during this pass through the list to
// avoid starving other event sources. This is implemented
// using the timer generation number: new handlers will have
// a newer generation number than any of the ones currently on
// the list.
// 2. The handler can call doOneEvent, so we have to remove
// the handler from the list before calling it. Otherwise an
// infinite loop could result.
// 3. Because we only fetch the current time before entering the loop,
// the only way a new timer will even be considered runnable is if
// its expiration time is within the same millisecond as the
// current time. This is fairly likely on Windows, since it has
// a course granularity clock. Since timers are placed
// on the queue in time order with the most recently created
// handler appearing after earlier ones with the same expiration
// time, we don't have to worry about newer generation timers
// appearing before later ones.
 
while ( notifier.timerList.Count > 0 )
{
TimerHandler h = (TimerHandler)notifier.timerList[0];
if ( h.generation > gen )
{
break;
}
if ( h.atTime > sysTime )
{
break;
}
notifier.timerList.RemoveAt( 0 );
h.invoke();
}
 
notifier.timerPending = false;
return 1;
}
} // end TimerEvent
}
/trunk/TCL/src/base/ParseResult.cs
@@ -0,0 +1,69 @@
/*
* ParseResult.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ParseResult.java,v 1.3 2003/01/09 02:15:39 mdejong Exp $
*
*/
using System.Text;
namespace tcl.lang
{
 
/// <summary> This class stores a single word that's generated inside the Tcl parser
/// inside the Interp class.
/// </summary>
public class ParseResult
{
 
/// <summary> The value of a parse operation. For calls to Interp.intEval(),
/// this variable is the same as interp.m_result. The ref count
/// has been incremented, so the user will need to explicitly
/// invoke release() to drop the ref.
/// </summary>
public TclObject value;
 
/// <summary> Points to the next character to be parsed.</summary>
public int nextIndex;
 
/// <summary> Create an empty parsed word.</summary>
internal ParseResult()
{
value = TclString.newInstance( "" );
value.preserve();
}
 
internal ParseResult( string s, int ni )
{
value = TclString.newInstance( s );
value.preserve();
nextIndex = ni;
}
 
/// <summary> Assume that the caller has already preserve()'ed the TclObject.</summary>
internal ParseResult( TclObject o, int ni )
{
value = o;
nextIndex = ni;
}
 
internal ParseResult( StringBuilder sbuf, int ni )
{
value = TclString.newInstance( sbuf.ToString() );
value.preserve();
nextIndex = ni;
}
 
public void release()
{
value.release();
}
}
}
/trunk/TCL/src/base/Parser.cs
@@ -0,0 +1,2199 @@
#undef DEBUG
 
/*
* Parser.java --
*
* This class contains methods that parse Tcl scripts. They
* do so in a general-purpose fashion that can be used for many
* different purposes, including compilation, direct execution,
* code analysis, etc. This class also includes a few additional
* procedures such as evalObjv, eval, and eval2, which allow
* scripts to be evaluated directly, without compiling.
*
* Copyright (c) 1998 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: Parser.java,v 1.17 2003/07/25 17:41:53 mdejong Exp $
*/
using System;
using System.Diagnostics;
namespace tcl.lang
{
 
public class Parser
{
public static TclParse parseCommand( Interp interp, char[] script_array, int script_index, int numBytes, string fileName, int lineNum, bool nested )
// True means that this is a nested command:
// close bracket should be considered
// a command terminator. If false, then close
// bracket has no special meaning.
{
 
char cur; //the char we are currently parsing
int type; // Result returned by charType(src.charAt()).
TclToken token; // Pointer to token being filled in.
int wordIndex; // Index of word token for current word.
int level; // Nesting level of curly braces: gives
// number of right braces we must find to
// end word.
TclParse parse; // Return value to fill in with information
// about the parsed command.
int terminators; // charType() bits that indicate the end
// of a command.
BackSlashResult bs; // Result of a call to backslash(...).
int endIndex; // Index that points to the character after
// the last character to be parsed.
char savedChar; // To terminate the parsing correctly, the
// character at endIndex is set to \0. This
// stores the value to return when finished.
 
 
int saved_script_index = script_index; //save the original index
 
 
int script_length = script_array.Length - 1;
 
 
if ( numBytes < 0 )
{
numBytes = script_length - script_index;
}
endIndex = script_index + numBytes;
if ( endIndex > script_length )
{
endIndex = script_length;
}
 
savedChar = script_array[endIndex];
script_array[endIndex] = '\x0000';
 
parse = new TclParse( interp, script_array, endIndex, fileName, lineNum );
 
if ( nested )
{
terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK;
}
else
{
terminators = TYPE_COMMAND_END;
}
 
// Parse any leading space and comments before the first word of the
// command.
 
 
try
{
 
while ( true )
{
 
cur = script_array[script_index];
 
while ( ( ( cur <= TYPE_MAX ) && ( typeTable[cur] == TYPE_SPACE ) ) || ( cur == '\n' ) )
{
cur = script_array[++script_index];
}
 
if ( ( cur == '\\' ) && ( script_array[script_index + 1] == '\n' ) )
{
 
// Skip backslash-newline sequence: it should be treated
// just like white space.
 
if ( ( script_index + 2 ) == parse.endIndex )
{
parse.incomplete = true;
}
 
//this will add 2 to the offset and return to the top
//of the while(true) loop which will get the next cur
 
script_index += 2;
continue;
}
 
// If we have found the start of a command goto the word parsing loop
if ( cur != '#' )
{
break;
}
 
// Record the index where the comment starts
if ( parse.commentStart < 0 )
{
parse.commentStart = script_index;
}
 
while ( true )
{
cur = script_array[script_index];
if ( script_index == parse.endIndex )
{
if ( nested )
parse.incomplete = true;
parse.commentSize = script_index - parse.commentStart;
break;
}
else if ( cur == '\\' )
{
if ( ( script_array[script_index + 1] == '\n' ) && ( ( script_index + 2 ) == parse.endIndex ) )
{
parse.incomplete = true;
}
bs = backslash( script_array, script_index );
script_index = bs.nextIndex;
}
else if ( cur == '\n' )
{
script_index++;
parse.commentSize = script_index - parse.commentStart;
break;
}
else
{
script_index++;
}
}
}
 
 
 
// The following loop parses the words of the command, one word
// in each iteration through the loop.
 
parse.commandStart = script_index;
 
while ( true )
{
 
bool expandWord = false;
 
// Create the token for the word.
wordIndex = parse.numTokens;
 
token = parse.getToken( wordIndex );
token.type = TCL_TOKEN_WORD;
 
// Skip white space before the word. Also skip a backslash-newline
// sequence: it should be treated just like white space.
 
 
while ( true )
{
cur = script_array[script_index];
type = ( ( cur > TYPE_MAX ) ? TYPE_NORMAL : typeTable[cur] );
 
if ( type == TYPE_SPACE )
{
script_index++;
continue;
}
else if ( ( cur == '\\' ) && ( script_array[script_index + 1] == '\n' ) )
{
if ( ( script_index + 2 ) == parse.endIndex )
{
parse.incomplete = true;
}
bs = backslash( script_array, script_index );
script_index = bs.nextIndex;
continue;
}
break;
}
 
if ( ( type & terminators ) != 0 )
{
script_index++;
break;
}
 
if ( script_index == parse.endIndex )
{
if ( nested && savedChar != ']' )
{
parse.incomplete = true;
throw new TclException( interp, "missing close-bracket" );
}
break;
}
 
token.script_array = script_array;
token.script_index = script_index;
 
parse.numTokens++;
parse.numWords++;
 
 
// At this point the word can have one of four forms: something
// enclosed in quotes, something enclosed in braces, and
// expanding word, or an unquoted word (anything else).
 
parseWord:
cur = script_array[script_index];
 
if ( cur == '"' )
{
script_index++;
parse = parseTokens( script_array, script_index, TYPE_QUOTE, parse );
if ( parse.result != TCL.CompletionCode.OK )
{
throw new TclException( parse.result );
}
if ( parse.inString[parse.termIndex] != '"' )
{
parse.termIndex = script_index - 1;
parse.incomplete = true;
throw new TclException( parse.interp, "missing \"" );
}
script_index = parse.termIndex + 1;
}
else if ( cur == '{' )
{
/*
* Hack for {*}
* Check whether the braces contained the word expansion prefix.
*/
if ( script_index < script_array.Length - 3 // only if there is room
&& script_array[script_index + 1] == '*' && script_array[script_index + 2] == '}' // and it is {*}
&& typeTable[script_array[script_index + 1]] != TYPE_SPACE /* Non-whitespace follows */
&& !expandWord // only one per token
)
{
script_index += 3; // Skip
expandWord = true;
//parse.numTokens--;
goto parseWord;
}
 
// Find the matching right brace that terminates the word,
// then generate a single token for everything between the
// braces.
 
script_index++;
token = parse.getToken( parse.numTokens );
token.type = TCL_TOKEN_TEXT;
token.script_array = script_array;
token.script_index = script_index;
token.numComponents = 0;
level = 1;
while ( true )
{
cur = script_array[script_index];
 
// get the current char in the array and lookup its type
while ( ( ( cur > TYPE_MAX ) ? TYPE_NORMAL : typeTable[cur] ) == TYPE_NORMAL )
{
cur = script_array[++script_index];
}
if ( script_array[script_index] == '}' )
{
level--;
if ( level == 0 )
{
break;
}
script_index++;
}
else if ( script_array[script_index] == '{' )
{
level++;
script_index++;
}
else if ( script_array[script_index] == '\\' )
{
bs = backslash( script_array, script_index );
if ( script_array[script_index + 1] == '\n' )
{
// A backslash-newline sequence requires special
// treatment: it must be collapsed, even inside
// braces, so we have to split the word into
// multiple tokens so that the backslash-newline
// can be represented explicitly.
 
if ( ( script_index + 2 ) == parse.endIndex )
{
parse.incomplete = true;
}
token.size = script_index - token.script_index;
if ( token.size != 0 )
{
parse.numTokens++;
}
token = parse.getToken( parse.numTokens );
token.type = TCL_TOKEN_BS;
token.script_array = script_array;
token.script_index = script_index;
token.size = bs.nextIndex - script_index;
token.numComponents = 0;
parse.numTokens++;
script_index = bs.nextIndex;
token = parse.getToken( parse.numTokens );
token.type = TCL_TOKEN_TEXT;
token.script_array = script_array;
token.script_index = script_index;
token.numComponents = 0;
}
else
{
script_index = bs.nextIndex;
}
}
else if ( script_index == parse.endIndex )
{
parse.termIndex = parse.getToken( wordIndex ).script_index;
parse.incomplete = true;
throw new TclException( interp, "missing close-brace" );
}
else
{
script_index++;
}
}
if ( ( script_index != token.script_index ) || ( parse.numTokens == ( wordIndex + 1 ) ) )
{
token.size = script_index - token.script_index;
parse.numTokens++;
}
script_index++;
}
else
{
// This is an unquoted word. Call parseTokens and let it do
// all of the work.
 
parse = parseTokens( script_array, script_index, TYPE_SPACE | terminators, parse );
if ( parse.result != TCL.CompletionCode.OK )
{
throw new TclException( parse.result );
}
script_index = parse.termIndex;
}
 
// Finish filling in the token for the word and check for the
// special case of a word consisting of a single range of
// literal text.
 
token = parse.getToken( wordIndex );
token.size = script_index - token.script_index;
token.numComponents = parse.numTokens - ( wordIndex + 1 );
 
if ( expandWord )
{
int i = 1;
bool isLiteral = true;
 
/*
* When a command includes a word that is an expanded literal; for
* example, {*}{1 2 3}, the parser performs that expansion
* immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead
* of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand()
* caller might have to expand. This notably makes it simpler for
* those callers that wish to track line endings, such as those
* that implement key parts of TIP 280.
*
* First check whether the thing to be expanded is a literal,
* in the sense of being composed entirely of TCL_TOKEN_TEXT
* tokens.
*/
 
for ( i = 1; i <= token.numComponents; i++ )
{
if ( parse.getToken( wordIndex + i ).type != TCL_TOKEN_TEXT )//if (tokenPtr[i].type != TCL_TOKEN_TEXT)
{
isLiteral = false;
break;
}
}
 
if ( isLiteral )
{
int elemCount = 0;
FindElemResult code = null;
bool nakedbs = false;
int nextElem, listEnd;
int elemStart = 0;
 
/*
* The word to be expanded is a literal, so determine the
* boundaries of the literal string to be treated as a list
* and expanded. That literal string starts at
* tokenPtr[1].start, and includes all bytes up to, but not
* including (tokenPtr[token.numComponents].start +
* tokenPtr[token.numComponents].size)
*/
 
//listEnd = ( tokenPtr[tokenPtr->numComponents].start +
// tokenPtr[tokenPtr->numComponents].size );
listEnd = ( parse.getToken( wordIndex + token.numComponents ).script_index +
parse.getToken( wordIndex + token.numComponents ).size ) - 1;
nextElem = parse.getToken( wordIndex + token.numComponents ).script_index;//nextElem = tokenPtr[1].start;
 
 
/*
* Step through the literal string, parsing and counting list
* elements.
*/
 
string string_array = new string( token.script_array );
while ( nextElem < listEnd )
{
int size;
 
code = Util.findElement( null, string_array, nextElem, listEnd );
//code = TclFindElement(NULL, nextElem, listEnd - nextElem,
// &elemStart, &nextElem, &size, &brace);
if ( code == null )
{
break;
}
if ( !code.brace )
{
size = code.size;
elemStart = nextElem;
int s;
 
for ( s = elemStart; size > 0; s++, size-- )
{
if ( token.script_array[s] == '\\' )
{
nakedbs = true;
break;
}
}
}
elemCount++;
nextElem = code.elemEnd;
}
 
if ( ( code == null ) || nakedbs )
{
/*
* Some list element could not be parsed, or contained
* naked backslashes. This means the literal string was
* not in fact a valid nor canonical list. Defer the
* handling of this to compile/eval time, where code is
* already in place to report the "attempt to expand a
* non-list" error or expand lists that require
* substitution.
*/
 
token.type = TCL_TOKEN_EXPAND_WORD;
}
else if ( elemCount == 0 )
{
/*
* We are expanding a literal empty list. This means that
* the expanding word completely disappears, leaving no
* word generated this pass through the loop. Adjust
* accounting appropriately.
*/
 
parse.numWords--;
parse.numTokens = wordIndex;
}
else
{
/*
* Recalculate the number of Tcl_Tokens needed to store
* tokens representing the expanded list.
*/
 
int growthNeeded = wordIndex + 2 * elemCount
- parse.numTokens;
parse.numWords += elemCount - 1;
if ( growthNeeded > 0 )
{
parse.expandTokenArray( growthNeeded );// TclGrowParseTokenArray( parse, growthNeeded );
token = parse.getToken( wordIndex );//&parsePtr->tokenPtr[wordIndex];
}
parse.numTokens = wordIndex + 2 * elemCount;
 
 
/*
* Generate a TCL_TOKEN_SIMPLE_WORD token sequence for
* each element of the literal list we are expanding in
* place. Take care with the start and size fields of each
* token so they point to the right literal characters in
* the original script to represent the right expanded
* word value.
*/
 
nextElem = parse.getToken( wordIndex ).script_index;//tokenPtr[1].start;
while ( token.script_array[nextElem] == ' ' )//isspace( UCHAR( *nextElem ) ) )
{
nextElem++;
}
while ( nextElem < listEnd )
{
token.type = TCL_TOKEN_SIMPLE_WORD;
token.numComponents = 1;
token.script_index = nextElem;
 
token = parse.getToken( ++wordIndex );// tokenPtr++;
token.type = TCL_TOKEN_TEXT;
token.numComponents = 0;
code = Util.findElement( null, string_array, nextElem, listEnd );
//TclFindElement(NULL, nextElem, listEnd - nextElem,
// &(tokenPtr->start), &nextElem,
// &(tokenPtr->size), NULL);
token.script_index = nextElem + ( code.brace ? 1 : 0 );
token.size = code.size;
nextElem = code.elemEnd;
if ( token.script_index + token.size == listEnd )
{
parse.getToken( wordIndex - 1 ).size = listEnd - parse.getToken( wordIndex - 1 ).script_index;//tokenPtr[-1].size = listEnd - tokenPtr[-1].start;
}
else
{
//tokenPtr[-1].size = tokenPtr->start
// + tokenPtr->size - tokenPtr[-1].start;
parse.getToken( wordIndex - 1 ).size = token.script_index
+ token.size - parse.getToken( wordIndex - 1 ).script_index;
if ( script_index + token.size < token.script_array.Length &&
( token.script_array[script_index + token.size] == ' ' ) )
parse.getToken( wordIndex - 1 ).size += 1;
// tokenPtr[-1].size += ( isspace( UCHAR(
//tokenPtr->start[tokenPtr->size] ) ) == 0 );
}
 
token = parse.getToken( ++wordIndex );// tokenPtr++;
}
}
}
else
{
/*
* The word to be expanded is not a literal, so defer
* expansion to compile/eval time by marking with a
* TCL_TOKEN_EXPAND_WORD token.
*/
 
token.type = TCL_TOKEN_EXPAND_WORD;
}
}
else if ( ( token.numComponents == 1 ) && ( parse.getToken( wordIndex + 1 ).type == TCL_TOKEN_TEXT ) )
{
token.type = TCL_TOKEN_SIMPLE_WORD;
}
 
 
// Do two additional checks: (a) make sure we're really at the
// end of a word (there might have been garbage left after a
// quoted or braced word), and (b) check for the end of the
// command.
 
cur = script_array[script_index];
type = ( ( cur > TYPE_MAX ) ? TYPE_NORMAL : typeTable[cur] );
 
if ( type == TYPE_SPACE )
{
script_index++;
continue;
}
else
{
// Backslash-newline (and any following white space) must be
// treated as if it were a space character.
 
if ( ( cur == '\\' ) && ( script_array[script_index + 1] == '\n' ) )
{
if ( ( script_index + 2 ) == parse.endIndex )
{
parse.incomplete = true;
}
bs = backslash( script_array, script_index );
script_index = bs.nextIndex;
continue;
}
}
 
if ( ( type & terminators ) != 0 )
{
script_index++;
break;
}
if ( script_index == parse.endIndex )
{
if ( nested && savedChar != ']' )
{
parse.incomplete = true;
throw new TclException( interp, "missing close-bracket" );
}
break;
}
parse.termIndex = script_index;
if ( script_array[script_index - 1] == '"' )
{
throw new TclException( interp, "extra characters after close-quote" );
}
else
{
throw new TclException( interp, "extra characters after close-brace" );
}
}
}
catch ( TclException e )
{
script_array[endIndex] = savedChar;
if ( parse.commandStart < 0 )
{
parse.commandStart = saved_script_index;
}
parse.commandSize = parse.termIndex - parse.commandStart;
parse.result = TCL.CompletionCode.ERROR;
return parse;
}
 
script_array[endIndex] = savedChar;
parse.commandSize = script_index - parse.commandStart;
parse.result = TCL.CompletionCode.OK;
return parse;
}
 
 
 
 
 
 
 
 
 
 
 
internal static TclParse parseTokens( char[] script_array, int script_index, int mask, TclParse parse )
// Information about parse in progress.
// Updated with additional tokens and
// termination information.
{
char cur;
int type, originalTokens, varToken;
TclToken token;
TclParse nested;
BackSlashResult bs;
 
 
 
#if DEBUG
System.Diagnostics.Debug.WriteLine();
System.Diagnostics.Debug.WriteLine("Entered Parser.parseTokens()");
System.Diagnostics.Debug.Write("now to parse the string \"");
for (int k = script_index; k < script_array.Length; k++)
{
System.Diagnostics.Debug.Write(script_array[k]);
}
System.Diagnostics.Debug.WriteLine("\"");
#endif
 
 
// Each iteration through the following loop adds one token of
// type TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or
// TCL_TOKEN_VARIABLE to parse. For TCL_TOKEN_VARIABLE additional,
// tokens tokens are added for the parsed variable name.
 
originalTokens = parse.numTokens;
while ( true )
{
token = parse.getToken( parse.numTokens );
token.script_array = script_array;
token.script_index = script_index;
token.numComponents = 0;
 
#if DEBUG
System.Diagnostics.Debug.WriteLine();
System.Diagnostics.Debug.WriteLine("Now on index " + script_index);
char tmp_c = script_array[script_index];
System.Diagnostics.Debug.WriteLine("Char is '" + tmp_c + "'");
System.Diagnostics.Debug.WriteLine("Unicode id is " + ((int) tmp_c));
int tmp_i = ((int) ((tmp_c > TYPE_MAX)?TYPE_NORMAL:typeTable[tmp_c]));
System.Diagnostics.Debug.WriteLine("Type is " + tmp_i);
System.Diagnostics.Debug.WriteLine("Mask is " + mask);
System.Diagnostics.Debug.WriteLine("(type & mask) is " + ((int) (tmp_i & mask)));
System.Diagnostics.Debug.WriteLine("orig token.size is " + token.size);
#endif
 
 
cur = script_array[script_index];
type = ( ( cur > TYPE_MAX ) ? TYPE_NORMAL : typeTable[cur] );
 
if ( ( type & mask ) != 0 )
{
System.Diagnostics.Debug.WriteLine( "mask break" );
break;
}
 
if ( ( type & TYPE_SUBS ) == 0 )
{
// This is a simple range of characters. Scan to find the end
// of the range.
 
System.Diagnostics.Debug.WriteLine( "simple range" );
 
while ( true )
{
cur = script_array[++script_index];
type = ( ( cur > TYPE_MAX ) ? TYPE_NORMAL : typeTable[cur] );
 
System.Diagnostics.Debug.WriteLine( "skipping '" + cur + "'" );
 
if ( ( type & ( mask | TYPE_SUBS ) ) != 0 )
{
break;
}
}
token.type = TCL_TOKEN_TEXT;
token.size = script_index - token.script_index;
parse.numTokens++;
 
System.Diagnostics.Debug.WriteLine( "end simple range" );
System.Diagnostics.Debug.WriteLine( "token.size is " + token.size );
System.Diagnostics.Debug.WriteLine( "parse.numTokens is " + parse.numTokens );
}
else if ( cur == '$' )
{
// This is a variable reference. Call parseVarName to do
// all the dirty work of parsing the name.
 
System.Diagnostics.Debug.WriteLine( "dollar sign" );
 
varToken = parse.numTokens;
parse = parseVarName( parse.interp, script_array, script_index, parse.endIndex - script_index, parse, true );
if ( parse.result != TCL.CompletionCode.OK )
{
return parse;
}
script_index += parse.getToken( varToken ).size;
}
else if ( cur == '[' )
{
// Command substitution. Call parseCommand recursively
// (and repeatedly) to parse the nested command(s), then
// throw away the parse information.
 
System.Diagnostics.Debug.WriteLine( "command" );
 
script_index++;
while ( true )
{
nested = parseCommand( parse.interp, script_array, script_index, parse.endIndex - script_index, parse.fileName, parse.lineNum, true );
if ( nested.result != TCL.CompletionCode.OK )
{
parse.termIndex = nested.termIndex;
parse.incomplete = nested.incomplete;
parse.result = nested.result;
return parse;
}
script_index = nested.commandStart + nested.commandSize;
if ( ( script_array[script_index - 1] == ']' ) && !nested.incomplete )
{
break;
}
if ( script_index == parse.endIndex )
{
if ( parse.interp != null )
{
parse.interp.setResult( "missing close-bracket" );
}
parse.termIndex = token.script_index;
parse.incomplete = true;
parse.result = TCL.CompletionCode.ERROR;
return parse;
}
}
token.type = TCL_TOKEN_COMMAND;
token.size = script_index - token.script_index;
parse.numTokens++;
}
else if ( cur == '\\' )
{
// Backslash substitution.
 
System.Diagnostics.Debug.WriteLine( "backslash" );
 
if ( script_array[script_index + 1] == '\n' )
{
if ( ( script_index + 2 ) == parse.endIndex )
{
parse.incomplete = true;
}
 
// Note: backslash-newline is special in that it is
// treated the same as a space character would be. This
// means that it could terminate the token.
 
if ( ( mask & TYPE_SPACE ) != 0 )
{
break;
}
}
token.type = TCL_TOKEN_BS;
bs = backslash( script_array, script_index );
token.size = bs.nextIndex - script_index;
parse.numTokens++;
script_index += token.size;
}
else if ( cur == '\x0000' )
{
// We encountered a null character. If it is the null
// character at the end of the string, then return.
// Otherwise generate a text token for the single
// character.
 
System.Diagnostics.Debug.WriteLine( "null char" );
System.Diagnostics.Debug.WriteLine( "script_index is " + script_index );
System.Diagnostics.Debug.WriteLine( "parse.endIndex is " + parse.endIndex );
 
if ( script_index == parse.endIndex )
{
break;
}
 
token.type = TCL_TOKEN_TEXT;
token.size = 1;
parse.numTokens++;
script_index++;
}
else
{
throw new TclRuntimeError( "parseTokens encountered unknown character" );
}
} // end while (true)
 
 
if ( parse.numTokens == originalTokens )
{
// There was nothing in this range of text. Add an empty token
// for the empty range, so that there is always at least one
// token added.
 
System.Diagnostics.Debug.WriteLine( "empty token" );
 
token.type = TCL_TOKEN_TEXT;
token.size = 0;
parse.numTokens++;
}
else
{
System.Diagnostics.Debug.WriteLine( "non empty token case" );
}
 
parse.termIndex = script_index;
parse.result = TCL.CompletionCode.OK;
 
#if DEBUG
System.Diagnostics.Debug.WriteLine();
System.Diagnostics.Debug.WriteLine("Leaving Parser.parseTokens()");
System.Diagnostics.Debug.WriteLine("after parse, parse.numTokens is " + parse.numTokens);
System.Diagnostics.Debug.WriteLine("after parse, token.size is " + token.size);
System.Diagnostics.Debug.WriteLine("after parse, token.hashCode() is " + token.GetHashCode());
//System.out.println( parse.toString() );
System.Diagnostics.Debug.Write("printing " + (parse.numTokens - originalTokens) + " token(s)");
for (int k = originalTokens; k < parse.numTokens; k++)
{
token = parse.getToken(k);
System.Diagnostics.Debug.WriteLine(token);
}
System.Diagnostics.Debug.WriteLine("done printing tokens");
#endif
 
return parse;
}
 
public static void evalObjv( Interp interp, TclObject[] objv, int length, int flags )
{
Command cmd;
WrappedCommand wCmd = null;
TclObject[] newObjv;
int i;
CallFrame savedVarFrame; //Saves old copy of interp.varFrame
// in case TCL.EVAL_GLOBAL was set.
 
interp.resetResult();
if ( objv.Length == 0 )
{
return;
}
 
// If the interpreter was deleted, return an error.
 
if ( interp.deleted )
{
interp.setResult( "attempt to call eval in deleted interpreter" );
interp.setErrorCode( TclString.newInstance( "CORE IDELETE {attempt to call eval in deleted interpreter}" ) );
throw new TclException( TCL.CompletionCode.ERROR );
}
 
// Check depth of nested calls to eval: if this gets too large,
// it's probably because of an infinite loop somewhere.
 
if ( interp.nestLevel >= interp.maxNestingDepth )
{
throw new TclException( interp, "too many nested calls to eval (infinite loop?)" );
}
interp.nestLevel++;
 
try
{
// Find the procedure to execute this command. If there isn't one,
// then see if there is a command "unknown". If so, create a new
// word array with "unknown" as the first word and the original
// command words as arguments. Then call ourselves recursively
// to execute it.
 
 
cmd = interp.getCommand( objv[0].ToString() );
if ( cmd == null )
wCmd = interp.getObjCommand( objv[0].ToString() );
// See if we are running as a slave interpretor, and this is a windows command
if ( cmd == null && wCmd == null && interp.slave != null )
{
wCmd = interp.slave.masterInterp.getObjCommand( objv[0].ToString() );
}
if ( cmd == null && wCmd == null )
{
newObjv = new TclObject[objv.Length + 1];
for ( i = ( objv.Length - 1 ); i >= 0; i-- )
{
newObjv[i + 1] = objv[i];
}
newObjv[0] = TclString.newInstance( "unknown" );
newObjv[0].preserve();
cmd = interp.getCommand( "unknown" );
if ( cmd == null )
{
 
Debug.Assert( false, "invalid command name \"" + objv[0].ToString() + "\"" );
throw new TclException( interp, "invalid command name \"" + objv[0].ToString() + "\"" );
}
else
{
evalObjv( interp, newObjv, length, 0 );
}
newObjv[0].release();
return;
}
 
// Finally, invoke the Command's cmdProc.
 
interp.cmdCount++;
savedVarFrame = interp.varFrame;
if ( ( flags & TCL.EVAL_GLOBAL ) != 0 )
{
interp.varFrame = null;
}
 
int rc = 0;
if ( cmd != null )
{
if ( cmd.cmdProc( interp, objv ) == TCL.CompletionCode.EXIT )
throw new TclException( TCL.CompletionCode.EXIT );
}
else
{
rc = wCmd.objProc( wCmd.objClientData, interp, objv.Length, objv );
if ( rc != 0 )
{
if ( rc == TCL.TCL_RETURN )
throw new TclException( TCL.CompletionCode.RETURN );
throw new TclException( TCL.CompletionCode.ERROR );
}
}
interp.varFrame = savedVarFrame;
}
finally
{
interp.nestLevel--;
}
}
internal static void logCommandInfo( Interp interp, char[] script_array, int script_index, int cmdIndex, int length, TclException e )
// The exception caused by the script
// evaluation.
{
string ellipsis;
string msg;
int offset;
int pIndex;
 
if ( interp.errAlreadyLogged )
{
// Someone else has already logged error information for this
// command; we shouldn't add anything more.
 
return;
}
 
// Compute the line number where the error occurred.
// Note: The script array must be accessed directly
// because we want to count from the beginning of
// the script, not the current index.
 
interp.errorLine = 1;
 
for ( pIndex = 0; pIndex < cmdIndex; pIndex++ )
{
if ( script_array[pIndex] == '\n' )
{
interp.errorLine++;
}
}
 
 
// Create an error message to add to errorInfo, including up to a
// maximum number of characters of the command.
 
if ( length < 0 )
{
//take into account the trailing '\0'
int script_length = script_array.Length - 1;
 
length = script_length - cmdIndex;
}
if ( length > 150 )
{
offset = 150;
ellipsis = "...";
}
else
{
offset = length;
ellipsis = "";
}
 
msg = new string( script_array, cmdIndex, offset );
if ( !( interp.errInProgress ) )
{
interp.addErrorInfo( "\n while executing\n\"" + msg + ellipsis + "\"" );
}
else
{
interp.addErrorInfo( "\n invoked from within\n\"" + msg + ellipsis + "\"" );
}
interp.errAlreadyLogged = false;
e.errIndex = cmdIndex + offset;
}
internal static TclObject evalTokens( Interp interp, TclToken[] tokenList, int tIndex, int count )
{
TclObject result, index, value;
TclToken token;
string p = null;
string varName;
BackSlashResult bs;
 
// The only tricky thing about this procedure is that it attempts to
// avoid object creation and string copying whenever possible. For
// example, if the value is just a nested command, then use the
// command's result object directly.
 
result = null;
for ( ; count > 0; count-- )
{
token = tokenList[tIndex];
 
// The switch statement below computes the next value to be
// concat to the result, as either a range of text or an
// object.
 
value = null;
switch ( token.type )
{
 
case TCL_TOKEN_TEXT:
p = token.TokenString;
break;
 
 
case TCL_TOKEN_BS:
bs = backslash( token.script_array, token.script_index );
if ( bs.isWordSep )
{
p = "\\" + bs.c;
}
else
{
System.Char ch = bs.c;
p = ch.ToString();
}
break;
 
 
case TCL_TOKEN_COMMAND:
interp.evalFlags |= Parser.TCL_BRACKET_TERM;
token.script_index++;
 
//should the nest level be changed???
//interp.nestLevel++;
 
eval2( interp, token.script_array, token.script_index, token.size - 2, 0 );
 
token.script_index--;
//interp.nestLevel--;
value = interp.getResult();
break;
 
 
case TCL_TOKEN_VARIABLE:
if ( token.numComponents == 1 )
{
index = null;
}
else
{
index = evalTokens( interp, tokenList, tIndex + 2, token.numComponents - 1 );
if ( index == null )
{
return null;
}
}
varName = tokenList[tIndex + 1].TokenString;
 
// In order to get the existing expr parser to work with the
// new Parser, we test the interp.noEval flag which is set
// by the expr parser. If it is != 0, then we do not evaluate
// the variable. This should be removed when the new expr
// parser is implemented.
 
if ( interp.noEval == 0 )
{
if ( index != null )
{
try
{
 
value = interp.getVar( varName, index.ToString(), 0 );
}
finally
{
index.release();
}
}
else
{
value = interp.getVar( varName, null, 0 );
}
}
else
{
value = TclString.newInstance( "" );
value.preserve();
}
count -= token.numComponents;
tIndex += token.numComponents;
break;
 
 
default:
throw new TclRuntimeError( "unexpected token type in evalTokens" );
 
}
 
// If value isn't null, the next piece of text comes from that
// object; otherwise, take value of p.
 
if ( result == null )
{
if ( value != null )
{
result = value;
}
else
{
result = TclString.newInstance( p );
}
result.preserve();
}
else
{
if ( result.Shared )
{
result.release();
result = result.duplicate();
result.preserve();
}
if ( value != null )
{
 
p = value.ToString();
}
TclString.append( result, p );
}
tIndex++;
}
return result;
}
public static void eval2( Interp interp, char[] script_array, int script_index, int numBytes, int flags )
{
int i;
int objUsed = 0;
int nextIndex, tokenIndex;
int commandLength, bytesLeft;
bool nested;
TclObject[] objv;
TclObject obj;
TclParse parse = null;
TclToken token;
 
// Saves old copy of interp.varFrame in case TCL.EVAL_GLOBAL was set
CallFrame savedVarFrame;
 
// Take into account the trailing '\0'
int script_length = script_array.Length - 1;
 
 
// These are modified instead of script_array and script_index
char[] src_array = script_array;
int src_index = script_index;
 
#if DEBUG
System.Diagnostics.Debug.WriteLine();
System.Diagnostics.Debug.WriteLine("Entered eval2()");
System.Diagnostics.Debug.Write("now to eval2 the string \"");
for (int k = script_index; k < script_array.Length; k++)
{
System.Diagnostics.Debug.Write(script_array[k]);
}
System.Diagnostics.Debug.WriteLine("\"");
#endif
 
 
 
if ( numBytes < 0 )
{
numBytes = script_length - script_index;
}
interp.resetResult();
savedVarFrame = interp.varFrame;
if ( ( flags & TCL.EVAL_GLOBAL ) != 0 )
{
interp.varFrame = null;
}
 
// Each iteration through the following loop parses the next
// command from the script and then executes it.
 
bytesLeft = numBytes;
 
// Init objv with the most commonly used array size
objv = grabObjv( interp, 3 );
 
if ( ( interp.evalFlags & TCL_BRACKET_TERM ) != 0 )
{
nested = true;
}
else
{
nested = false;
}
interp.evalFlags &= ~TCL_BRACKET_TERM;
 
try
{
 
do
{
parse = parseCommand( interp, src_array, src_index, bytesLeft, null, 0, nested );
 
if ( parse.result != TCL.CompletionCode.OK )
{
throw new TclException( parse.result );
}
 
// The test on noEval is temporary. As soon as the new expr
// parser is implemented it should be removed.
 
if ( parse.numWords > 0 && interp.noEval == 0 )
{
// Generate an array of objects for the words of the command.
 
try
{
tokenIndex = 0;
token = parse.getToken( tokenIndex );
 
// Test to see if new space needs to be allocated. If objv
// is the EXACT size of parse.numWords, then no allocation
// needs to be performed.
 
if ( objv.Length != parse.numWords )
{
//System.out.println("need new size " + objv.length);
releaseObjv( interp, objv ); //let go of resource
objv = grabObjv( interp, parse.numWords ); //get new resource
}
else
{
//System.out.println("reusing size " + objv.length);
}
 
for ( objUsed = 0; objUsed < parse.numWords; objUsed++ )
{
obj = evalTokens( interp, parse.tokenList, tokenIndex + 1, token.numComponents );
if ( obj == null )
{
throw new TclException( TCL.CompletionCode.ERROR );
}
else
{
objv[objUsed] = obj;
if ( token.type == TCL_TOKEN_EXPAND_WORD )
{
int numElements;
int code;
TclList.setListFromAny( null, objv[objUsed] );
TclObject[] elements = TclList.getElements( null, objv[objUsed] );
if ( elements.Length == 0 )
{
elements = new TclObject[1];
elements[0] = TclString.newInstance("{}") ;
TclList.setListFromAny( null, elements[0] );
}
numElements = elements.Length;
/*
* Some word expansion was requested. Check for objv resize.
*/
 
int objIdx = objUsed + numElements - 1;
Array.Resize( ref objv, objIdx+1 );
while ( numElements-- != 0 )
{
objv[objIdx] = elements[numElements];
objv[objIdx].preserve();
objIdx--;
}
objUsed = objv.Length-1;
}
}
tokenIndex += ( token.numComponents + 1 );
token = parse.getToken( tokenIndex );
}
 
// Execute the command and free the objects for its words.
try
{
evalObjv( interp, objv, bytesLeft, 0 );
}
catch ( System.StackOverflowException e )
{
interp.setResult( "too many nested calls" + " to eval (infinite loop?)" );
throw new TclException( TCL.CompletionCode.ERROR );
}
}
catch ( TclException e )
{
// Generate various pieces of error information, such
// as the line number where the error occurred and
// information to add to the errorInfo variable. Then
// free resources that had been allocated
// to the command.
 
if ( e.getCompletionCode() == TCL.CompletionCode.ERROR && !( interp.errAlreadyLogged ) )
{
commandLength = parse.commandSize;
 
char term = script_array[parse.commandStart + commandLength - 1];
int type = charType( term );
int terminators;
if ( nested )
{
terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK;
}
else
{
terminators = TYPE_COMMAND_END;
}
if ( ( type & terminators ) != 0 )
{
// The command where the error occurred didn't end
// at the end of the script (i.e. it ended at a
// terminator character such as ";". Reduce the
// length by one so that the error message
// doesn't include the terminator character.
 
commandLength -= 1;
}
interp.varFrame = savedVarFrame;
logCommandInfo( interp, script_array, script_index, parse.commandStart, commandLength, e );
throw e;
}
else
throw;
}
finally
{
for ( i = 0; i < objUsed; i++ )
{
objv[i].release();
}
objUsed = 0;
 
parse.release(); // Cleanup parser resources
}
}
 
 
// Advance to the next command in the script.
 
nextIndex = parse.commandStart + parse.commandSize;
bytesLeft -= ( nextIndex - src_index );
src_index = nextIndex;
if ( nested && ( src_index > 1 ) && ( src_array[src_index - 1] == ']' ) )
{
 
// We get here in the special case where the TCL_BRACKET_TERM
// flag was set in the interpreter and we reached a close
// bracket in the script. Return immediately.
 
interp.termOffset = ( src_index - 1 ) - script_index;
interp.varFrame = savedVarFrame;
return;
}
}
while ( bytesLeft > 0 );
}
finally
{
if ( parse != null )
{
parse.release(); // Let go of parser resources
}
releaseObjv( interp, objv ); // Let go of objv buffer
}
 
interp.termOffset = src_index - script_index;
interp.varFrame = savedVarFrame;
return;
}
public static TclParse parseVarName( Interp interp, char[] script_array, int script_index, int numBytes, TclParse parse, bool append )
// Non-zero means append tokens to existing
// information in parse; zero means ignore
// existing tokens in parse and reinitialize
// it.
{
char cur;
TclToken token, startToken;
int endIndex, varIndex;
 
#if DEBUG
System.Diagnostics.Debug.WriteLine();
System.Diagnostics.Debug.WriteLine("Entered parseVarName()");
System.Diagnostics.Debug.Write("now to parse var off the string \"");
for (int k = script_index; k < script_array.Length; k++)
{
System.Diagnostics.Debug.Write(script_array[k]);
}
System.Diagnostics.Debug.WriteLine("\"");
#endif
 
 
if ( numBytes >= 0 )
{
endIndex = script_index + numBytes;
}
else
{
endIndex = script_array.Length - 1;
}
if ( !append )
{
parse = new TclParse( interp, script_array, endIndex, null, -1 );
}
 
// Generate one token for the variable, an additional token for the
// name, plus any number of additional tokens for the index, if
// there is one.
 
token = parse.getToken( parse.numTokens );
token.type = TCL_TOKEN_VARIABLE;
token.script_array = script_array;
token.script_index = script_index;
varIndex = parse.numTokens;
parse.numTokens++;
script_index++;
if ( script_index >= endIndex )
{
// The dollar sign isn't followed by a variable name.
// replace the TCL_TOKEN_VARIABLE token with a
// TCL_TOKEN_TEXT token for the dollar sign.
 
token.type = TCL_TOKEN_TEXT;
token.size = 1;
token.numComponents = 0;
parse.result = TCL.CompletionCode.OK;
return parse;
}
startToken = token;
token = parse.getToken( parse.numTokens );
 
// The name of the variable can have three forms:
// 1. The $ sign is followed by an open curly brace. Then
// the variable name is everything up to the next close
// curly brace, and the variable is a scalar variable.
// 2. The $ sign is not followed by an open curly brace. Then
// the variable name is everything up to the next
// character that isn't a letter, digit, or underscore.
// :: sequences are also considered part of the variable
// name, in order to support namespaces. If the following
// character is an open parenthesis, then the information
// between parentheses is the array element name.
// 3. The $ sign is followed by something that isn't a letter,
// digit, or underscore: in this case, there is no variable
// name and the token is just "$".
 
if ( script_array[script_index] == '{' )
{
System.Diagnostics.Debug.WriteLine( "parsing curley var name" );
 
script_index++;
token.type = TCL_TOKEN_TEXT;
token.script_array = script_array;
token.script_index = script_index;
token.numComponents = 0;
 
while ( true )
{
if ( script_index == endIndex )
{
if ( interp != null )
{
interp.setResult( "missing close-brace for variable name" );
}
parse.termIndex = token.script_index - 1;
parse.incomplete = true;
parse.result = TCL.CompletionCode.ERROR;
return parse;
}
if ( script_array[script_index] == '}' )
{
break;
}
script_index++;
}
token.size = script_index - token.script_index;
startToken.size = script_index - startToken.script_index;
parse.numTokens++;
script_index++;
}
else
{
System.Diagnostics.Debug.WriteLine( "parsing non curley var name" );
 
token.type = TCL_TOKEN_TEXT;
token.script_array = script_array;
token.script_index = script_index;
token.numComponents = 0;
while ( script_index != endIndex )
{
cur = script_array[script_index];
if ( ( System.Char.IsLetterOrDigit( cur ) ) || ( cur == '_' ) )
{
script_index++;
continue;
}
if ( ( cur == ':' ) && ( ( ( script_index + 1 ) != endIndex ) && ( script_array[script_index + 1] == ':' ) ) )
{
script_index += 2;
while ( ( script_index != endIndex ) && ( script_array[script_index] == ':' ) )
{
script_index++;
}
continue;
}
break;
}
token.size = script_index - token.script_index;
if ( token.size == 0 )
{
// The dollar sign isn't followed by a variable name.
// replace the TCL_TOKEN_VARIABLE token with a
// TCL_TOKEN_TEXT token for the dollar sign.
 
System.Diagnostics.Debug.WriteLine( "single $ with no var name found" );
 
startToken.type = TCL_TOKEN_TEXT;
startToken.size = 1;
startToken.numComponents = 0;
parse.result = TCL.CompletionCode.OK;
return parse;
}
parse.numTokens++;
if ( ( script_index != endIndex ) && ( script_array[script_index] == '(' ) )
{
// This is a reference to an array element. Call
// parseTokens recursively to parse the element name,
// since it could contain any number of substitutions.
 
System.Diagnostics.Debug.WriteLine( "parsing array element" );
 
script_index++;
parse = parseTokens( script_array, script_index, TYPE_CLOSE_PAREN, parse );
if ( parse.result != TCL.CompletionCode.OK )
{
return parse;
}
if ( ( parse.termIndex == endIndex ) || ( parse.inString[parse.termIndex] != ')' ) )
{
if ( interp != null )
{
interp.setResult( "missing )" );
}
parse.termIndex = script_index - 1;
parse.incomplete = true;
parse.result = TCL.CompletionCode.ERROR;
return parse;
}
script_index = parse.termIndex + 1;
}
}
 
 
#if DEBUG
System.Diagnostics.Debug.WriteLine("default end parse case");
System.Diagnostics.Debug.Write("var token is \"");
for (int k = startToken.script_index; k < script_index; k++)
{
System.Diagnostics.Debug.Write(script_array[k]);
}
System.Diagnostics.Debug.WriteLine("\"");
#endif
 
startToken.size = script_index - startToken.script_index;
startToken.numComponents = parse.numTokens - ( varIndex + 1 );
parse.result = TCL.CompletionCode.OK;
return parse;
}
 
 
public static ParseResult parseVar( Interp interp, string inString )
{
TclParse parse;
TclObject obj;
 
System.Diagnostics.Debug.WriteLine( "Entered parseVar()" );
System.Diagnostics.Debug.Write( "now to parse var off the string \"" + inString + "\"" );
 
 
CharPointer src = new CharPointer( inString );
parse = parseVarName( interp, src.array, src.index, -1, null, false );
if ( parse.result != TCL.CompletionCode.OK )
{
 
throw new TclException( interp, interp.getResult().ToString() );
}
 
try
{
System.Diagnostics.Debug.Write( "parsed " + parse.numTokens + " tokens" );
 
if ( parse.numTokens == 1 )
{
// There isn't a variable name after all: the $ is just a $.
return new ParseResult( "$", 1 );
}
 
obj = evalTokens( interp, parse.tokenList, 0, parse.numTokens );
if ( !obj.Shared )
{
throw new TclRuntimeError( "parseVar got temporary object from evalTokens" );
}
return new ParseResult( obj, parse.tokenList[0].size );
}
finally
{
parse.release(); // Release parser resources
}
}
internal static bool commandComplete( string inString, int length )
// Number of bytes in script.
{
TclParse parse;
 
CharPointer src = new CharPointer( inString );
 
do
{
parse = parseCommand( null, src.array, src.index, length, null, 0, false );
 
src.index = parse.commandStart + parse.commandSize;
 
parse.release(); // Release parser resources
 
if ( src.index >= length )
{
break;
}
}
while ( parse.result == TCL.CompletionCode.OK );
 
if ( parse.incomplete )
{
return false;
}
return true;
}
internal static bool objCommandComplete( TclObject obj )
// Points to object holding script
// to check.
{
 
string inString = obj.ToString();
return commandComplete( inString, inString.Length );
}
internal static BackSlashResult backslash( char[] script_array, int script_index )
{
int result;
 
script_index++;
int endIndex = script_array.Length - 1;
 
if ( script_index == endIndex )
{
return new BackSlashResult( '\\', script_index );
}
 
char c = script_array[script_index];
switch ( c )
{
 
case 'a':
return new BackSlashResult( (char)0x7, script_index + 1 );
 
case 'b':
return new BackSlashResult( (char)0x8, script_index + 1 );
 
case 'f':
return new BackSlashResult( (char)0xc, script_index + 1 );
 
case 'n':
return new BackSlashResult( '\n', script_index + 1 );
 
case 'r':
return new BackSlashResult( '\r', script_index + 1 );
 
case 't':
return new BackSlashResult( '\t', script_index + 1 );
 
case 'v':
return new BackSlashResult( (char)0xb, script_index + 1 );
 
case 'x':
script_index++;
if ( script_index < endIndex )
{
c = script_array[script_index];
 
if ( ( ( c >= '0' ) && ( c <= '9' ) ) || ( ( c >= 'A' ) && ( c <= 'F' ) ) || ( ( c >= 'a' ) && ( c <= 'f' ) ) )
{
 
string str = new string( script_array, script_index, endIndex - script_index );
StrtoulResult res = Util.strtoul( str, 0, 16 );
if ( res.errno == 0 )
{
// We force res.value to be a 8-bit (ASCII) character
// so that it is compatible with Tcl.
 
char b = (char)( res.value & 0xff );
return new BackSlashResult( b, script_index + res.index );
}
}
}
return new BackSlashResult( 'x', script_index );
 
case 'u': // TODO -- determine how to handle Unicode
int count, n;
result = 0;
for ( count = 0; count < 4; count++ )
{
script_index++;
c = script_array[script_index];
if ( ( ( c >= '0' ) && ( c <= '9' ) ) || ( ( c >= 'a' ) && ( c <= 'f' ) ) || ( ( c >= 'A' ) && ( c <= 'F' ) ) )
{
n = c - '0';
if ( n > 9 )
{
n = n + '0' + 10 - 'A';
}
if ( n > 16 )
{
n = n + 'A' - 'a';
}
result = ( result << 4 ) + n;
}
else
{
break;
}
}
if ( count == 0 )
{
result = 'u';
}
return new BackSlashResult( (char)result, script_index + 1 );
 
case '\r':
case '\n':
if ( c == '\r' )
{
if ( ( script_index + 1 ) < endIndex )
{
if ( script_array[script_index + 1] == '\n' )
{
script_index++;
}
}
}
do
{
script_index++;
c = script_array[script_index];
}
while ( ( script_index < endIndex ) && ( ( c == ' ' ) || ( c == '\t' ) ) );
return new BackSlashResult( (char)' ', script_index );
 
case (char)( 0 ):
return new BackSlashResult( (char)'\\', script_index + 1 );
 
default:
if ( ( c >= '0' ) && ( c <= '9' ) )
{
// Convert it to an octal number. This implementation is
// compatible with tcl 7.6 - characters 8 and 9 are allowed.
 
result = c - '0';
script_index++;
 
{
if ( script_index == endIndex )
{
goto getoctal_brk;
}
c = script_array[script_index];
if ( !( ( c >= '0' ) && ( c <= '9' ) ) )
{
goto getoctal_brk;
}
result = ( result * 8 ) + ( c - '0' );
script_index++;
 
if ( script_index == endIndex )
{
goto getoctal_brk;
}
c = script_array[script_index];
if ( !( ( c >= '0' ) && ( c <= '9' ) ) )
{
goto getoctal_brk;
}
result = ( result * 8 ) + ( c - '0' );
script_index++;
}
 
getoctal_brk:
;
 
 
// We force result to be a 8-bit (ASCII) character so
// that it compatible with Tcl 7.6.
 
return new BackSlashResult( (char)( result & 0xff ), script_index );
}
else
{
return new BackSlashResult( c, script_index + 1 );
}
}
}
 
 
 
 
 
 
internal static char charType( char c )
{
return ( ( c > TYPE_MAX ) ? TYPE_NORMAL : typeTable[c] );
}
 
// The following table provides parsing information about each possible
// character.
//
// The method charType is used to index into the table and return
// information about its character argument. The following return
// values are defined.
//
// TYPE_NORMAL - All characters that don't have special significance
// to the Tcl parser.
// TYPE_SPACE - The character is a whitespace character other
// than newline.
// TYPE_COMMAND_END - Character is newline or semicolon.
// TYPE_SUBS - Character begins a substitution or has other
// special meaning in parseTokens: backslash, dollar
// sign, open bracket, or null.
// TYPE_QUOTE - Character is a double quote.
// TYPE_CLOSE_PAREN - Character is a right parenthesis.
// TYPE_CLOSE_BRACK - Character is a right square bracket.
// TYPE_BRACE - Character is a curly brace (either left or right).
 
internal const char TYPE_NORMAL = (char)( 0 );
internal const char TYPE_SPACE = (char)( 0x1 );
internal const char TYPE_COMMAND_END = (char)( 0x2 );
internal const char TYPE_SUBS = (char)( 0x4 );
internal const char TYPE_QUOTE = (char)( 0x8 );
internal const char TYPE_CLOSE_PAREN = (char)( 0x10 );
internal const char TYPE_CLOSE_BRACK = (char)( 0x20 );
internal const char TYPE_BRACE = (char)( 0x40 );
 
// This is the largest value in the type table. If a
// char value is larger then the char type is TYPE_NORMAL.
// Lookup -> ((c > TYPE_MAX) ? TYPE_NORMAL : typeTable[c])
 
internal const char TYPE_MAX = (char)( 127 );
 
 
internal static char[] typeTable;
 
 
// Type values defined for TclToken structures. These values are
// defined as mask bits so that it's easy to check for collections of
// types.
//
// TCL_TOKEN_WORD - The token describes one word of a command,
// from the first non-blank character of
// the word (which may be " or {) up to but
// not including the space, semicolon, or
// bracket that terminates the word.
// NumComponents counts the total number of
// sub-tokens that make up the word. This
// includes, for example, sub-tokens of
// TCL_TOKEN_VARIABLE tokens.
// TCL_TOKEN_SIMPLE_WORD - This token is just like TCL_TOKEN_WORD
// except that the word is guaranteed to
// consist of a single TCL_TOKEN_TEXT
// sub-token.
// TCL_TOKEN_TEXT - The token describes a range of literal
// text that is part of a word.
// NumComponents is always 0.
// TCL_TOKEN_BS - The token describes a backslash sequence
// that must be collapsed. NumComponents
// is always 0.
// TCL_TOKEN_COMMAND - The token describes a command whose result
// must be substituted into the word. The
// token includes the enclosing brackets.
// NumComponents is always 0.
// TCL_TOKEN_VARIABLE - The token describes a variable
// substitution, including the dollar sign,
// variable name, and array index (if there
// is one) up through the right
// parentheses. NumComponents tells how
// many additional tokens follow to
// represent the variable name. The first
// token will be a TCL_TOKEN_TEXT token
// that describes the variable name. If
// the variable is an array reference then
// there will be one or more additional
// tokens, of type TCL_TOKEN_TEXT,
// TCL_TOKEN_BS, TCL_TOKEN_COMMAND, and
// TCL_TOKEN_VARIABLE, that describe the
// array index; numComponents counts the
// total number of nested tokens that make
// up the variable reference, including
// sub-tokens of TCL_TOKEN_VARIABLE tokens.
 
internal const int TCL_TOKEN_WORD = 1;
internal const int TCL_TOKEN_SIMPLE_WORD = 2;
internal const int TCL_TOKEN_TEXT = 4;
internal const int TCL_TOKEN_BS = 8;
internal const int TCL_TOKEN_COMMAND = 16;
internal const int TCL_TOKEN_VARIABLE = 32;
//#define TCL_TOKEN_SUB_EXPR 64
//#define TCL_TOKEN_OPERATOR 128
internal const int TCL_TOKEN_EXPAND_WORD = 256;
 
 
// Note: Most of the variables below will not be used until the
// Compilier is implemented, but are left for consistency.
 
// A structure of the following type is filled in by parseCommand.
// It describes a single command parsed from an input string.
 
// evalFlag bits for Interp structures:
//
// TCL_BRACKET_TERM 1 means that the current script is terminated by
// a close bracket rather than the end of the string.
// TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with
// a code other than TCL_OK or TCL_ERROR; 0 means
// codes other than these should be turned into errors.
 
public const int TCL_BRACKET_TERM = 1;
public const int TCL_ALLOW_EXCEPTIONS = 4;
 
// Flag bits for Interp structures:
//
// DELETED: Non-zero means the interpreter has been deleted:
// don't process any more commands for it, and destroy
// the structure as soon as all nested invocations of
// Tcl_Eval are done.
// ERR_IN_PROGRESS: Non-zero means an error unwind is already in
// progress. Zero means a command proc has been
// invoked since last error occurred.
// ERR_ALREADY_LOGGED: Non-zero means information has already been logged
// in $errorInfo for the current Tcl_Eval instance,
// so Tcl_Eval needn't log it (used to implement the
// "error message log" command).
// ERROR_CODE_SET: Non-zero means that Tcl_SetErrorCode has been
// called to record information for the current
// error. Zero means Tcl_Eval must clear the
// errorCode variable if an error is returned.
// EXPR_INITIALIZED: Non-zero means initialization specific to
// expressions has been carried out.
// DONT_COMPILE_CMDS_INLINE: Non-zero means that the bytecode compiler
// should not compile any commands into an inline
// sequence of instructions. This is set 1, for
// example, when command traces are requested.
// RAND_SEED_INITIALIZED: Non-zero means that the randSeed value of the
// interp has not be initialized. This is set 1
// when we first use the rand() or srand() functions.
// SAFE_INTERP: Non zero means that the current interp is a
// safe interp (ie it has only the safe commands
// installed, less priviledge than a regular interp).
// USE_EVAL_DIRECT: Non-zero means don't use the compiler or byte-code
// interpreter; instead, have Tcl_EvalObj call
// Tcl_EvalDirect. Used primarily for testing the
// new parser.
 
public const int DELETED = 1;
public const int ERR_IN_PROGRESS = 2;
public const int ERR_ALREADY_LOGGED = 4;
public const int ERROR_CODE_SET = 8;
public const int EXPR_INITIALIZED = 0x10;
public const int DONT_COMPILE_CMDS_INLINE = 0x20;
public const int RAND_SEED_INITIALIZED = 0x40;
public const int SAFE_INTERP = 0x80;
public const int USE_EVAL_DIRECT = 0x100;
 
 
 
 
 
 
// These are private read only values that are used by the parser
// class to implement a TclObject[] cache
 
// Max size of array to cache (1..N)
private const int OBJV_CACHE_MAX = 10;
 
// The number of array to cache for each size
// for example if the number of 3 elements is set to 5
// an array of 5 TclObject[] objects
// which will each be 3 elements long
 
private static readonly int[] OBJV_CACHE_SIZES = new int[] { 0, 4, 4, 10, 4, 4, 4, 4, 4, 4 };
 
// use test results
// 1 373
// 2 2424
// 3 11889
// 4 840
// 5 1374
// 6 926
// 7 0
// 8 74
// 9 0
 
 
internal static void init( Interp interp )
{
//System.out.println("called Parser.init()");
 
TclObject[][][] OBJV = new TclObject[OBJV_CACHE_MAX][][];
int[] USED = new int[OBJV_CACHE_MAX];
 
int i, j, size;
 
for ( i = 0; i < OBJV_CACHE_MAX; i++ )
{
size = OBJV_CACHE_SIZES[i];
//System.out.println("size " + i + " has " + size + " cache blocks");
OBJV[i] = new TclObject[size][];
USED[i] = 0;
for ( j = 0; j < size; j++ )
{
OBJV[i][j] = new TclObject[i];
}
}
 
interp.parserObjv = OBJV;
interp.parserObjvUsed = USED;
}
 
 
private static TclObject[] grabObjv( Interp interp, int size )
{
 
if ( size >= OBJV_CACHE_MAX )
{
//System.out.println("allocate for big objv of size " + size);
return new TclObject[size];
}
 
//get array of used markers for this size
int OPEN = interp.parserObjvUsed[size];
 
if ( OPEN < OBJV_CACHE_SIZES[size] )
{
// Found an open cache slot
//System.out.println("cache hit for objv of size " + size);
interp.parserObjvUsed[size] += 1;
return interp.parserObjv[size][OPEN];
}
else
{
// Did not find a free cache array of this size
//System.out.println("cache miss for objv of size " + size);
return new TclObject[size];
}
}
 
 
private static void releaseObjv( Interp interp, TclObject[] objv )
{
int size = objv.Length;
 
if ( size >= OBJV_CACHE_MAX )
{
//System.out.println("release for big objv of size " + size);
return;
}
 
int OPEN = interp.parserObjvUsed[size];
 
if ( OPEN > 0 )
{
OPEN--;
interp.parserObjvUsed[size] = OPEN;
interp.parserObjv[size][OPEN] = objv;
//System.out.println("released objv of size " + size);
}
/*
else {
System.out.println("no release for objv of size " + size);
}
*/
 
return;
}
static Parser()
{
typeTable = new char[] { TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SPACE, TYPE_COMMAND_END, TYPE_SPACE, TYPE_SPACE, TYPE_SPACE, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL, TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_COMMAND_END, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SUBS, TYPE_SUBS, TYPE_CLOSE_BRACK, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_NORMAL };
}
} // end class Parser
}
/trunk/TCL/src/base/Procedure.cs
@@ -0,0 +1,259 @@
#undef DEBUG
/*
* Procedure.java --
*
* This class implements the body of a Tcl procedure.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: Procedure.java,v 1.4 1999/08/05 03:40:31 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the body of a Tcl procedure.</summary>
 
public class Procedure : Command, CommandWithDispose
{
 
// The formal parameters of the procedure and their default values.
// argList[0][0] = name of the 1st formal param
// argList[0][1] = if non-null, default value of the 1st formal param
 
 
internal TclObject[][] argList;
 
// True if this proc takes an variable number of arguments. False
// otherwise.
 
internal bool isVarArgs;
 
// The body of the procedure.
 
internal CharPointer body;
internal int body_length;
 
// The namespace that the Command is defined in
internal NamespaceCmd.Namespace ns;
 
// Name of the source file that contains this procedure. May be null, which
// indicates that the source file is unknown.
 
internal string srcFileName;
 
// Position where the body of the procedure starts in the source file.
// 1 means the first line in the source file.
 
internal int srcLineNumber;
 
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();
}
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
// Create the call frame and parameter bindings
 
CallFrame frame = interp.newCallFrame( this, argv );
 
// Execute the body
 
interp.pushDebugStack( srcFileName, srcLineNumber );
try
{
Parser.eval2( interp, body.array, body.index, body_length, 0 );
}
catch ( TclException e )
{
TCL.CompletionCode code = e.getCompletionCode();
if ( code == TCL.CompletionCode.RETURN )
{
TCL.CompletionCode realCode = interp.updateReturnInfo();
if ( realCode != TCL.CompletionCode.OK )
{
e.setCompletionCode( realCode );
throw;
}
}
else if ( code == TCL.CompletionCode.ERROR )
{
 
interp.addErrorInfo( "\n (procedure \"" + argv[0] + "\" line " + interp.errorLine + ")" );
throw;
}
else if ( code == TCL.CompletionCode.BREAK )
{
throw new TclException( interp, "invoked \"break\" outside of a loop" );
}
else if ( code == TCL.CompletionCode.CONTINUE )
{
throw new TclException( interp, "invoked \"continue\" outside of a loop" );
}
else
{
throw;
}
}
finally
{
interp.popDebugStack();
 
// The check below is a hack. The problem is that there
// could be unset traces on the variables, which cause
// scripts to be evaluated. This will clear the
// errInProgress flag, losing stack trace information if
// the procedure was exiting with an error. The code
// below preserves the flag. Unfortunately, that isn't
// really enough: we really should preserve the errorInfo
// variable too (otherwise a nested error in the trace
// script will trash errorInfo). What's really needed is
// a general-purpose mechanism for saving and restoring
// interpreter state.
 
if ( interp.errInProgress )
{
frame.dispose();
interp.errInProgress = true;
}
else
{
frame.dispose();
}
}
return TCL.CompletionCode.RETURN;
}
public void disposeCmd()
{
//body.release();
body = null;
for ( int i = 0; i < argList.Length; i++ )
{
argList[i][0].release();
argList[i][0] = null;
 
if ( argList[i][1] != null )
{
argList[i][1].release();
argList[i][1] = null;
}
}
argList = null;
}
 
internal static bool isProc( WrappedCommand cmd )
{
return ( cmd.cmd is Procedure );
 
/*
// FIXME: do we really want to get the original command
// and test that? Methods like InfoCmd.InfoProcsCmd seem
// to do this already.
WrappedCommand origCmd;
origCmd = NamespaceCmd.getOriginalCommand(cmd);
if (origCmd != null) {
cmd = origCmd;
}
return (cmd.cmd instanceof Procedure);
*/
}
 
internal static Procedure findProc( Interp interp, string procName )
{
WrappedCommand cmd;
WrappedCommand origCmd;
 
try
{
cmd = NamespaceCmd.findCommand( interp, procName, null, 0 );
}
catch ( TclException e )
{
// This should never happen
throw new TclRuntimeError( "unexpected TclException: " + e.Message );
}
 
if ( cmd == null )
{
return null;
}
 
origCmd = NamespaceCmd.getOriginalCommand( cmd );
if ( origCmd != null )
{
cmd = origCmd;
}
if ( !( cmd.cmd is Procedure ) )
{
return null;
}
return (Procedure)cmd.cmd;
}
} // end Procedure
}
/trunk/TCL/src/base/QSort.cs
@@ -0,0 +1,554 @@
/*
* QSort.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: QSort.java,v 1.2 1999/05/09 01:14:07 dejong Exp $
*
*/
using System.Text;
namespace tcl.lang
{
 
/*
* This file is adapted from the JDK 1.0 QSortAlgorithm.java demo program.
* Original copyright notice is preserveed below.
*
* @(#)QSortAlgorithm.java 1.3 29 Feb 1996 James Gosling
*
* Copyright (c) 1994-1996 Sun Microsystems, Inc. All Rights Reserved.
*
* Permission to use, copy, modify, and distribute this software
* and its documentation for NON-COMMERCIAL or COMMERCIAL purposes and
* without fee is hereby granted.
* Please refer to the file http://www.javasoft.com/copy_trademarks.html
* for further important copyright and trademark information and to
* http://www.javasoft.com/licensing.html for further important
* licensing information for the Java (tm) Technology.
*
* SUN MAKES NO REPRESENTATIONS OR WARRANTIES. ABOUT THE SUITABILITY OF
* THE SOFTWARE, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED
* TO THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
* PARTICULAR PURPOSE, OR NON-INFRINGEMENT. SUN SHALL NOT BE LIABLE FOR
* ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
* DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES.
*
* THIS SOFTWARE IS NOT DESIGNED OR INTENDED FOR USE OR RESALE AS ON-LINE
* CONTROL EQUIPMENT IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE
* PERFORMANCE, SUCH AS IN THE OPERATION OF NUCLEAR FACILITIES, AIRCRAFT
* NAVIGATION OR COMMUNICATION SYSTEMS, AIR TRAFFIC CONTROL, DIRECT LIFE
* SUPPORT MACHINES, OR WEAPONS SYSTEMS, IN WHICH THE FAILURE OF THE
* SOFTWARE COULD LEAD DIRECTLY TO DEATH, PERSONAL INJURY, OR SEVERE
* PHYSICAL OR ENVIRONMENTAL DAMAGE ("HIGH RISK ACTIVITIES"). SUN
* SPECIFICALLY DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR
* HIGH RISK ACTIVITIES.
*/
 
/// <summary> Sorts an array of TclObjects.</summary>
sealed class QSort
{
internal const int ASCII = 0;
internal const int INTEGER = 1;
internal const int REAL = 2;
internal const int COMMAND = 3;
internal const int DICTIONARY = 4;
 
// Data used during sort.
 
private int sortMode;
private int sortIndex;
private bool sortIncreasing;
private string sortCommand;
private Interp sortInterp;
 
/// <summary> This is a generic version of C.A.R Hoare's Quick Sort
/// algorithm. This will handle arrays that are already
/// sorted, and arrays with duplicate keys.<BR>
///
/// If you think of a one dimensional array as going from
/// the lowest index on the left to the highest index on the right
/// then the parameters to this function are lowest index or
/// left and highest index or right. The first time you call
/// this function it will be with the parameters 0, a.length - 1.
///
/// </summary>
/// <param name="a"> an integer array
/// </param>
/// <param name="lo0"> left boundary of array partition
/// </param>
/// <param name="hi0"> right boundary of array partition
/// </param>
private void quickSort( TclObject[] a, int lo0, int hi0 )
{
int lo = lo0;
int hi = hi0;
TclObject mid;
 
if ( hi0 > lo0 )
{
// Arbitrarily establishing partition element as the midpoint of
// the array.
mid = a[( lo0 + hi0 ) / 2];
 
// loop through the array until indices cross
while ( lo <= hi )
{
// find the first element that is greater than or equal to
// the partition element starting from the left Index.
 
while ( ( lo < hi0 ) && ( compare( a[lo], mid ) < 0 ) )
{
++lo;
}
 
// find an element that is smaller than or equal to
// the partition element starting from the right Index.
 
while ( ( hi > lo0 ) && ( compare( a[hi], mid ) > 0 ) )
{
--hi;
}
 
// if the indexes have not crossed, swap
if ( lo <= hi )
{
swap( a, lo, hi );
++lo;
--hi;
}
}
 
// If the right index has not reached the left side of array
// must now sort the left partition.
 
if ( lo0 < hi )
{
quickSort( a, lo0, hi );
}
 
// If the left index has not reached the right side of array
// must now sort the right partition.
 
if ( lo < hi0 )
{
quickSort( a, lo, hi0 );
}
}
}
 
/// <summary> Swaps two items in the array.
///
/// </summary>
/// <param name="a">the array.
/// </param>
/// <param name="i">index of first item.
/// </param>
/// <param name="j">index of first item.
/// </param>
private static void swap( TclObject[] a, int i, int j )
{
TclObject T;
T = a[i];
a[i] = a[j];
a[j] = T;
}
 
/// <summary> Starts the quick sort with the given parameters.
///
/// </summary>
/// <param name="interp">if cmd is specified, it is evaluated inside this
/// interp.
/// </param>
/// <param name="a">the array of TclObject's to sort.
/// </param>
/// <param name="mode">the sortng mode.
/// </param>
/// <param name="increasing">true if the sorted array should be in increasing
/// order.
/// </param>
/// <param name="cmd">the command to use for comparing items. It is used only
/// if sortMode is COMMAND.
/// </param>
/// <param name="unique">true if the result should contain no duplicates.
/// </param>
/// <returns> the length of the sorted array. This length may be different
/// from the length if array a due to the unique option.
/// </returns>
/// <exception cref=""> TclException if an error occurs during sorting.
/// </exception>
internal int sort( Interp interp, TclObject[] a, int mode, int index, bool increasing, string cmd, bool unique )
{
sortInterp = interp;
sortMode = mode;
sortIndex = index;
sortIncreasing = increasing;
sortCommand = cmd;
quickSort( a, 0, a.Length - 1 );
if ( !unique )
{
return a.Length;
}
 
int uniqueIx = 1;
for ( int ix = 1; ix < a.Length; ix++ )
{
if ( compare( a[ix], a[uniqueIx - 1] ) == 0 )
{
a[ix].release();
}
else
{
if ( ix != uniqueIx )
{
a[uniqueIx] = a[ix];
a[uniqueIx].preserve();
}
uniqueIx++;
}
}
return uniqueIx;
 
}
 
/// <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> Compares the order of two strings in "dictionary" order.
///
/// </summary>
/// <param name="str1">first item.
/// </param>
/// <param name="str2">second item.
/// </param>
/// <returns> 0 if they are equal, 1 if obj1 > obj2, -1 otherwise.
/// </returns>
private int doDictionary( string str1, string str2 )
{
int diff = 0, zeros;
int secondaryDiff = 0;
 
bool cont = true;
int i1 = 0, i2 = 0;
int len1 = str1.Length;
int len2 = str2.Length;
 
 
while ( cont )
{
if ( i1 >= len1 || i2 >= len2 )
{
break;
}
 
if ( System.Char.IsDigit( str2[i2] ) && System.Char.IsDigit( str1[i1] ) )
{
 
// There are decimal numbers embedded in the two
// strings. Compare them as numbers, rather than
// strings. If one number has more leading zeros than
// the other, the number with more leading zeros sorts
// later, but only as a secondary choice.
 
zeros = 0;
while ( ( i2 < ( len2 - 1 ) ) && ( str2[i2] == '0' ) )
{
i2++;
zeros--;
}
while ( ( i1 < ( len1 - 1 ) ) && ( str1[i1] == '0' ) )
{
i1++;
zeros++;
}
if ( secondaryDiff == 0 )
{
secondaryDiff = zeros;
}
 
 
// The code below compares the numbers in the two
// strings without ever converting them to integers. It
// does this by first comparing the lengths of the
// numbers and then comparing the digit values.
 
diff = 0;
while ( true )
{
 
if ( i1 >= len1 || i2 >= len2 )
{
cont = false;
break;
}
if ( diff == 0 )
{
diff = str1[i1] - str2[i2];
}
i1++;
i2++;
if ( i1 >= len1 || i2 >= len2 )
{
cont = false;
break;
}
 
 
if ( !System.Char.IsDigit( str2[i2] ) )
{
if ( System.Char.IsDigit( str1[i1] ) )
{
return 1;
}
else
{
if ( diff != 0 )
{
return diff;
}
break;
}
}
else if ( !System.Char.IsDigit( str1[i1] ) )
{
return -1;
}
}
continue;
}
diff = str1[i1] - str2[i2];
if ( diff != 0 )
{
if ( System.Char.IsUpper( str1[i1] ) && System.Char.IsLower( str2[i2] ) )
{
diff = System.Char.ToLower( str1[i1] ) - str2[i2];
if ( diff != 0 )
{
return diff;
}
else if ( secondaryDiff == 0 )
{
secondaryDiff = -1;
}
}
else if ( System.Char.IsUpper( str2[i2] ) && System.Char.IsLower( str1[i1] ) )
{
diff = str1[i1] - System.Char.ToLower( str2[i2] );
if ( diff != 0 )
{
return diff;
}
else if ( secondaryDiff == 0 )
{
secondaryDiff = 1;
}
}
else
{
return diff;
}
}
i1++;
i2++;
}
 
if ( i1 >= len1 && i2 < len2 )
{
if ( !System.Char.IsDigit( str2[i2] ) )
{
return 1;
}
else
{
return -1;
}
}
else if ( i2 >= len2 && i1 < len1 )
{
if ( !System.Char.IsDigit( str1[i1] ) )
{
return -1;
}
else
{
return 1;
}
}
 
if ( diff == 0 )
{
diff = secondaryDiff;
}
return diff;
}
}
}
/trunk/TCL/src/base/Resolver.cs
@@ -0,0 +1,34 @@
/// <summary> Resolver.java
///
/// Interface for resolvers that can be added to
/// the Tcl Interpreter or to a namespace.
///
/// Copyright (c) 1997 Sun Microsystems, Inc.
/// Copyright (c) 2001 Christian Krone
///
/// See the file "license.terms" for information on usage and
/// redistribution of this file, and for a DISCLAIMER OF ALL
/// WARRANTIES.
///
/// Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
/// $Header$
/// RCS: @(#) $Id: Resolver.java,v 1.1 2001/05/05 22:38:13 mdejong Exp $
/// </summary>
using System;
namespace tcl.lang
{
 
/// <summary> The Resolver interface specifies the methods that a new Tcl resolver
/// must implement. See the addInterpResolver method of the Interp class
/// to see how to add a new resolver to an interperter or the
/// setNamespaceResolver of the NamespaceCmd class.
/// </summary>
 
public interface Resolver
{
 
WrappedCommand resolveCmd( Interp interp, string name, NamespaceCmd.Namespace context, TCL.VarFlag flags ); // Tcl exceptions are thrown for Tcl errors.
 
Var resolveVar( Interp interp, string name, NamespaceCmd.Namespace context, TCL.VarFlag flags ); // Tcl exceptions are thrown for Tcl errors.
} // end Resolver
}
/trunk/TCL/src/base/SearchId.cs
@@ -0,0 +1,130 @@
/*
* SearchId.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: SearchId.java,v 1.1.1.1 1998/10/14 21:09:20 cvsadmin Exp $
*
*/
using System;
using System.Collections;
 
namespace tcl.lang
{
 
/// <summary> SearchId is used only by the ArrayVar class. When searchstart is
/// called on an Tcl array, a SearchId is created that contains the
/// Enumerated list of all the array keys; a String that uniquely
/// identifies the searchId for the Tcl array, and an index that is
/// used when to generate other unique strings.
/// </summary>
public sealed class SearchId
{
/// <summary> Return the Enumeration for the SearchId object. This is
/// used in the ArrayCmd class for the anymore, donesearch,
/// and nextelement functions.
///
/// </summary>
/// <param name="">none
/// </param>
/// <returns> The Enumeration for the SearchId object
/// </returns>
private IDictionaryEnumerator Enum
{
get
{
return enum_Renamed;
}
 
}
/// <summary> Return the integer value of the index. Used in ArrayVar to
/// generate the next unique SearchId string.
///
/// </summary>
/// <param name="">none
/// </param>
/// <returns>h The integer value of the index
/// </returns>
internal int Index
{
get
{
return index;
}
 
}
private bool hasMore = true;
internal bool HasMore
{
get
{
return hasMore;
}
}
private DictionaryEntry entry;
internal DictionaryEntry nextEntry()
{
DictionaryEntry cEntry = entry;
hasMore = enum_Renamed.MoveNext();
if ( hasMore )
entry = enum_Renamed.Entry;
return cEntry;
}
 
 
/// <summary> An Enumeration that stores the list of keys for
/// the ArrayVar.
/// </summary>
private IDictionaryEnumerator enum_Renamed;
 
/// <summary> The unique searchId string</summary>
private string str;
 
/// <summary> Unique index used for generating unique searchId strings</summary>
private int index;
 
/// <summary> A SearchId is only created from an ArrayVar object. The ArrayVar
/// constructs a new SearchId object by passing it's current keys
/// stored as an enumeration, a unique string that ArrayVar creates,
/// and an index value used for future SearchId objects.
///
/// </summary>
/// <param name="e">initial Enumeration
/// </param>
/// <param name="s">String as the unique identifier for the searchId
/// </param>
/// <param name="e">index value for this object
/// </param>
internal SearchId( IDictionaryEnumerator e, string s, int i )
{
enum_Renamed = e;
str = s;
index = i;
hasMore = enum_Renamed.MoveNext();
if ( hasMore )
entry = enum_Renamed.Entry;
}
 
/// <summary> Return the str that is the unique identifier of the SearchId</summary>
public override string ToString()
{
return str;
}
 
/// <summary> Tests for equality based on the value of str</summary>
/// <param name="">none
/// </param>
/// <returns> boolean based on the equality of the string
/// </returns>
internal bool equals( string s )
{
return str.Equals( s );
}
}
}
/trunk/TCL/src/base/TCL.cs
@@ -0,0 +1,125 @@
/*
* TCL.java --
*
* This class stores all the public constants for the tcl.lang.
* The exact values should match those in tcl.h.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TCL.java,v 1.4 2000/05/14 23:10:20 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
// This class holds all the publicly defined constants contained by the
// tcl.lang package.
 
public partial class TCL
{
 
// Flag values passed to variable-related procedures. THESE VALUES
// MUST BE CONSISTANT WITH THE C IMPLEMENTATION OF TCL.
 
[Flags()]
public enum VarFlag
{
GLOBAL_ONLY = 1,
NAMESPACE_ONLY = 2,
APPEND_VALUE = 4,
LIST_ELEMENT = 8,
TRACE_READS = 0x10,
TRACE_WRITES = 0x20,
TRACE_UNSETS = 0x40,
TRACE_DESTROYED = 0x80,
INTERP_DESTROYED = 0x100,
LEAVE_ERR_MSG = 0x200,
TRACE_ARRAY = 0x800,
FIND_ONLY_NS = 0x1000,
CREATE_NS_IF_UNKNOWN = 0x800,
};
 
// When an TclException is thrown, its compCode may contain any
// of the following values:
//
// TCL.CompletionCode.ERROR The command couldn't be completed successfully;
// the interpreter's result describes what went wrong.
// TCL.CompletionCode.RETURN The command requests that the current procedure
// return; the interpreter's result contains the
// procedure's return value.
// TCL.CompletionCode.BREAK The command requests that the innermost loop
// be exited; the interpreter's result is meaningless.
// TCL.CompletionCode.CONTINUE Go on to the next iteration of the current loop;
// the interpreter's result is meaningless.
// TCL.CompletionCode.OK is only used internally. TclExceptions should never be thrown with
// the completion code TCL.CompletionCode.OK. If the desired completion code is TCL.CompletionCode.OK, no
// exception should be thrown.
 
public enum CompletionCode
{
OK = 0,
ERROR = 1,
RETURN = 2,
BREAK = 3,
CONTINUE = 4,
EXIT = 5
};
 
 
// The following value is used by the Interp::commandComplete(). It's used
// to report that a script is not complete.
 
protected internal const int INCOMPLETE = 10;
 
// Flag values to pass to TCL.Tcl_DoOneEvent to disable searches
// for some kinds of events:
 
public const int DONT_WAIT = ( 1 << 1 );
public const int WINDOW_EVENTS = ( 1 << 2 );
public const int FILE_EVENTS = ( 1 << 3 );
public const int TIMER_EVENTS = ( 1 << 4 );
public const int IDLE_EVENTS = ( 1 << 5 );
public const int ALL_EVENTS = ( ~DONT_WAIT );
 
// The largest positive and negative integer values that can be
// represented in Tcl.
 
internal const long INT_MAX = 2147483647;
internal const long INT_MIN = - 2147483648;
 
// These values are used by Util.strtoul and Util.strtod to
// report conversion errors.
 
internal const int INVALID_INTEGER = -1;
internal const int INTEGER_RANGE = -2;
internal const int INVALID_DOUBLE = -3;
internal const int DOUBLE_RANGE = -4;
 
// Positions to pass to TCL.Tcl_QueueEvent. THESE VALUES
// MUST BE CONSISTANT WITH THE C IMPLEMENTATION OF TCL.
 
public const int QUEUE_TAIL = 0;
public const int QUEUE_HEAD = 1;
public const int QUEUE_MARK = 2;
 
// Flags used to control the TclIndex.get method.
 
public const int EXACT = 1; // Matches must be exact.
 
// Flag values passed to recordAndEval and/or evalObj.
// These values must match those defined in tcl.h !!!
 
// Note: EVAL_DIRECT is not currently used in Jacl.
 
public const int NO_EVAL = 0x10000;
public const int EVAL_GLOBAL = 0x20000;
public const int EVAL_DIRECT = 0x40000;
} // end TCL
}
/trunk/TCL/src/base/TCLObj.cs
@@ -0,0 +1,101 @@
/*
* TclObj.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclObj.java,v 1.5 2000/10/29 06:00:42 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the object type in Tcl.</summary>
 
public class TclObj : InternalRep
{
/// <summary> Internal representation of a object value.</summary>
private object value;
 
/// <summary> Construct a TclObj representation with the given object value.</summary>
private TclObj( object o )
{
value = o;
}
 
/// <summary> Returns a dupilcate of the current object.</summary>
/// <param name="obj">the TclObject that contains this internalRep.
/// </param>
public InternalRep duplicate()
{
return new TclObj( value );
}
 
/// <summary> Implement this no-op for the InternalRep interface.</summary>
 
public void dispose()
{
value = null;
}
 
/// <summary> Called to query the string representation of the Tcl object. This
/// method is called only by TclObject.toString() when
/// TclObject.stringRep is null.
///
/// </summary>
/// <returns> the string representation of the Tcl object.
/// </returns>
public override string ToString()
{
return value.ToString();
}
 
/// <summary> Tcl_NewIntObj -> TclObj.newInstance
///
/// Creates a new instance of a TclObject with a TclObj internal
/// representation.
///
/// </summary>
/// <param name="b">initial value of the object object.
/// </param>
/// <returns> the TclObject with the given object value.
/// </returns>
 
public static TclObject newInstance( object o )
{
return new TclObject( new TclObj( o ) );
}
 
 
/// <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 );
}
}
}
}
/trunk/TCL/src/base/TclBoolean.cs
@@ -0,0 +1,150 @@
/*
* TclBoolean.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclBoolean.java,v 1.2 2000/10/29 06:00:42 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the boolean object type in Tcl.</summary>
 
public class TclBoolean : InternalRep
{
/// <summary> Internal representation of a boolean value.</summary>
private bool value;
 
/// <summary> Construct a TclBoolean representation with the given boolean value.
///
/// </summary>
/// <param name="b">initial boolean value.
/// </param>
private TclBoolean( bool b )
{
value = b;
}
 
/// <summary> Construct a TclBoolean representation with the initial value taken
/// from the given string.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <exception cref=""> TclException if the string is not a well-formed Tcl boolean
/// value.
/// </exception>
private TclBoolean( Interp interp, string str )
{
value = Util.getBoolean( interp, str );
}
 
/// <summary> Returns a dupilcate of the current object.
///
/// </summary>
/// <param name="tobj">the TclObject that contains this ObjType.
/// </param>
public InternalRep duplicate()
{
return new TclBoolean( value );
}
 
/// <summary> Implement this no-op for the InternalRep interface.</summary>
 
public void dispose()
{
}
 
/// <summary> Called to query the string representation of the Tcl object. This
/// method is called only by TclObject.toString() when
/// TclObject.stringRep is null.
///
/// </summary>
/// <returns> the string representation of the Tcl object.
/// </returns>
public override string ToString()
{
if ( value )
{
return "1";
}
else
{
return "0";
}
}
 
/// <summary> Creates a new instance of a TclObject with a TclBoolean internal
/// representation.
///
/// </summary>
/// <param name="b">initial value of the boolean object.
/// </param>
/// <returns> the TclObject with the given boolean value.
/// </returns>
 
public static TclObject newInstance( bool b )
{
return new TclObject( new TclBoolean( b ) );
}
 
/// <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> 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;
}
}
}
/trunk/TCL/src/base/TclByteArray.cs
@@ -0,0 +1,236 @@
/*
* TclByteArray.java
*
* This class contains the implementation of the Jacl binary data object.
*
* Copyright (c) 1999 Christian Krone.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclByteArray.java,v 1.4 2003/03/08 02:05:06 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the binary data object type in Tcl.</summary>
public class TclByteArray : InternalRep
{
 
/// <summary> The number of bytes used in the byte array.
/// The following structure is the internal rep for a ByteArray object.
/// Keeps track of how much memory has been used. This can be different from
/// how much has been allocated for the byte array to enable growing and
/// shrinking of the ByteArray object with fewer allocations.
/// </summary>
private int used;
 
/// <summary> Internal representation of the binary data.</summary>
private byte[] bytes;
 
/// <summary> Create a new empty Tcl binary data.</summary>
private TclByteArray()
{
used = 0;
bytes = new byte[0];
}
 
/// <summary> Create a new Tcl binary data.</summary>
private TclByteArray( byte[] b )
{
used = b.Length;
bytes = new byte[used];
Array.Copy( b, 0, bytes, 0, used );
}
 
/// <summary> Create a new Tcl binary data.</summary>
private TclByteArray( byte[] b, int position, int length )
{
used = length;
bytes = new byte[used];
Array.Copy( b, position, bytes, 0, used );
}
 
/// <summary> Create a new Tcl binary data.</summary>
private TclByteArray( char[] c )
{
used = c.Length;
bytes = new byte[used];
for ( int ix = 0; ix < used; ix++ )
{
bytes[ix] = (byte)c[ix];
}
}
 
/// <summary> Returns a duplicate of the current object.
///
/// </summary>
/// <param name="obj">the TclObject that contains this internalRep.
/// </param>
public InternalRep duplicate()
{
return new TclByteArray( bytes, 0, used );
}
 
/// <summary> Implement this no-op for the InternalRep interface.</summary>
 
public void dispose()
{
}
 
/// <summary> Called to query the string representation of the Tcl object. This
/// method is called only by TclObject.toString() when
/// TclObject.stringRep is null.
///
/// </summary>
/// <returns> the string representation of the Tcl object.
/// </returns>
public override string ToString()
{
char[] c = new char[used];
for ( int ix = 0; ix < used; ix++ )
{
c[ix] = (char)( bytes[ix] & 0xff );
}
return new string( c );
}
 
/// <summary> Creates a new instance of a TclObject with a TclByteArray internal
/// rep.
///
/// </summary>
/// <returns> the TclObject with the given byte array value.
/// </returns>
 
public static TclObject newInstance( byte[] b, int position, int length )
{
return new TclObject( new TclByteArray( b, position, length ) );
}
 
/// <summary> Creates a new instance of a TclObject with a TclByteArray internal
/// rep.
///
/// </summary>
/// <returns> the TclObject with the given byte array value.
/// </returns>
 
public static TclObject newInstance( byte[] b )
{
return new TclObject( new TclByteArray( b ) );
}
 
/// <summary> Creates a new instance of a TclObject with an empty TclByteArray
/// internal rep.
///
/// </summary>
/// <returns> the TclObject with the empty byte array value.
/// </returns>
 
public static TclObject newInstance()
{
return new TclObject( new TclByteArray() );
}
 
/// <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>
/// This method changes the length of the byte array for this
/// object. Once the caller has set the length of the array, it
/// is acceptable to directly modify the bytes in the array up until
/// Tcl_GetStringFromObj() has been called on this object.
///
/// Results:
/// The new byte array of the specified length.
///
/// Side effects:
/// Allocates enough memory for an array of bytes of the requested
/// size. When growing the array, the old array is copied to the
/// new array; new bytes are undefined. When shrinking, the
/// old array is truncated to the specified length.
/// </summary>
 
public static byte[] setLength( Interp interp, TclObject tobj, int length )
{
if ( tobj.Shared )
{
throw new TclRuntimeError( "TclByteArray.setLength() called with shared object" );
}
setByteArrayFromAny( interp, tobj );
TclByteArray tbyteArray = (TclByteArray)tobj.InternalRep;
 
if ( length > tbyteArray.bytes.Length )
{
byte[] newBytes = new byte[length];
Array.Copy( tbyteArray.bytes, 0, newBytes, 0, tbyteArray.used );
tbyteArray.bytes = newBytes;
}
tobj.invalidateStringRep();
tbyteArray.used = length;
return tbyteArray.bytes;
}
 
/// <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;
}
 
/// <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;
}
}
}
/trunk/TCL/src/base/TclDouble.cs
@@ -0,0 +1,133 @@
/*
* TclDouble.java --
*
* Implements the TclDouble internal object representation, as well
* variable traces for the tcl_precision variable.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclDouble.java,v 1.2 2000/10/29 06:00:42 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements the double object type in Tcl.
*/
 
public class TclDouble : InternalRep
{
 
/*
* Internal representation of a double value.
*/
 
private double value;
 
private TclDouble( double i )
{
value = i;
}
private TclDouble( Interp interp, string str )
{
value = Util.getDouble( interp, str );
}
public InternalRep duplicate()
{
return new TclDouble( value );
}
public void dispose()
{
}
public static TclObject newInstance( double d )
// Initial value.
{
return new TclObject( new TclDouble( d ) );
}
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 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;
}
public static void set( TclObject tobj, double d )
// The new value for the object.
{
tobj.invalidateStringRep();
InternalRep rep = tobj.InternalRep;
 
if ( rep is TclDouble )
{
TclDouble tdouble = (TclDouble)rep;
tdouble.value = d;
}
else
{
tobj.InternalRep = new TclDouble( d );
}
}
public override string ToString()
{
return Util.printDouble( value );
}
} // end TclDouble
}
/trunk/TCL/src/base/TclEvent.cs
@@ -0,0 +1,109 @@
/*
* TclEvent.java --
*
* Abstract class for describing an event in the Tcl notifier
* API.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclEvent.java,v 1.3 2003/03/11 01:45:53 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This is an abstract class that describes an event in the Jacl
* implementation of the notifier. It contains package protected
* fields and methods that are accessed by the Jacl notifier. Tcl Blend
* needs a different implementation of the TclEvent base class.
*
* The only public methods in this class are processEvent() and
* sync(). These methods must appear in both the Jacl and Tcl Blend versions
* of this class.
*/
 
public abstract class TclEvent
{
 
/*
* The notifier in which this event is queued.
*/
 
internal Notifier notifier = null;
 
/*
* This flag is true if sync() has been called on this object.
*/
 
internal bool needsNotify = false;
 
/*
* True if this event is current being processing. This flag provents
* an event to be processed twice when the event loop is entered
* recursively.
*/
 
internal bool isProcessing = false;
 
/*
* True if this event has been processed.
*/
 
internal bool isProcessed = false;
 
/*
* Links to the next event in the event queue.
*/
 
internal TclEvent next;
 
public abstract int processEvent( int flags ); // Same as flags passed to Notifier.doOneEvent.
 
public void sync()
{
if ( notifier == null )
{
throw new TclRuntimeError( "TclEvent is not queued when sync() is called" );
}
 
if ( System.Threading.Thread.CurrentThread == notifier.primaryThread )
{
while ( !isProcessed )
{
notifier.serviceEvent( 0 );
}
}
else
{
lock ( this )
{
needsNotify = true;
while ( !isProcessed )
{
try
{
System.Threading.Monitor.Wait( this, TimeSpan.FromMilliseconds( 0 ) );
}
catch ( System.Threading.ThreadInterruptedException e )
{
// Another thread has sent us an "interrupt"
// signal. We ignore it and continue waiting until
// the event is processed.
 
continue;
}
}
}
}
}
} // end TclEvent
}
/trunk/TCL/src/base/TclException.cs
@@ -0,0 +1,113 @@
/*
* TclException.java --
*
* This file defines the TclException class used by Tcl to report
* generic script-level errors and exceptions.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclException.java,v 1.2 2000/04/03 14:09:11 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* TclException is used to interrupt the Tcl script currently being
* interpreted by the Tcl Interpreter. Usually, a TclException is thrown
* to indicate a script level error, e.g.:
*
* - A syntax error occurred in a script.
* - A unknown variable is referenced.
* - A unknown command is executed.
* - A command is passed incorrected.
*
* A TclException can also be thrown by Tcl control structure commands such
* as "return" and "continue" to change the flow of control in
* a Tcl script.
*
* A TclException is accompanied by two pieces of information: the error
* message and the completion code. The error message is a string stored in
* the interpreter result. After a TclException is thrown and caught, the
* error message can be queried by Interp.getResult().
*
* The completion code indicates why the TclException is generated. It is
* stored in the compCode field of this class.
*/
 
public class TclException : System.Exception
{
 
/*
* Stores the completion code of a TclException.
*/
 
private TCL.CompletionCode compCode;
 
/*
* An index that indicates where an error occurs inside a Tcl
* string. This is used to add the offending command into the stack
* trace.
*
* A negative value means the location of the index is unknown.
*
* Currently this field is used only by the Jacl interpreter.
*/
 
protected internal int errIndex;
 
protected internal TclException( Interp interp, string msg, TCL.CompletionCode ccode, int idx )
: base( msg )
{
if ( ccode == TCL.CompletionCode.OK )
{
throw new TclRuntimeError( "The reserved completion code TCL.CompletionCode.OK (0) cannot be used " + "in TclException" );
}
compCode = ccode;
errIndex = idx;
 
if ( interp != null && (System.Object)msg != null )
{
interp.setResult( msg );
}
}
public TclException( TCL.CompletionCode ccode )
: base()
{
if ( ccode == TCL.CompletionCode.OK )
{
throw new TclRuntimeError( "The reserved completion code TCL.CompletionCode.OK (0) cannot be used" );
}
compCode = ccode;
errIndex = -1;
}
public TclException( Interp interp, string msg )
: this( interp, msg, TCL.CompletionCode.ERROR, -1 )
{
}
public TclException( Interp interp, string msg, TCL.CompletionCode ccode )
: this( interp, msg, ccode, -1 )
{
}
public TCL.CompletionCode getCompletionCode()
{
return compCode;
}
internal void setCompletionCode( TCL.CompletionCode ccode )
// New completion code.
{
if ( ccode == TCL.CompletionCode.OK )
{
throw new TclRuntimeError( "The reserved completion code TCL.CompletionCode.OK (0) cannot be used" );
}
compCode = ccode;
}
} // end TclException
}
/trunk/TCL/src/base/TclIndex.cs
@@ -0,0 +1,163 @@
/*
* TclIndex.java
*
* This file implements objects of type "index". This object type
* is used to lookup a keyword in a table of valid values and cache
* the index of the matching entry.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclIndex.java,v 1.5 2003/01/10 01:35:58 mdejong Exp $
*/
using System.Text;
namespace tcl.lang
{
 
public class TclIndex : InternalRep
{
 
/// <summary> The variable slots for this object.</summary>
private int index;
 
/// <summary> Table of valid options.</summary>
 
private string[] table;
 
/// <summary> Construct a TclIndex representation with the given index & table.</summary>
private TclIndex( int i, string[] tab )
{
index = i;
table = tab;
}
 
/// <summary> Returns a dupilcate of the current object.</summary>
/// <param name="obj">the TclObject that contains this internalRep.
/// </param>
public InternalRep duplicate()
{
return new TclIndex( index, table );
}
 
/// <summary> Implement this no-op for the InternalRep interface.</summary>
 
public void dispose()
{
}
 
/// <summary> Called to query the string representation of the Tcl object. This
/// method is called only by TclObject.toString() when
/// TclObject.stringRep is null.
///
/// </summary>
/// <returns> the string representation of the Tcl object.
/// </returns>
public override string ToString()
{
return table[index];
}
 
/// <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;
}
}
}
/trunk/TCL/src/base/TclInteger.cs
@@ -0,0 +1,175 @@
/*
* TclInteger.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclInteger.java,v 1.5 2000/10/29 06:00:42 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the integer object type in Tcl.</summary>
 
public class TclInteger : InternalRep
{
/// <summary> Internal representation of a integer value.</summary>
private int value;
 
/// <summary> Construct a TclInteger representation with the given integer value.</summary>
private TclInteger( int i )
{
value = i;
 
}
 
/// <summary> Construct a TclInteger representation with the initial value taken
/// from the given string.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="str">string rep of the integer.
/// </param>
/// <exception cref=""> TclException if the string is not a well-formed Tcl integer
/// value.
/// </exception>
private TclInteger( Interp interp, string str )
{
value = Util.getInt( interp, str );
}
 
/// <summary> Returns a dupilcate of the current object.</summary>
/// <param name="obj">the TclObject that contains this internalRep.
/// </param>
public InternalRep duplicate()
{
return new TclInteger( value );
}
 
/// <summary> Implement this no-op for the InternalRep interface.</summary>
 
public void dispose()
{
}
 
/// <summary> Called to query the string representation of the Tcl object. This
/// method is called only by TclObject.toString() when
/// TclObject.stringRep is null.
///
/// </summary>
/// <returns> the string representation of the Tcl object.
/// </returns>
public override string ToString()
{
return value.ToString();
}
 
/// <summary> TCL.Tcl_NewIntObj -> TclInteger.newInstance
///
/// Creates a new instance of a TclObject with a TclInteger internal
/// representation.
///
/// </summary>
/// <param name="b">initial value of the integer object.
/// </param>
/// <returns> the TclObject with the given integer value.
/// </returns>
 
public static TclObject newInstance( int i )
{
return new TclObject( new TclInteger( i ) );
}
 
/// <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() );
}
}
 
/// <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> Changes the integer value of the object.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the object to operate on.
/// @paran i the new integer value.
/// </param>
public static void set( TclObject tobj, int i )
{
tobj.invalidateStringRep();
InternalRep rep = tobj.InternalRep;
TclInteger tint;
 
if ( rep is TclInteger )
{
tint = (TclInteger)rep;
tint.value = i;
}
else
{
tobj.InternalRep = new TclInteger( i );
}
}
}
}
/trunk/TCL/src/base/TclList.cs
@@ -0,0 +1,449 @@
/*
* TclList.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclList.java,v 1.5 2003/01/09 02:15:39 mdejong Exp $
*
*/
using System;
using System.Collections;
using System.Text;
 
namespace tcl.lang
{
 
/// <summary> This class implements the list object type in Tcl.</summary>
public class TclList : InternalRep
{
 
/// <summary> Internal representation of a list value.</summary>
private ArrayList vector;
 
/// <summary> Create a new empty Tcl List.</summary>
private TclList()
{
vector = new ArrayList( 10 );
}
 
/// <summary> Create a new empty Tcl List, with the vector pre-allocated to
/// the given size.
///
/// </summary>
/// <param name="size">the number of slots pre-allocated in the vector.
/// </param>
private TclList( int size )
{
vector = new ArrayList( size );
}
 
/// <summary> Called to free any storage for the type's internal rep.</summary>
/// <param name="obj">the TclObject that contains this internalRep.
/// </param>
public void dispose()
{
int size = vector.Count;
for ( int i = 0; i < size; i++ )
{
( (TclObject)vector[i] ).release();
}
}
 
/// <summary> DupListInternalRep -> duplicate
///
/// Returns a dupilcate of the current object.
///
/// </summary>
/// <param name="obj">the TclObject that contains this internalRep.
/// </param>
public InternalRep duplicate()
{
int size = vector.Count;
TclList newList = new TclList( size );
 
for ( int i = 0; i < size; i++ )
{
TclObject tobj = (TclObject)vector[i];
tobj.preserve();
newList.vector.Add( tobj );
}
 
return newList;
}
 
/// <summary> Called to query the string representation of the Tcl object. This
/// method is called only by TclObject.toString() when
/// TclObject.stringRep is null.
///
/// </summary>
/// <returns> the string representation of the Tcl object.
/// </returns>
public override string ToString()
{
StringBuilder sbuf = new StringBuilder();
int size = vector.Count;
 
try
{
for ( int i = 0; i < size; i++ )
{
Object elm = vector[i];
if ( elm != null )
{
 
Util.appendElement( null, sbuf, elm.ToString() );
}
else
{
Util.appendElement( null, sbuf, "" );
}
}
}
catch ( TclException e )
{
throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
}
 
return sbuf.ToString();
}
 
/// <summary> Creates a new instance of a TclObject with a TclList internal
/// rep.
///
/// </summary>
/// <returns> the TclObject with the given list value.
/// </returns>
 
public static TclObject newInstance()
{
return new TclObject( new TclList() );
}
 
/// <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> Splits a list (in string rep) up into its constituent fields.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="v">store the list elements in this vector.
/// </param>
/// <param name="s">the string to convert into a list.
/// </param>
/// <exception cref=""> TclException if the object doesn't contain a valid list.
/// </exception>
private static void splitList( Interp interp, ArrayList v, string s )
{
int len = s.Length;
int i = 0;
 
while ( i < len )
{
FindElemResult res = Util.findElement( interp, s, i, len );
if ( res == null )
{
break;
}
else
{
TclObject tobj = TclString.newInstance( res.elem );
tobj.preserve();
v.Add( tobj );
}
i = res.elemEnd;
}
}
 
 
/// <summary> Tcl_ListObjAppendElement -> TclList.append()
///
/// Appends a TclObject element to a list object.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the TclObject to append an element to.
/// </param>
/// <param name="elemObj">the element to append to the object.
/// </param>
/// <exception cref=""> TclException if tobj cannot be converted into a list.
/// </exception>
public static void append( Interp interp, TclObject tobj, TclObject elemObj )
{
if ( tobj.Shared )
{
throw new TclRuntimeError( "TclList.append() called with shared object" );
}
setListFromAny( interp, tobj );
tobj.invalidateStringRep();
 
TclList tlist = (TclList)tobj.InternalRep;
elemObj.preserve();
tlist.vector.Add( elemObj );
}
 
/// <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> Returns a TclObject array of the elements in a list object. If
/// tobj is not a list object, an attempt will be made to convert
/// it to a list. <p>
///
/// The objects referenced by the returned array should be treated
/// as readonly and their ref counts are _not_ incremented; the
/// caller must do that if it holds on to a reference.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="tobj">the list to sort.
/// </param>
/// <returns> a TclObject array of the elements in a list object.
/// </returns>
/// <exception cref=""> TclException if tobj is not a valid list.
/// </exception>
public static TclObject[] getElements( Interp interp, TclObject tobj )
{
setListFromAny( interp, tobj );
TclList tlist = (TclList)tobj.InternalRep;
 
int size = tlist.vector.Count;
TclObject[] objArray = new TclObject[size];
for ( int i = 0; i < size; i++ )
{
objArray[i] = (TclObject)tlist.vector[i];
}
return objArray;
}
 
/// <summary> This procedure returns a pointer to the index'th object from
/// the list referenced by tobj. The first element has index
/// 0. If index is negative or greater than or equal to the number
/// of elements in the list, a null is returned. 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 index of the requested element.
/// </param>
/// <returns> the the requested element.
/// </returns>
/// <exception cref=""> TclException if tobj is not a valid list.
/// </exception>
public static TclObject index( Interp interp, TclObject tobj, int index )
{
setListFromAny( interp, tobj );
 
TclList tlist = (TclList)tobj.InternalRep;
if ( index < 0 || index >= tlist.vector.Count )
{
return null;
}
else
{
return (TclObject)tlist.vector[index];
}
}
 
/// <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> This procedure replaces zero or more elements of the list
/// referenced by tobj with the objects from an TclObject array.
/// 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 replace operation. <=0 means
/// the beginning of the list. >= TclList.getLength(tobj) means
/// the end of the list.
/// </param>
/// <param name="count">the number of elements to delete from the list. <=0 means
/// no elements should be deleted and the operation is equivalent to
/// an insertion operation.
/// </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>
public static void replace( Interp interp, TclObject tobj, int index, int count, TclObject[] elements, int from, int to )
{
if ( tobj.Shared )
{
throw new TclRuntimeError( "TclList.replace() called with shared object" );
}
setListFromAny( interp, tobj );
tobj.invalidateStringRep();
TclList tlist = (TclList)tobj.InternalRep;
 
int size = tlist.vector.Count;
int i;
 
if ( index >= size )
{
// Append to the end of the list. There is no need for deleting
// elements.
index = size;
}
else
{
if ( index < 0 )
{
index = 0;
}
if ( count > size - index )
{
count = size - index;
}
for ( i = 0; i < count; i++ )
{
TclObject obj = (TclObject)tlist.vector[index];
obj.release();
tlist.vector.RemoveAt( index );
}
}
for ( i = from; i <= to; i++ )
{
elements[i].preserve();
tlist.vector.Insert( index++, elements[i] );
}
}
 
/// <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 );
}
}
}
}
/trunk/TCL/src/base/TclLong.cs
@@ -0,0 +1,174 @@
/*
* TclLong.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclLong.java,v 1.5 2000/10/29 06:00:42 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the long object type in Tcl.</summary>
 
public class TclLong : InternalRep
{
/// <summary> longernal representation of a long value.</summary>
private long value;
 
/// <summary> Construct a TclLong representation with the given long value.</summary>
private TclLong( long i )
{
value = i;
}
 
/// <summary> Construct a TclLong representation with the initial value taken
/// from the given string.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="str">string rep of the long.
/// </param>
/// <exception cref=""> TclException if the string is not a well-formed Tcl long
/// value.
/// </exception>
private TclLong( Interp interp, string str )
{
value = Util.getLong( interp, str );
}
 
/// <summary> Returns a dupilcate of the current object.</summary>
/// <param name="obj">the TclObject that contains this InternalRep.
/// </param>
public InternalRep duplicate()
{
return new TclLong( value );
}
 
/// <summary> Implement this no-op for the InternalRep longerface.</summary>
 
public void dispose()
{
}
 
/// <summary> Called to query the string representation of the Tcl object. This
/// method is called only by TclObject.toString() when
/// TclObject.stringRep is null.
///
/// </summary>
/// <returns> the string representation of the Tcl object.
/// </returns>
public override string ToString()
{
return value.ToString();
}
 
/// <summary> Tcl_NewlongObj -> TclLong.newInstance
///
/// Creates a new instance of a TclObject with a TclLong longernal
/// representation.
///
/// </summary>
/// <param name="b">initial value of the long object.
/// </param>
/// <returns> the TclObject with the given long value.
/// </returns>
 
public static TclObject newInstance( long i )
{
return new TclObject( new TclLong( i ) );
}
 
/// <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() );
}
}
 
/// <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;
}
 
/// <summary> Changes the long value of the object.
///
/// </summary>
/// <param name="interp">current interpreter.
/// </param>
/// <param name="tobj">the object to operate on.
/// @paran i the new long value.
/// </param>
public static void set( TclObject tobj, long i )
{
tobj.invalidateStringRep();
InternalRep rep = tobj.InternalRep;
TclLong tlong;
 
if ( rep is TclLong )
{
tlong = (TclLong)rep;
tlong.value = i;
}
else
{
tobj.InternalRep = new TclLong( i );
}
}
}
}
/trunk/TCL/src/base/TclNumArgsException.cs
@@ -0,0 +1,81 @@
/*
* TclNumArgsException.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclNumArgsException.java,v 1.3 2003/01/12 02:44:28 mdejong Exp $
*
*/
using System.Text;
namespace tcl.lang
{
 
/// <summary> This exception is used to report wrong number of arguments in Tcl scripts.</summary>
 
public class TclNumArgsException : TclException
{
 
/// <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() );
}
}
}
}
/trunk/TCL/src/base/TclObject.cs
@@ -0,0 +1,435 @@
/*
* TclObject.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclObject.java,v 1.9 2003/01/09 02:15:40 mdejong Exp $
*
*/
using System;
using System.Text;
 
namespace tcl.lang
{
 
/// <summary> This class implements the basic notion of an "object" in Tcl. The
/// fundamental representation of an object is its string value. However,
/// an object can also have an internal representation, which is a "cached"
/// reprsentation of this object in another form. The type of the internal
/// rep of Tcl objects can mutate. This class provides the storage of the
/// string rep and the internal rep, as well as the facilities for mutating
/// the internal rep.
/// </summary>
 
public class TclObject
{
/// <summary> Returns the handle to the current internal rep. This method should be
/// called only by an InternalRep implementation.
/// the handle to the current internal rep.
/// Change the internal rep of the object. The old internal rep
/// will be deallocated as a result. This method should be
/// called only by an InternalRep implementation.
/// </summary>
/// <param name="rep">the new internal rep.
/// </param>
public InternalRep InternalRep
{
get
{
disposedCheck();
return internalRep;
}
 
set
{
disposedCheck();
if ( value == null )
{
throw new TclRuntimeError( "null InternalRep" );
}
if ( value == internalRep )
{
return;
}
 
// In the special case where the internal representation is a CObject,
// we want to call the special interface to convert the underlying
// native object into a reference to the Java TclObject. Note that
// this test will always fail if we are not using the native
// implementation. Also note that the makeReference method
// will do nothing in the case where the Tcl_Obj inside the
// CObject was originally allocated in Java. When converting
// to a CObject we need to break the link made earlier.
 
if ( ( internalRep is CObject ) && !( value is CObject ) )
{
// We must ensure that the string rep is copied into Java
// before we lose the reference to the underlying CObject.
// Otherwise we will lose the original string information
// when the backpointer is lost.
 
if ( (System.Object)stringRep == null )
{
stringRep = internalRep.ToString();
}
( (CObject)internalRep ).makeReference( this );
}
 
//System.out.println("TclObject setInternalRep for \"" + stringRep + "\"");
//System.out.println("from \"" + internalRep.getClass().getName() +
// "\" to \"" + rep.getClass().getName() + "\"");
internalRep.dispose();
internalRep = value;
}
 
}
/// <summary> Returns true if the TclObject is shared, false otherwise.</summary>
/// <returns> true if the TclObject is shared, false otherwise.
/// </returns>
public bool Shared
{
get
{
disposedCheck();
return ( refCount > 1 );
}
 
}
/// <summary> Returns the refCount of this object.
///
/// </summary>
/// <returns> refCount.
/// </returns>
public int RefCount
{
get
{
return refCount;
}
 
}
/// <summary> Returns the Tcl_Obj* objPtr member for a CObject or TclList.
/// This method is only called from Tcl Blend.
/// </summary>
internal long CObjectPtr
{
 
 
get
{
if ( internalRep is CObject )
{
return ( (CObject)internalRep ).CObjectPtr;
}
else
{
return 0;
}
}
 
}
/// <summary> Returns 2 if the internal rep is a TclList.
/// Returns 1 if the internal rep is a CObject.
/// Otherwise returns 0.
/// This method provides an optimization over
/// invoking getInternalRep() and two instanceof
/// checks via JNI. It is only used by Tcl Blend.
/// </summary>
internal int CObjectInst
{
 
 
get
{
if ( internalRep is CObject )
{
if ( internalRep is TclList )
return 2;
else
return 1;
}
else
{
return 0;
}
}
 
}
 
// Internal representation of the object.
 
protected internal InternalRep internalRep;
 
// Reference count of this object. When 0 the object will be deallocated.
 
protected internal int refCount;
 
// String representation of the object.
 
protected internal string stringRep;
 
// Return true if the TclObject contains a TclList.
public bool isListType() {
return (internalRep.GetType().ToString().Contains("TclList"));
}
/// <summary> Creates a TclObject with the given InternalRep. This method should be
/// called only by an InternalRep implementation.
///
/// </summary>
/// <param name="rep">the initial InternalRep for this object.
/// </param>
public TclObject( InternalRep rep )
{
if ( rep == null )
{
throw new TclRuntimeError( "null InternalRep" );
}
internalRep = rep;
stringRep = null;
refCount = 0;
}
 
/// <summary> Creates a TclObject with the given InternalRep and stringRep.
/// This constructor is used by the TclString class only. No other place
/// should call this constructor.
///
/// </summary>
/// <param name="rep">the initial InternalRep for this object.
/// </param>
/// <param name="s">the initial string rep for this object.
/// </param>
protected internal TclObject( TclString rep, string s )
{
if ( rep == null )
{
throw new TclRuntimeError( "null InternalRep" );
}
internalRep = rep;
stringRep = s;
refCount = 0;
}
 
/// <summary> Returns the string representation of the object.
///
/// </summary>
/// <returns> the string representation of the object.
/// </returns>
public override string ToString()
{
disposedCheck();
if ( (System.Object)stringRep == null )
{
stringRep = internalRep.ToString().Replace( "Infinity", "inf" );
}
return stringRep;
}
 
/// <summary> Returns the UTF8 byte representation of the object.
///
/// </summary>
/// <returns> the string representation of the object.
/// </returns>
public byte[] ToBytes()
{
disposedCheck();
if ( (System.Object)stringRep == null )
{
stringRep = internalRep.ToString();
}
return Encoding.UTF8.GetBytes( stringRep );
}
/// <summary> Sets the string representation of the object to null. Next
/// time when toString() is called, getInternalRep().toString() will
/// be called. This method should be called ONLY when an InternalRep
/// is about to modify the value of a TclObject.
///
/// </summary>
/// <exception cref=""> TclRuntimeError if object is not exclusively owned.
/// </exception>
public void invalidateStringRep()
{
disposedCheck();
if ( refCount > 1 )
{
throw new TclRuntimeError( "string representation of object \"" + ToString() + "\" cannot be invalidated: refCount = " + refCount );
}
stringRep = null;
}
 
/// <summary> Tcl_DuplicateObj -> duplicate
///
/// Duplicate a TclObject, this method provides the preferred
/// means to deal with modification of a shared TclObject.
/// It should be invoked in conjunction with isShared instead
/// of using the deprecated takeExclusive method.
///
/// Example:
///
/// if (tobj.isShared()) {
/// tobj = tobj.duplicate();
/// }
/// TclString.append(tobj, "hello");
///
/// </summary>
/// <returns> an TclObject with a refCount of 0.
/// </returns>
 
public TclObject duplicate()
{
disposedCheck();
if ( internalRep is TclString )
{
if ( (System.Object)stringRep == null )
{
stringRep = internalRep.ToString();
}
}
TclObject newObj = new TclObject( internalRep.duplicate() );
newObj.stringRep = this.stringRep;
newObj.refCount = 0;
return newObj;
}
 
/// <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_IncrRefCount -> preserve
///
/// Increments the refCount to indicate the caller's intent to
/// preserve the value of this object. Each preserve() call must be matched
/// by a corresponding release() call.
///
/// </summary>
/// <exception cref=""> TclRuntimeError if the object has already been deallocated.
/// </exception>
public void preserve()
{
disposedCheck();
if ( internalRep is CObject )
{
( (CObject)internalRep ).incrRefCount();
}
_preserve();
}
 
/// <summary> _preserve
///
/// Private implementation of preserve() method.
/// This method will be invoked from Native code
/// to change the TclObject's ref count without
/// effecting the ref count of a CObject.
/// </summary>
private void _preserve()
{
refCount++;
}
 
/// <summary> Tcl_DecrRefCount -> release
///
/// Decrements the refCount to indicate that the caller is no longer
/// interested in the value of this object. If the refCount reaches 0,
/// the obejct will be deallocated.
/// </summary>
public void release()
{
disposedCheck();
if ( internalRep is CObject )
{
( (CObject)internalRep ).decrRefCount();
}
_release();
}
 
/// <summary> _release
///
/// Private implementation of preserve() method.
/// This method will be invoked from Native code
/// to change the TclObject's ref count without
/// effecting the ref count of a CObject.
/// </summary>
private void _release()
{
refCount--;
if ( refCount <= 0 )
{
internalRep.dispose();
 
// Setting these to null will ensure that any attempt to use
// this object will result in a Java NullPointerException.
 
internalRep = null;
stringRep = null;
}
}
 
/// <summary> Raise a TclRuntimeError if this TclObject has been
/// disposed of before the last ref was released.
/// </summary>
 
private void disposedCheck()
{
if ( internalRep == null )
{
throw new TclRuntimeError( "TclObject has been deallocated" );
}
}
 
/// <summary> Return string describing type.</summary>
public string typePtr
{
get
{
if ( this.internalRep == null )
return "null";
string sType = this.internalRep.GetType().ToString().Replace( "tcl.lang.Tcl", "" ).ToLower();
if ( sType == "integer" )
return "int";
if ( sType == "long" )
return "int";
return sType;
}
}
 
}
}
/trunk/TCL/src/base/TclParse.cs
@@ -0,0 +1,329 @@
#undef DEBUG
/*
* TclParse.java --
*
* A Class of the following type is filled in by Parser.parseCommand.
* It describes a single command parsed from an input string.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclParse.java,v 1.2 1999/05/09 01:33:45 dejong Exp $
*/
using System;
namespace tcl.lang
{
 
public class TclParse
{
 
// The original command string passed to Parser.parseCommand.
 
public char[] inString;
 
// Index into 'string' that is the character just after the last
// one in the command string.
 
public int endIndex;
 
// Index into 'string' that is the # that begins the first of
// one or more comments preceding the command.
 
public int commentStart;
 
// Number of bytes in comments (up through newline character
// that terminates the last comment). If there were no
// comments, this field is 0.
 
public int commentSize;
 
// Index into 'string' that is the first character in first
// word of command.
 
public int commandStart;
 
// Number of bytes in command, including first character of
// first word, up through the terminating newline, close
// bracket, or semicolon.
 
public int commandSize;
 
// Total number of words in command. May be 0.
 
public int numWords;
 
// Stores the tokens that compose the command.
 
public TclToken[] tokenList;
 
// Total number of tokens in command.
 
internal int numTokens;
 
// Total number of tokens available at token.
 
internal int tokensAvailable;
 
/*
*----------------------------------------------------------------------
*
* The fields below are intended only for the private use of the
* parser. They should not be used by procedures that invoke
* Tcl_ParseCommand.
*
*----------------------------------------------------------------------
*/
 
// Interpreter to use for error reporting, or null.
 
internal Interp interp;
 
// Name of file from which script came, or null. Used for error
// messages.
 
internal string fileName;
 
// Line number corresponding to first character in string.
 
internal int lineNum;
 
// Points to character in string that terminated most recent token.
// Filled in by Parser.parseTokens. If an error occurs, points to
// beginning of region where the error occurred (e.g. the open brace
// if the close brace is missing).
 
public int termIndex;
 
// This field is set to true by Parser.parseCommand if the command
// appears to be incomplete. This information is used by
// Parser.commandComplete.
 
internal bool incomplete;
 
// When a TclParse is the return value of a method, result is set to
// a standard Tcl result, indicating the return of the method.
public TCL.CompletionCode result;
 
// Default size of the tokenList array.
 
private const int INITIAL_NUM_TOKENS = 20;
private const int MAX_CACHED_TOKENS = 50; //my tests show 50 is best
 
internal TclParse( Interp interp, char[] inString, int endIndex, string fileName, int lineNum )
{
this.interp = interp;
this.inString = inString;
this.endIndex = endIndex;
this.fileName = fileName;
this.lineNum = lineNum;
this.tokenList = new TclToken[INITIAL_NUM_TOKENS];
this.tokensAvailable = INITIAL_NUM_TOKENS;
this.numTokens = 0;
this.numWords = 0;
this.commentStart = -1;
this.commentSize = 0;
this.commandStart = -1;
this.commandSize = 0;
this.incomplete = false;
}
internal TclToken getToken( int index )
// The index into tokenList.
{
if ( index >= tokensAvailable )
{
expandTokenArray( index );
}
 
if ( tokenList[index] == null )
{
tokenList[index] = grabToken();
tokenList[index].script_array = tokenList[0].script_array;
}
return tokenList[index];
}
 
 
// Release internal resources that this TclParser object might have allocated
 
internal void release()
{
for ( int index = 0; index < tokensAvailable; index++ )
{
if ( tokenList[index] != null )
{
releaseToken( tokenList[index] );
tokenList[index] = null;
}
}
}
 
 
 
 
// Creating an interpreter will cause this init method to be called
 
internal static void init( Interp interp )
{
TclToken[] TOKEN_CACHE = new TclToken[MAX_CACHED_TOKENS];
for ( int i = 0; i < MAX_CACHED_TOKENS; i++ )
{
TOKEN_CACHE[i] = new TclToken();
}
 
interp.parserTokens = TOKEN_CACHE;
interp.parserTokensUsed = 0;
}
 
 
private TclToken grabToken()
{
if ( interp == null || interp.parserTokensUsed == MAX_CACHED_TOKENS )
{
// either we do not have a cache because the interp is null or we have already
// used up all the open cache slots, we just allocate a new one in this case
return new TclToken();
}
else
{
// the cache has an avaliable slot so grab it
return interp.parserTokens[interp.parserTokensUsed++];
}
}
 
private void releaseToken( TclToken token )
{
if ( interp != null && interp.parserTokensUsed > 0 )
{
// if cache is not full put the object back in the cache
interp.parserTokensUsed -= 1;
interp.parserTokens[interp.parserTokensUsed] = token;
}
}
 
 
/*
//uncommenting these methods will disable caching
static void init(Interp interp) {}
private TclToken grabToken() {return new TclToken();}
private void releaseToken(TclToken token) {}
*/
 
 
 
internal void expandTokenArray( int needed )
{
// Make sure there is at least enough room for needed tokens
while ( needed >= tokensAvailable )
{
tokensAvailable *= 2;
}
 
TclToken[] newList = new TclToken[tokensAvailable];
Array.Copy( (System.Array)tokenList, 0, (System.Array)newList, 0, tokenList.Length );
tokenList = newList;
}
 
public override string ToString()
{
 
return ( get().ToString() );
}
 
public TclObject get()
{
TclObject obj;
TclToken token;
string typeString;
int nextIndex;
string cmd;
int i;
 
 
System.Diagnostics.Debug.WriteLine( "Entered TclParse.get()" );
System.Diagnostics.Debug.WriteLine( "numTokens is " + numTokens );
 
obj = TclList.newInstance();
try
{
if ( commentSize > 0 )
{
TclList.append( interp, obj, TclString.newInstance( new string( inString, commentStart, commentSize ) ) );
}
else
{
TclList.append( interp, obj, TclString.newInstance( "-" ) );
}
 
if ( commandStart >= ( endIndex + 1 ) )
{
commandStart = endIndex;
}
cmd = new string( inString, commandStart, commandSize );
TclList.append( interp, obj, TclString.newInstance( cmd ) );
TclList.append( interp, obj, TclInteger.newInstance( numWords ) );
 
for ( i = 0; i < numTokens; i++ )
{
System.Diagnostics.Debug.WriteLine( "processing token " + i );
 
token = tokenList[i];
switch ( token.type )
{
 
case Parser.TCL_TOKEN_WORD:
typeString = "word";
break;
 
case Parser.TCL_TOKEN_SIMPLE_WORD:
typeString = "simple";
break;
 
case Parser.TCL_TOKEN_EXPAND_WORD:
typeString = "expand";
break;
 
case Parser.TCL_TOKEN_TEXT:
typeString = "text";
break;
 
case Parser.TCL_TOKEN_BS:
typeString = "backslash";
break;
 
case Parser.TCL_TOKEN_COMMAND:
typeString = "command";
break;
 
case Parser.TCL_TOKEN_VARIABLE:
typeString = "variable";
break;
 
default:
typeString = "??";
break;
 
}
 
System.Diagnostics.Debug.WriteLine( "typeString is " + typeString );
 
TclList.append( interp, obj, TclString.newInstance( typeString ) );
TclList.append( interp, obj, TclString.newInstance( token.TokenString ) );
TclList.append( interp, obj, TclInteger.newInstance( token.numComponents ) );
}
nextIndex = commandStart + commandSize;
TclList.append( interp, obj, TclString.newInstance( new string( inString, nextIndex, ( endIndex - nextIndex ) ) ) );
}
catch ( TclException e )
{
// Do Nothing.
}
 
return obj;
}
} // end TclParse
}
/trunk/TCL/src/base/TclPosixException.cs
@@ -0,0 +1,765 @@
/*
* TclPosixException.java --
*
* This file implements the TclPosixException class, used to report posix
* errors in Tcl scripts.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclPosixException.java,v 1.2 2001/11/22 00:08:36 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements exceptions used to report posix errors in Tcl scripts.
*/
 
class TclPosixException : TclException
{
 
internal const int EPERM = 1; /* Operation not permitted */
internal const int ENOENT = 2; /* No such file or directory */
internal const int ESRCH = 3; /* No such process */
internal const int EINTR = 4; /* Interrupted system call */
internal const int EIO = 5; /* Input/output error */
internal const int ENXIO = 6; /* Device not configured */
internal const int E2BIG = 7; /* Argument list too long */
internal const int ENOEXEC = 8; /* Exec format error */
internal const int EBADF = 9; /* Bad file descriptor */
internal const int ECHILD = 10; /* No child processes */
internal const int EDEADLK = 11; /* Resource deadlock avoided */
/* 11 was EAGAIN */
internal const int ENOMEM = 12; /* Cannot allocate memory */
internal const int EACCES = 13; /* Permission denied */
internal const int EFAULT = 14; /* Bad address */
internal const int ENOTBLK = 15; /* Block device required */
internal const int EBUSY = 16; /* Device busy */
internal const int EEXIST = 17; /* File exists */
internal const int EXDEV = 18; /* Cross-device link */
internal const int ENODEV = 19; /* Operation not supported by device */
internal const int ENOTDIR = 20; /* Not a directory */
internal const int EISDIR = 21; /* Is a directory */
internal const int EINVAL = 22; /* Invalid argument */
internal const int ENFILE = 23; /* Too many open files in system */
internal const int EMFILE = 24; /* Too many open files */
internal const int ENOTTY = 25; /* Inappropriate ioctl for device */
internal const int ETXTBSY = 26; /* Text file busy */
internal const int EFBIG = 27; /* File too large */
internal const int ENOSPC = 28; /* No space left on device */
internal const int ESPIPE = 29; /* Illegal seek */
internal const int EROFS = 30; /* Read-only file system */
internal const int EMLINK = 31; /* Too many links */
internal const int EPIPE = 32; /* Broken pipe */
internal const int EDOM = 33; /* Numerical argument out of domain */
internal const int ERANGE = 34; /* Result too large */
internal const int EAGAIN = 35; /* Resource temporarily unavailable */
internal const int EWOULDBLOCK = EAGAIN; /* Operation would block */
internal const int EINPROGRESS = 36; /* Operation now in progress */
internal const int EALREADY = 37; /* Operation already in progress */
internal const int ENOTSOCK = 38; /* Socket operation on non-socket */
internal const int EDESTADDRREQ = 39; /* Destination address required */
internal const int EMSGSIZE = 40; /* Message too long */
internal const int EPROTOTYPE = 41; /* Protocol wrong type for socket */
internal const int ENOPROTOOPT = 42; /* Protocol not available */
internal const int EPROTONOSUPPORT = 43; /* Protocol not supported */
internal const int ESOCKTNOSUPPORT = 44; /* Socket type not supported */
internal const int EOPNOTSUPP = 45; /* Operation not supported on socket */
internal const int EPFNOSUPPORT = 46; /* Protocol family not supported */
internal const int EAFNOSUPPORT = 47; /* Address family not supported by
/* protocol family */
internal const int EADDRINUSE = 48; /* Address already in use */
internal const int EADDRNOTAVAIL = 49; /* Can't assign requested
/* address */
internal const int ENETDOWN = 50; /* Network is down */
internal const int ENETUNREACH = 51; /* Network is unreachable */
internal const int ENETRESET = 52; /* Network dropped connection on reset */
internal const int ECONNABORTED = 53; /* Software caused connection abort */
internal const int ECONNRESET = 54; /* Connection reset by peer */
internal const int ENOBUFS = 55; /* No buffer space available */
internal const int EISCONN = 56; /* Socket is already connected */
internal const int ENOTCONN = 57; /* Socket is not connected */
internal const int ESHUTDOWN = 58; /* Can't send after socket shutdown */
internal const int ETOOMANYREFS = 59; /* Too many references: can't splice */
internal const int ETIMEDOUT = 60; /* Connection timed out */
internal const int ECONNREFUSED = 61; /* Connection refused */
internal const int ELOOP = 62; /* Too many levels of symbolic links */
internal const int ENAMETOOLONG = 63; /* File name too long */
internal const int EHOSTDOWN = 64; /* Host is down */
internal const int EHOSTUNREACH = 65; /* No route to host */
internal const int ENOTEMPTY = 66; /* Directory not empty */
internal const int EPROCLIM = 67; /* Too many processes */
internal const int EUSERS = 68; /* Too many users */
internal const int EDQUOT = 69; /* Disc quota exceeded */
internal const int ESTALE = 70; /* Stale NFS file handle */
internal const int EREMOTE = 71; /* Too many levels of remote in path */
internal const int EBADRPC = 72; /* RPC struct is bad */
internal const int ERPCMISMATCH = 73; /* RPC version wrong */
internal const int EPROGUNAVAIL = 74; /* RPC prog. not avail */
internal const int EPROGMISMATCH = 75; /* Program version wrong */
internal const int EPROCUNAVAIL = 76; /* Bad procedure for program */
internal const int ENOLCK = 77; /* No locks available */
internal const int ENOSYS = 78; /* Function not implemented */
internal const int EFTYPE = 79; /* Inappropriate file type or format */
 
 
 
public TclPosixException( Interp interp, int errno, 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 )
{
interp.setResult( errorMsg );
}
}
 
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 );
}
}
}
private static string getPosixId( int errno )
// Code of posix error.
{
switch ( errno )
{
 
case E2BIG:
return "E2BIG";
 
case EACCES:
return "EACCES";
 
case EADDRINUSE:
return "EADDRINUSE";
 
case EADDRNOTAVAIL:
return "EADDRNOTAVAIL";
//case EADV: return "EADV";
 
case EAFNOSUPPORT:
return "EAFNOSUPPORT";
 
case EAGAIN:
return "EAGAIN";
//case EALIGN: return "EALIGN";
 
case EALREADY:
return "EALREADY";
//case EBADE: return "EBADE";
 
case EBADF:
return "EBADF";
//case EBADFD: return "EBADFD";
//case EBADMSG: return "EBADMSG";
//case EBADR: return "EBADR";
 
case EBADRPC:
return "EBADRPC";
//case EBADRQC: return "EBADRQC";
//case EBADSLT: return "EBADSLT";
//case EBFONT: return "EBFONT";
 
case EBUSY:
return "EBUSY";
 
case ECHILD:
return "ECHILD";
//case ECHRNG: return "ECHRNG";
//case ECOMM: return "ECOMM";
 
case ECONNABORTED:
return "ECONNABORTED";
 
case ECONNREFUSED:
return "ECONNREFUSED";
 
case ECONNRESET:
return "ECONNRESET";
 
case EDEADLK:
return "EDEADLK";
//case EDEADLOCK: return "EDEADLOCK";
 
case EDESTADDRREQ:
return "EDESTADDRREQ";
//case EDIRTY: return "EDIRTY";
 
case EDOM:
return "EDOM";
//case EDOTDOT: return "EDOTDOT";
 
case EDQUOT:
return "EDQUOT";
//case EDUPPKG: return "EDUPPKG";
 
case EEXIST:
return "EEXIST";
 
case EFAULT:
return "EFAULT";
 
case EFBIG:
return "EFBIG";
 
case EHOSTDOWN:
return "EHOSTDOWN";
 
case EHOSTUNREACH:
return "EHOSTUNREACH";
//case EIDRM: return "EIDRM";
//case EINIT: return "EINIT";
 
case EINPROGRESS:
return "EINPROGRESS";
 
case EINTR:
return "EINTR";
 
case EINVAL:
return "EINVAL";
 
case EIO:
return "EIO";
 
case EISCONN:
return "EISCONN";
 
case EISDIR:
return "EISDIR";
//case EISNAM: return "EISNAM";
//case ELBIN: return "ELBIN";
//case EL2HLT: return "EL2HLT";
//case EL2NSYNC: return "EL2NSYNC";
//case EL3HLT: return "EL3HLT";
//case EL3RST: return "EL3RST";
//case ELIBACC: return "ELIBACC";
//case ELIBBAD: return "ELIBBAD";
//case ELIBEXEC: return "ELIBEXEC";
//case ELIBMAX: return "ELIBMAX";
//case ELIBSCN: return "ELIBSCN";
//case ELNRNG: return "ELNRNG";
 
case ELOOP:
return "ELOOP";
 
case EMLINK:
return "EMLINK";
 
case EMSGSIZE:
return "EMSGSIZE";
//case EMULTIHOP: return "EMULTIHOP";
 
case ENAMETOOLONG:
return "ENAMETOOLONG";
//case ENAVAIL: return "ENAVAIL";
//case ENET: return "ENET";
 
case ENETDOWN:
return "ENETDOWN";
 
case ENETRESET:
return "ENETRESET";
 
case ENETUNREACH:
return "ENETUNREACH";
 
case ENFILE:
return "ENFILE";
//case ENOANO: return "ENOANO";
 
case ENOBUFS:
return "ENOBUFS";
//case ENOCSI: return "ENOCSI";
//case ENODATA: return "ENODATA";
 
case ENODEV:
return "ENODEV";
 
case ENOENT:
return "ENOENT";
 
case ENOEXEC:
return "ENOEXEC";
 
case ENOLCK:
return "ENOLCK";
//case ENOLINK: return "ENOLINK";
 
case ENOMEM:
return "ENOMEM";
//case ENOMSG: return "ENOMSG";
//case ENONET: return "ENONET";
//case ENOPKG: return "ENOPKG";
 
case ENOPROTOOPT:
return "ENOPROTOOPT";
 
case ENOSPC:
return "ENOSPC";
//case ENOSR: return "ENOSR";
//case ENOSTR: return "ENOSTR";
//case ENOSYM: return "ENOSYM";
 
case ENOSYS:
return "ENOSYS";
 
case ENOTBLK:
return "ENOTBLK";
 
case ENOTCONN:
return "ENOTCONN";
 
case ENOTDIR:
return "ENOTDIR";
 
case ENOTEMPTY:
return "ENOTEMPTY";
//case ENOTNAM: return "ENOTNAM";
 
case ENOTSOCK:
return "ENOTSOCK";
//case ENOTSUP: return "ENOTSUP";
 
case ENOTTY:
return "ENOTTY";
//case ENOTUNIQ: return "ENOTUNIQ";
 
case ENXIO:
return "ENXIO";
 
case EOPNOTSUPP:
return "EOPNOTSUPP";
 
case EPERM:
return "EPERM";
 
case EPFNOSUPPORT:
return "EPFNOSUPPORT";
 
case EPIPE:
return "EPIPE";
 
case EPROCLIM:
return "EPROCLIM";
 
case EPROCUNAVAIL:
return "EPROCUNAVAIL";
 
case EPROGMISMATCH:
return "EPROGMISMATCH";
 
case EPROGUNAVAIL:
return "EPROGUNAVAIL";
//case EPROTO: return "EPROTO";
 
case EPROTONOSUPPORT:
return "EPROTONOSUPPORT";
 
case EPROTOTYPE:
return "EPROTOTYPE";
 
case ERANGE:
return "ERANGE";
//case EREFUSED: return "EREFUSED";
//case EREMCHG: return "EREMCHG";
//case EREMDEV: return "EREMDEV";
 
case EREMOTE:
return "EREMOTE";
//case EREMOTEIO: return "EREMOTEIO";
//case EREMOTERELEASE: return "EREMOTERELEASE";
 
case EROFS:
return "EROFS";
 
case ERPCMISMATCH:
return "ERPCMISMATCH";
//case ERREMOTE: return "ERREMOTE";
 
case ESHUTDOWN:
return "ESHUTDOWN";
 
case ESOCKTNOSUPPORT:
return "ESOCKTNOSUPPORT";
 
case ESPIPE:
return "ESPIPE";
 
case ESRCH:
return "ESRCH";
//case ESRMNT: return "ESRMNT";
 
case ESTALE:
return "ESTALE";
//case ESUCCESS: return "ESUCCESS";
//case ETIME: return "ETIME";
 
case ETIMEDOUT:
return "ETIMEDOUT";
 
case ETOOMANYREFS:
return "ETOOMANYREFS";
 
case ETXTBSY:
return "ETXTBSY";
//case EUCLEAN: return "EUCLEAN";
//case EUNATCH: return "EUNATCH";
 
case EUSERS:
return "EUSERS";
//case EVERSION: return "EVERSION";
//case EWOULDBLOCK: return "EWOULDBLOCK";
 
case EXDEV:
return "EXDEV";
//case EXFULL: return "EXFULL";
}
return "unknown error";
}
internal static string getPosixMsg( int errno )
// Code of posix error.
{
switch ( errno )
{
 
case E2BIG:
return "argument list too long";
 
case EACCES:
return "permission denied";
 
case EADDRINUSE:
return "address already in use";
 
case EADDRNOTAVAIL:
return "can't assign requested address";
//case EADV: return "advertise error";
 
case EAFNOSUPPORT:
return "address family not supported by protocol family";
 
case EAGAIN:
return "resource temporarily unavailable";
//case EALIGN: return "EALIGN";
 
case EALREADY:
return "operation already in progress";
//case EBADE: return "bad exchange descriptor";
 
case EBADF:
return "bad file number";
//case EBADFD: return "file descriptor in bad state";
//case EBADMSG: return "not a data message";
//case EBADR: return "bad request descriptor";
 
case EBADRPC:
return "RPC structure is bad";
//case EBADRQC: return "bad request code";
//case EBADSLT: return "invalid slot";
//case EBFONT: return "bad font file format";
 
case EBUSY:
return "file busy";
 
case ECHILD:
return "no children";
//case ECHRNG: return "channel number out of range";
//case ECOMM: return "communication error on send";
 
case ECONNABORTED:
return "software caused connection abort";
 
case ECONNREFUSED:
return "connection refused";
 
case ECONNRESET:
return "connection reset by peer";
 
case EDEADLK:
return "resource deadlock avoided";
//case EDEADLOCK: return "resource deadlock avoided";
 
case EDESTADDRREQ:
return "destination address required";
//case EDIRTY: return "mounting a dirty fs w/o force";
 
case EDOM:
return "math argument out of range";
//case EDOTDOT: return "cross mount point";
 
case EDQUOT:
return "disk quota exceeded";
//case EDUPPKG: return "duplicate package name";
 
case EEXIST:
return "file already exists";
 
case EFAULT:
return "bad address in system call argument";
 
case EFBIG:
return "file too large";
 
case EHOSTDOWN:
return "host is down";
 
case EHOSTUNREACH:
return "host is unreachable";
//case EIDRM: return "identifier removed";
//case EINIT: return "initialization error";
 
case EINPROGRESS:
return "operation now in progress";
 
case EINTR:
return "interrupted system call";
 
case EINVAL:
return "invalid argument";
 
case EIO:
return "I/O error";
 
case EISCONN:
return "socket is already connected";
 
case EISDIR:
return "illegal operation on a directory";
//case EISNAM: return "is a name file";
//case ELBIN: return "ELBIN";
//case EL2HLT: return "level 2 halted";
//case EL2NSYNC: return "level 2 not synchronized";
//case EL3HLT: return "level 3 halted";
//case EL3RST: return "level 3 reset";
//case ELIBACC: return "can not access a needed shared library";
//case ELIBBAD: return "accessing a corrupted shared library";
//case ELIBEXEC: return "can not exec a shared library directly";
//case ELIBMAX: return
//"attempting to link in more shared libraries than system limit";
//case ELIBSCN: return ".lib section in a.out corrupted";
//case ELNRNG: return "link number out of range";
 
case ELOOP:
return "too many levels of symbolic links";
 
case EMFILE:
return "too many open files";
 
case EMLINK:
return "too many links";
 
case EMSGSIZE:
return "message too long";
//case EMULTIHOP: return "multihop attempted";
 
case ENAMETOOLONG:
return "file name too long";
//case ENAVAIL: return "not available";
//case ENET: return "ENET";
 
case ENETDOWN:
return "network is down";
 
case ENETRESET:
return "network dropped connection on reset";
 
case ENETUNREACH:
return "network is unreachable";
 
case ENFILE:
return "file table overflow";
//case ENOANO: return "anode table overflow";
 
case ENOBUFS:
return "no buffer space available";
//case ENOCSI: return "no CSI structure available";
//case ENODATA: return "no data available";
 
case ENODEV:
return "no such device";
 
case ENOENT:
return "no such file or directory";
 
case ENOEXEC:
return "exec format error";
 
case ENOLCK:
return "no locks available";
//case ENOLINK: return "link has be severed";
 
case ENOMEM:
return "not enough memory";
//case ENOMSG: return "no message of desired type";
//case ENONET: return "machine is not on the network";
//case ENOPKG: return "package not installed";
 
case ENOPROTOOPT:
return "bad proocol option";
 
case ENOSPC:
return "no space left on device";
//case ENOSR: return "out of stream resources";
//case ENOSTR: return "not a stream device";
//case ENOSYM: return "unresolved symbol name";
 
case ENOSYS:
return "function not implemented";
 
case ENOTBLK:
return "block device required";
 
case ENOTCONN:
return "socket is not connected";
 
case ENOTDIR:
return "not a directory";
 
case ENOTEMPTY:
return "directory not empty";
//case ENOTNAM: return "not a name file";
 
case ENOTSOCK:
return "socket operation on non-socket";
//case ENOTSUP: return "operation not supported";
 
case ENOTTY:
return "inappropriate device for ioctl";
//case ENOTUNIQ: return "name not unique on network";
 
case ENXIO:
return "no such device or address";
 
case EOPNOTSUPP:
return "operation not supported on socket";
 
case EPERM:
return "not owner";
 
case EPFNOSUPPORT:
return "protocol family not supported";
 
case EPIPE:
return "broken pipe";
 
case EPROCLIM:
return "too many processes";
 
case EPROCUNAVAIL:
return "bad procedure for program";
 
case EPROGMISMATCH:
return "program version wrong";
 
case EPROGUNAVAIL:
return "RPC program not available";
//case EPROTO: return "protocol error";
 
case EPROTONOSUPPORT:
return "protocol not suppored";
 
case EPROTOTYPE:
return "protocol wrong type for socket";
 
case ERANGE:
return "math result unrepresentable";
//case EREFUSED: return "EREFUSED";
//case EREMCHG: return "remote address changed";
//case EREMDEV: return "remote device";
 
case EREMOTE:
return "pathname hit remote file system";
//case EREMOTEIO: return "remote i/o error";
//case EREMOTERELEASE: return "EREMOTERELEASE";
 
case EROFS:
return "read-only file system";
 
case ERPCMISMATCH:
return "RPC version is wrong";
//case ERREMOTE: return "object is remote";
 
case ESHUTDOWN:
return "can't send afer socket shutdown";
 
case ESOCKTNOSUPPORT:
return "socket type not supported";
 
case ESPIPE:
return "invalid seek";
 
case ESRCH:
return "no such process";
//case ESRMNT: return "srmount error";
 
case ESTALE:
return "stale remote file handle";
//case ESUCCESS: return "Error 0";
//case ETIME: return "timer expired";
 
case ETIMEDOUT:
return "connection timed out";
 
case ETOOMANYREFS:
return "too many references: can't splice";
 
case ETXTBSY:
return "text file or pseudo-device busy";
//case EUCLEAN: return "structure needs cleaning";
//case EUNATCH: return "protocol driver not attached";
 
case EUSERS:
return "too many users";
//case EVERSION: return "version mismatch";
//case EWOULDBLOCK: return "operation would block";
 
case EXDEV:
return "cross-domain link";
//case EXFULL: return "message tables full";
 
default:
return "unknown POSIX error";
 
}
}
} // end TclPosixException class
}
/trunk/TCL/src/base/TclRegexp.cs
@@ -0,0 +1,48 @@
/*
* TclRegexp.java
*
* Copyright (c) 1999 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* SCCS: %Z% %M% %I% %E% %U%
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
*/
using System;
using Regexp = sunlabs.brazil.util.regexp.Regexp;
namespace tcl.lang
{
 
public class TclRegexp
{
private TclRegexp()
{
}
 
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 );
}
}
}
}
/trunk/TCL/src/base/TclRuntimeError.cs
@@ -0,0 +1,39 @@
/*
* TclRuntimeError.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclRuntimeError.java,v 1.1.1.1 1998/10/14 21:09:14 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> Signals that a unrecoverable run-time error in the interpreter.
/// Similar to the panic() function in C.
/// </summary>
public class TclRuntimeError : System.SystemException
{
/// <summary> Constructs a TclRuntimeError with the specified detail
/// message.
///
/// </summary>
/// <param name="s">the detail message.
/// </param>
public TclRuntimeError( string s )
: base( s )
{
}
public TclRuntimeError( string s, Exception inner )
: base( s, inner )
{
}
}
}
/trunk/TCL/src/base/TclString.cs
@@ -0,0 +1,221 @@
/*
* TclList.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclString.java,v 1.5 2003/03/08 03:42:56 mdejong Exp $
*
*/
using System.Text;
namespace tcl.lang
{
 
// This class implements the string object type in Tcl.
 
public class TclString : InternalRep
{
/// <summary> Called to convert the other object's internal rep to string.
///
/// </summary>
/// <param name="tobj">the TclObject to convert to use the TclString internal rep.
/// </param>
private static TclObject StringFromAny
{
set
{
InternalRep rep = value.InternalRep;
 
if ( !( rep is TclString ) )
{
// make sure that this object now has a valid string rep.
 
value.ToString();
 
// Change the type of the object to TclString.
 
value.InternalRep = new TclString();
}
}
 
/*
* public static String get(TclObject tobj) {;}
*
* There is no "get" class method for TclString representations.
* Use tobj.toString() instead.
*/
 
}
 
// Used to perform "append" operations. After an append op,
// sbuf.toString() will contain the latest value of the string and
// tobj.stringRep will be set to null. This field is not private
// since it will need to be accessed directly by Jacl's IO code.
 
internal StringBuilder sbuf;
 
private TclString()
{
sbuf = null;
}
 
private TclString( StringBuilder sb )
{
sbuf = sb;
}
 
/// <summary> Returns a dupilcate of the current object.</summary>
/// <param name="obj">the TclObject that contains this internalRep.
/// </param>
 
public InternalRep duplicate()
{
return new TclString();
}
 
/// <summary> Implement this no-op for the InternalRep interface.</summary>
 
public void dispose()
{
}
 
/// <summary> Called to query the string representation of the Tcl object. This
/// method is called only by TclObject.toString() when
/// TclObject.stringRep is null.
///
/// </summary>
/// <returns> the string representation of the Tcl object.
/// </returns>
public override string ToString()
{
if ( sbuf == null )
{
return "";
}
else
{
return sbuf.ToString();
}
}
 
/// <summary> Create a new TclObject that has a string representation with
/// the given string value.
/// </summary>
public static TclObject newInstance( string str )
{
return new TclObject( new TclString(), str );
}
 
/// <summary> Create a new TclObject that makes use of the given StringBuffer
/// object. The passed in StringBuffer should not be modified after
/// it is passed to this method.
/// </summary>
internal static TclObject newInstance( StringBuilder sb )
{
return new TclObject( new TclString( sb ) );
}
 
internal static TclObject newInstance( System.Object o )
{
return newInstance( o.ToString() );
}
 
/// <summary> Create a TclObject with an internal TclString representation
/// whose initial value is a string with the single character.
///
/// </summary>
/// <param name="c">initial value of the string.
/// </param>
 
internal static TclObject newInstance( char c )
{
char[] charArray = new char[1];
charArray[0] = c;
return newInstance( new string( charArray ) );
}
 
 
/// <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 StringBuilder( tobj.ToString() );
}
tobj.invalidateStringRep();
tstr.sbuf.Append( toAppend );
}
 
/// <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 StringBuilder( tobj.ToString() );
}
tobj.invalidateStringRep();
tstr.sbuf.Append( charArr, offset, length );
}
 
/// <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() );
}
 
/// <summary> This procedure clears out an existing TclObject so
/// that it has a string representation of "".
/// </summary>
 
public static void empty( TclObject tobj )
{
StringFromAny = tobj;
 
TclString tstr = (TclString)tobj.InternalRep;
if ( tstr.sbuf == null )
{
tstr.sbuf = new StringBuilder();
}
else
{
tstr.sbuf.Length = 0;
}
tobj.invalidateStringRep();
}
}
}
/trunk/TCL/src/base/TclToken.cs
@@ -0,0 +1,138 @@
#undef DEBUG
/*
* TclToken.java --
*
* For each word of a command, and for each piece of a word such as a
* variable reference, a TclToken is used to describe the word.
*
* Note: TclToken is designed to be write-once with respect to
* setting the script and size variables. Failure to do this
* may lead to inconsistencies in calls to getTokenString().
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclToken.java,v 1.2 1999/05/09 01:34:50 dejong Exp $
*/
using System.Text;
namespace tcl.lang
{
 
public class TclToken
{
internal string TokenString
{
get
{
#if DEBUG
if ((script_index + size) > script_array.Length)
{
System.Diagnostics.Debug.WriteLine("Entered TclToken.getTokenString()");
System.Diagnostics.Debug.WriteLine("hashCode() is " + GetHashCode());
System.Diagnostics.Debug.WriteLine("script_array.length is " + script_array.Length);
System.Diagnostics.Debug.WriteLine("script_index is " + script_index);
System.Diagnostics.Debug.WriteLine("size is " + size);
System.Diagnostics.Debug.Write("the string is \"");
for (int k = 0; k < script_array.Length; k++)
{
System.Diagnostics.Debug.Write(script_array[k]);
}
System.Diagnostics.Debug.WriteLine("\"");
}
#endif
 
return ( new string( script_array, script_index, size ) );
}
 
}
 
// Contains an array the references the script from where the
// token originates from and an index to the first character
// of the token inside the script.
 
 
internal char[] script_array;
internal int script_index;
 
// Number of bytes in token.
 
public int size;
 
// Type of token, such as TCL_TOKEN_WORD; See Parse.java
// for valid types.
 
internal int type;
 
// If this token is composed of other tokens, this field
// tells how many of them there are (including components
// of components, etc.). The component tokens immediately
// follow this one.
 
internal int numComponents;
internal TclToken()
{
script_array = null;
script_index = -1;
}
public override string ToString()
{
StringBuilder sbuf = new StringBuilder();
switch ( type )
{
 
case Parser.TCL_TOKEN_WORD:
{
sbuf.Append( "\n Token Type: TCL_TOKEN_WORD" );
break;
}
 
case Parser.TCL_TOKEN_SIMPLE_WORD:
{
sbuf.Append( "\n Token Type: TCL_TOKEN_SIMPLE_WORD" );
break;
}
 
case Parser.TCL_TOKEN_EXPAND_WORD:
{
sbuf.Append( "\n Token Type: TCL_TOKEN_EXPAND_WORD" );
break;
}
case Parser.TCL_TOKEN_TEXT:
{
sbuf.Append( "\n Token Type: TCL_TOKEN_TEXT" );
break;
}
 
case Parser.TCL_TOKEN_BS:
{
sbuf.Append( "\n Token Type: TCL_TOKEN_BS" );
break;
}
 
case Parser.TCL_TOKEN_COMMAND:
{
sbuf.Append( "\n Token Type: TCL_TOKEN_COMMAND" );
break;
}
 
case Parser.TCL_TOKEN_VARIABLE:
{
sbuf.Append( "\n Token Type: TCL_TOKEN_VARIABLE" );
break;
}
}
sbuf.Append( "\n String: " + TokenString );
sbuf.Append( "\n String Size: " + TokenString.Length );
sbuf.Append( "\n ScriptIndex: " + script_index );
sbuf.Append( "\n NumComponents: " + numComponents );
sbuf.Append( "\n Token Size: " + size );
return sbuf.ToString();
}
} // end TclToken
}
/trunk/TCL/src/base/TclVarException.cs
@@ -0,0 +1,56 @@
/*
* TclNumArgsException.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclVarException.java,v 1.1.1.1 1998/10/14 21:09:19 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This exception is used to report variable errors in Tcl.</summary>
 
class TclVarException : TclException
{
 
/// <summary> Creates an exception with the appropiate Tcl error message to
/// indicate an error with variable access.
///
/// </summary>
/// <param name="interp">currrent interpreter.
/// </param>
/// <param name="name1">first part of a variable name.
/// </param>
/// <param name="name2">second part of a variable name. May be null.
/// </param>
/// <param name="operation">either "read" or "set".
/// </param>
/// <param name="reason">a string message to explain why the operation fails..
/// </param>
 
internal TclVarException( Interp interp, string name1, string name2, string operation, string reason )
: base( TCL.CompletionCode.ERROR )
{
if ( interp != null )
{
interp.resetResult();
if ( (System.Object)name2 == null )
{
interp.setResult( "can't " + operation + " \"" + name1 + "\": " + reason );
}
else
{
interp.setResult( "can't " + operation + " \"" + name1 + "(" + name2 + ")\": " + reason );
}
}
}
}
}
/trunk/TCL/src/base/TimerHandler.cs
@@ -0,0 +1,144 @@
/*
* TimerHandler.java --
*
* The API for defining timer event handler.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TimerHandler.java,v 1.1.1.1 1998/10/14 21:09:21 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This abstract class is used to define timer handlers.
*/
 
abstract public class TimerHandler
{
 
/*
* Back pointer to the notifier that will fire this timer.
*/
 
internal Notifier notifier;
 
/*
* System time at (of after) which the timer should be fired.
*/
 
internal long atTime;
 
/*
* True if the cancel() method has been called.
*/
 
internal bool isCancelled;
 
/*
* Used to distinguish older idle handlers from recently-created ones.
*/
 
internal int generation;
 
public TimerHandler( Notifier n, int milliseconds )
{
int i;
 
atTime = ( System.DateTime.Now.Ticks - 621355968000000000 ) / 10000 + milliseconds;
notifier = (Notifier)n;
isCancelled = false;
 
/*
* Add the event to the queue in the correct position (ordered by
* event firing time).
*
* NOTE: it's very important that if two timer handlers have the
* same atTime, the newer timer handler always goes after the
* older handler in the list. See comments in
* Notifier.TimerEvent.processEvent() for details.
*/
 
lock ( notifier )
{
generation = notifier.timerGeneration;
 
for ( i = 0; i < notifier.timerList.Count; i++ )
{
TimerHandler q = (TimerHandler)notifier.timerList[i];
if ( atTime < q.atTime )
{
break;
}
}
notifier.timerList.Insert( i, this );
 
if ( System.Threading.Thread.CurrentThread != notifier.primaryThread )
{
System.Threading.Monitor.PulseAll( notifier );
}
}
}
public void cancel()
{
lock ( this )
{
if ( isCancelled )
{
return;
}
 
isCancelled = true;
 
lock ( notifier )
{
for ( int i = 0; i < notifier.timerList.Count; i++ )
{
if ( notifier.timerList[i] == this )
{
notifier.timerList.RemoveAt( i );
 
/*
* We can return now because the same timer can be
* registered only once in the list of timers.
*/
 
return;
}
}
}
}
}
internal int invoke()
{
lock ( this )
{
/*
* The timer may be cancelled after it was put on the
* event queue. Check its isCancelled field to make sure it's
* not cancelled.
*/
 
if ( !isCancelled )
{
processTimerEvent();
return 1;
}
else
{
return 0;
}
}
}
abstract public void processTimerEvent();
} // end TimerHandler
}
/trunk/TCL/src/base/TraceRecord.cs
@@ -0,0 +1,40 @@
/*
* TraceRecord.java --
*
* This class is used internally by CallFrame to store one
* variable trace.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TraceRecord.java,v 1.2 1999/07/28 03:27:36 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class is used internally by CallFrame to store one variable
/// trace.
/// </summary>
 
class TraceRecord
{
 
/// <summary> Stores info about the conditions under which this trace should be
/// triggered. Should be a combination of TCL.VarFlag.TRACE_READS, TCL.VarFlag.TRACE_WRITES
/// or TCL.VarFlag.TRACE_UNSETS.
/// </summary>
 
internal TCL.VarFlag flags;
 
/// <summary> Stores the trace procedure to invoke when a trace is fired.</summary>
 
internal VarTrace trace;
} // end TraceRecord
}
/trunk/TCL/src/base/Util.cs
@@ -0,0 +1,1470 @@
#undef DEBUG
/*
* Util.java --
*
* This class provides useful Tcl utility methods.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997-1999 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: Util.java,v 1.10 2002/05/16 22:53:45 mdejong Exp $
*/
using System;
using System.Text;
using Regexp = sunlabs.brazil.util.regexp.Regexp;
namespace tcl.lang
{
 
public class Util
{
public static int ActualPlatform
{
get
{
if ( Util.Windows )
{
return JACL.PLATFORM_WINDOWS;
}
if ( Util.Mac )
{
return JACL.PLATFORM_MAC;
}
return JACL.PLATFORM_UNIX;
}
 
}
public static bool Unix
{
get
{
if ( Mac || Windows )
{
return false;
}
return true;
}
 
}
public static bool Mac
{
get
{
return false;
}
 
}
public static bool Windows
{
get
{
// TODO .NET ist always Windows now
return true;
}
 
}
 
internal const int TCL_DONT_USE_BRACES = 1;
internal const int USE_BRACES = 2;
internal const int BRACES_UNMATCHED = 4;
 
// Some error messages.
 
internal const string intTooBigCode = "ARITH IOVERFLOW {integer value too large to represent}";
internal const string fpTooBigCode = "ARITH OVERFLOW {floating-point value too large to represent}";
 
// This table below is used to convert from ASCII digits to a
// numerical equivalent. It maps from '0' through 'z' to integers
// (100 for non-digit characters).
 
internal static char[] cvtIn = new char[] { (char)( 0 ), (char)( 1 ), (char)( 2 ), (char)( 3 ), (char)( 4 ), (char)( 5 ), (char)( 6 ), (char)( 7 ), (char)( 8 ), (char)( 9 ), (char)( 100 ), (char)( 100 ), (char)( 100 ), (char)( 100 ), (char)( 100 ), (char)( 100 ), (char)( 100 ), (char)( 10 ), (char)( 11 ), (char)( 12 ), (char)( 13 ), (char)( 14 ), (char)( 15 ), (char)( 16 ), (char)( 17 ), (char)( 18 ), (char)( 19 ), (char)( 20 ), (char)( 21 ), (char)( 22 ), (char)( 23 ), (char)( 24 ), (char)( 25 ), (char)( 26 ), (char)( 27 ), (char)( 28 ), (char)( 29 ), (char)( 30 ), (char)( 31 ), (char)( 32 ), (char)( 33 ), (char)( 34 ), (char)( 35 ), (char)( 100 ), (char)( 100 ), (char)( 100 ), (char)( 100 ), (char)( 100 ), (char)( 100 ), (char)( 10 ), (char)( 11 ), (char)( 12 ), (char)( 13 ), (char)( 14 ), (char)( 15 ), (char)( 16 ), (char)( 17 ), (char)( 18 ), (char)( 19 ), (char)( 20 ), (char)( 21 ), (char)( 22 ), (char)( 23 ), (char)( 24 ), (char)( 25 ), (char)( 26 ), (char)( 27 ), (char)( 28 ), (char)( 29 ), (char)( 30 ), (char)( 31 ), (char)( 32 ), (char)( 33 ), (char)( 34 ), (char)( 35 ) };
 
// Largest possible base 10 exponent. Any
// exponent larger than this will already
// produce underflow or overflow, so there's
// no need to worry about additional digits.
 
internal const int maxExponent = 511;
 
// Table giving binary powers of 10. Entry
// is 10^2^i. Used to convert decimal
// exponents into floating-point numbers.
 
internal static readonly double[] powersOf10 = new double[] { 10.0, 100.0, 1.0e4, 1.0e8, 1.0e16, 1.0e32, 1.0e64, 1.0e128, 1.0e256 };
 
// Default precision for converting floating-point values to strings.
 
internal const int DEFAULT_PRECISION = 12;
 
// The following variable determine the precision used when converting
// floating-point values to strings. This information is linked to all
// of the tcl_precision variables in all interpreters inside a JVM via
// PrecTraceProc.
//
// Note: since multiple threads may change precision concurrently, race
// conditions may occur.
//
// It should be modified only by the PrecTraceProc class.
 
internal static int precision;
private Util()
{
// Do nothing. This should never be called.
}
internal static StrtoulResult strtoul( string s, int start, int base_ )
// Base for conversion. Must be less than 37. If 0,
// then the base is chosen from the leading characters
// of string: "0x" means hex, "0" means octal,
// anything else means decimal.
{
long result = 0;
int digit;
bool anyDigits = false;
int len = s.Length;
int i = start;
char c;
 
// Skip any leading blanks.
 
while ( i < len && System.Char.IsWhiteSpace( s[i] ) )
{
i++;
}
if ( i >= len )
{
return new StrtoulResult( 0, 0, TCL.INVALID_INTEGER );
}
 
// If no base was provided, pick one from the leading characters
// of the string.
 
if ( base_ == 0 )
{
c = s[i];
if ( c == '0' )
{
if ( i < len - 1 )
{
i++;
c = s[i];
if ( c == 'x' || c == 'X' )
{
i += 1;
base_ = 16;
}
}
if ( base_ == 0 )
{
// Must set anyDigits here, otherwise "0" produces a
// "no digits" error.
 
anyDigits = true;
base_ = 8;
}
}
else
{
base_ = 10;
}
}
else if ( base_ == 16 )
{
if ( i < len - 2 )
{
// Skip a leading "0x" from hex numbers.
 
if ( ( s[i] == '0' ) && ( s[i + 1] == 'x' ) )
{
i += 2;
}
}
}
 
long max = ( Int64.MaxValue / ( (long)base_ ) );
bool overflowed = false;
 
for ( ; ; i += 1 )
{
if ( i >= len )
{
break;
}
digit = s[i] - '0';
if ( digit < 0 || digit > ( 'z' - '0' ) )
{
break;
}
digit = cvtIn[digit];
if ( digit >= base_ )
{
break;
}
 
if ( result > max )
{
overflowed = true;
}
 
result = result * base_ + digit;
anyDigits = true;
}
 
// See if there were any digits at all.
 
if ( !anyDigits )
{
return new StrtoulResult( 0, 0, TCL.INVALID_INTEGER );
}
else if ( overflowed )
{
return new StrtoulResult( 0, i, TCL.INTEGER_RANGE );
}
else
{
return new StrtoulResult( result, i, 0 );
}
}
internal static int getInt( Interp interp, string s )
{
int len = s.Length;
bool sign;
int i = 0;
 
// Skip any leading blanks.
 
while ( i < len && System.Char.IsWhiteSpace( s[i] ) )
{
i++;
}
if ( i >= len )
{
throw new TclException( interp, "expected integer but got \"" + s + "\"" );
}
 
char c = s[i];
if ( c == '-' )
{
sign = true;
i += 1;
}
else
{
if ( c == '+' )
{
i += 1;
}
sign = false;
}
 
StrtoulResult res = strtoul( s, i, 0 );
if ( res.errno < 0 )
{
if ( res.errno == TCL.INTEGER_RANGE )
{
if ( interp != null )
{
interp.setErrorCode( TclString.newInstance( intTooBigCode ) );
}
throw new TclException( interp, "integer value too large to represent" );
}
else
{
throw new TclException( interp, "expected integer but got \"" + s + "\"" + checkBadOctal( interp, s ) );
}
}
else if ( res.index < len )
{
for ( i = res.index; i < len; i++ )
{
if ( !System.Char.IsWhiteSpace( s[i] ) )
{
throw new TclException( interp, "expected integer but got \"" + s + "\"" + checkBadOctal( interp, s ) );
}
}
}
 
if ( sign )
{
return (int)( -res.value );
}
else
{
return (int)( res.value );
}
}
internal static long getLong( Interp interp, string s )
{
int len = s.Length;
bool sign;
int i = 0;
 
// Skip any leading blanks.
 
while ( i < len && System.Char.IsWhiteSpace( s[i] ) )
{
i++;
}
if ( i >= len )
{
throw new TclException( interp, "expected integer but got \"" + s + "\"" );
}
 
char c = s[i];
if ( c == '-' )
{
sign = true;
i += 1;
}
else
{
if ( c == '+' )
{
i += 1;
}
sign = false;
}
 
StrtoulResult res = strtoul( s, i, 0 );
if ( res.errno < 0 )
{
if ( res.errno == TCL.INTEGER_RANGE )
{
if ( interp != null )
{
interp.setErrorCode( TclString.newInstance( intTooBigCode ) );
}
throw new TclException( interp, "integer value too large to represent" );
}
else
{
throw new TclException( interp, "expected integer but got \"" + s + "\"" + checkBadOctal( interp, s ) );
}
}
else if ( res.index < len )
{
for ( i = res.index; i < len; i++ )
{
if ( !System.Char.IsWhiteSpace( s[i] ) )
{
throw new TclException( interp, "expected integer but got \"" + s + "\"" + checkBadOctal( interp, s ) );
}
}
}
 
if ( sign )
{
return (long)( -res.value );
}
else
{
return (long)( res.value );
}
}
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 ) ) );
}
}
internal static string checkBadOctal( Interp interp, string value )
{
int p = 0;
int len = value.Length;
 
// A frequent mistake is invalid octal values due to an unwanted
// leading zero. Try to generate a meaningful error message.
 
while ( p < len && System.Char.IsWhiteSpace( value[p] ) )
{
p++;
}
if ( ( p < len ) && ( value[p] == '+' || value[p] == '-' ) )
{
p++;
}
if ( ( p < len ) && ( value[p] == '0' ) )
{
while ( ( p < len ) && System.Char.IsDigit( value[p] ) )
{
// INTL: digit.
p++;
}
while ( ( p < len ) && System.Char.IsWhiteSpace( value[p] ) )
{
// INTL: ISO space.
p++;
}
if ( p >= len )
{
// Reached end of string
if ( interp != null )
{
return " (looks like invalid octal number)";
}
}
}
return "";
}
internal static StrtodResult strtod( string s, int start )
// The index to the char where the number starts.
{
//bool sign;
char c;
int mantSize; // Number of digits in mantissa.
int decPt; // Number of mantissa digits BEFORE decimal
// point.
int len = s.Length;
int i = start;
 
// Skip any leading blanks.
 
while ( i < len && System.Char.IsWhiteSpace( s[i] ) )
{
i++;
}
if ( i >= len )
{
return new StrtodResult( 0, 0, TCL.INVALID_DOUBLE );
}
 
c = s[i];
if ( c == '-' )
{
// sign = true;
i += 1;
}
else
{
if ( c == '+' )
{
i += 1;
}
// sign = false;
}
 
// Count the number of digits in the mantissa (including the decimal
// point), and also locate the decimal point.
 
bool maybeZero = true;
decPt = -1;
for ( mantSize = 0; ; mantSize += 1 )
{
c = CharAt( s, i, len );
if ( !System.Char.IsDigit( c ) )
{
if ( ( c != '.' ) || ( decPt >= 0 ) )
{
break;
}
decPt = mantSize;
}
if ( c != '0' && c != '.' )
{
maybeZero = false; // non zero digit found...
}
i++;
}
 
// Skim off the exponent.
 
if ( ( CharAt( s, i, len ) == 'E' ) || ( CharAt( s, i, len ) == 'e' ) )
{
i += 1;
if ( CharAt( s, i, len ) == '-' )
{
i += 1;
}
else if ( CharAt( s, i, len ) == '+' )
{
i += 1;
}
 
while ( System.Char.IsDigit( CharAt( s, i, len ) ) )
{
i += 1;
}
}
 
s = s.Substring( start, ( i ) - ( start ) );
double result = 0;
 
try
{
result = System.Double.Parse( s, System.Globalization.NumberFormatInfo.InvariantInfo );
}
catch ( System.OverflowException e )
{
return new StrtodResult( 0, 0, TCL.DOUBLE_RANGE );
}
catch ( System.FormatException e )
{
return new StrtodResult( 0, 0, TCL.INVALID_DOUBLE );
}
 
if ( ( result == System.Double.NegativeInfinity ) || ( result == System.Double.PositiveInfinity ) || ( result == 0.0 && !maybeZero ) )
{
return new StrtodResult( result, i, TCL.DOUBLE_RANGE );
}
 
if ( result == System.Double.NaN )
{
return new StrtodResult( 0, 0, TCL.INVALID_DOUBLE );
}
 
return new StrtodResult( result, i, 0 );
}
internal static char CharAt( string s, int index, int len )
{
if ( index >= 0 && index < len )
{
return s[index];
}
else
{
return '\x0000';
}
}
internal static double getDouble( Interp interp, string s )
{
int len = s.Length;
bool sign;
int i = 0;
 
// Skip any leading blanks.
 
while ( i < len && System.Char.IsWhiteSpace( s[i] ) )
{
i++;
}
if ( i >= len )
{
throw new TclException( interp, "expected floating-point number but got \"" + s + "\"" );
}
 
char c = s[i];
if ( c == '-' )
{
sign = true;
i += 1;
}
else
{
if ( c == '+' )
{
i += 1;
}
sign = false;
}
 
StrtodResult res = strtod( s, i );
if ( res.errno != 0 )
{
if ( res.errno == TCL.DOUBLE_RANGE )
{
if ( interp != null )
{
interp.setErrorCode( TclString.newInstance( fpTooBigCode ) );
}
throw new TclException( interp, "floating-point value too large to represent" );
}
else
{
throw new TclException( interp, "expected floating-point number but got \"" + s + "\"" );
}
}
else if ( res.index < len )
{
for ( i = res.index; i < len; i++ )
{
if ( !System.Char.IsWhiteSpace( s[i] ) )
{
throw new TclException( interp, "expected floating-point number but got \"" + s + "\"" );
}
}
}
 
if ( sign )
{
return (double)( -res.value );
}
else
{
return (double)( res.value );
}
}
internal static string concat( int from, int to, TclObject[] argv )
// The CmdArgs.
{
StringBuilder sbuf;
 
if ( from > argv.Length )
{
return "";
}
if ( to <= argv.Length )
{
to = argv.Length - 1;
}
 
sbuf = new StringBuilder();
for ( int i = from; i <= to; i++ )
{
 
string str = TrimLeft( argv[i].ToString() );
str = TrimRight( str );
if ( str.Length == 0 )
{
continue;
}
sbuf.Append( str );
if ( i < to )
{
sbuf.Append( " " );
}
}
 
return sbuf.ToString().TrimEnd();
}
public static bool stringMatch( string str, string pat )
//Pattern which may contain special characters.
{
char[] strArr = str.ToCharArray();
char[] patArr = pat.ToCharArray();
int strLen = str.Length; // Cache the len of str.
int patLen = pat.Length; // Cache the len of pat.
int pIndex = 0; // Current index into patArr.
int sIndex = 0; // Current index into patArr.
char strch; // Stores current char in string.
char ch1; // Stores char after '[' in pat.
char ch2; // Stores look ahead 2 char in pat.
bool incrIndex = false; // If true it will incr both p/sIndex.
 
while ( true )
{
 
if ( incrIndex == true )
{
pIndex++;
sIndex++;
incrIndex = false;
}
 
// See if we're at the end of both the pattern and the string.
// If so, we succeeded. If we're at the end of the pattern
// but not at the end of the string, we failed.
 
if ( pIndex == patLen )
{
return sIndex == strLen;
}
if ( ( sIndex == strLen ) && ( patArr[pIndex] != '*' ) )
{
return false;
}
 
// Check for a "*" as the next pattern character. It matches
// any substring. We handle this by calling ourselves
// recursively for each postfix of string, until either we
// match or we reach the end of the string.
 
if ( patArr[pIndex] == '*' )
{
pIndex++;
if ( pIndex == patLen )
{
return true;
}
while ( true )
{
if ( stringMatch( str.Substring( sIndex ), pat.Substring( pIndex ) ) )
{
return true;
}
if ( sIndex == strLen )
{
return false;
}
sIndex++;
}
}
 
// Check for a "?" as the next pattern character. It matches
// any single character.
 
if ( patArr[pIndex] == '?' )
{
incrIndex = true;
continue;
}
 
// Check for a "[" as the next pattern character. It is followed
// by a list of characters that are acceptable, or by a range
// (two characters separated by "-").
 
if ( patArr[pIndex] == '[' )
{
pIndex++;
while ( true )
{
if ( ( pIndex == patLen ) || ( patArr[pIndex] == ']' ) )
{
return false;
}
if ( sIndex == strLen )
{
return false;
}
ch1 = patArr[pIndex];
strch = strArr[sIndex];
if ( ( ( pIndex + 1 ) != patLen ) && ( patArr[pIndex + 1] == '-' ) )
{
if ( ( pIndex += 2 ) == patLen )
{
return false;
}
ch2 = patArr[pIndex];
if ( ( ( ch1 <= strch ) && ( ch2 >= strch ) ) || ( ( ch1 >= strch ) && ( ch2 <= strch ) ) )
{
break;
}
}
else if ( ch1 == strch )
{
break;
}
pIndex++;
}
 
for ( pIndex++; ( ( pIndex != patLen ) && ( patArr[pIndex] != ']' ) ); pIndex++ )
{
}
if ( pIndex == patLen )
{
pIndex--;
}
incrIndex = true;
continue;
}
 
// If the next pattern character is '\', just strip off the '\'
// so we do exact matching on the character that follows.
 
if ( patArr[pIndex] == '\\' )
{
pIndex++;
if ( pIndex == patLen )
{
return false;
}
}
 
// There's no special character. Just make sure that the next
// characters of each string match.
 
if ( ( sIndex == strLen ) || ( patArr[pIndex] != strArr[sIndex] ) )
{
return false;
}
incrIndex = true;
}
}
internal static string toTitle( string str )
// String to convert in place.
{
// Capitalize the first character and then lowercase the rest of the
// characters until we get to the end of string.
 
int length = str.Length;
if ( length == 0 )
{
return "";
}
StringBuilder buf = new StringBuilder( length );
buf.Append( System.Char.ToUpper( str[0] ) );
buf.Append( str.Substring( 1 ).ToLower() );
return buf.ToString();
}
internal static bool regExpMatch( Interp interp, string inString, TclObject pattern )
{
Regexp r = TclRegexp.compile( interp, pattern, false );
return r.match( inString, (string[])null );
}
internal static void appendElement( Interp interp, StringBuilder sbuf, string s )
{
if ( sbuf.Length > 0 )
{
sbuf.Append( ' ' );
}
 
int flags = scanElement( interp, s );
sbuf.Append( convertElement( s, flags ) );
}
internal static FindElemResult findElement( Interp interp, string s, int i, int len )
{
int openBraces = 0;
bool inQuotes = false;
 
for ( ; i < len && System.Char.IsWhiteSpace( s[i] ); i++ )
{
;
}
if ( i >= len )
{
return null;
}
char c = s[i];
if ( c == '{' )
{
openBraces = 1;
i++;
}
else if ( c == '"' )
{
inQuotes = true;
i++;
}
StringBuilder sbuf = new StringBuilder();
 
while ( true )
{
if ( i >= len )
{
if ( openBraces != 0 )
{
throw new TclException( interp, "unmatched open brace in list" );
}
else if ( inQuotes )
{
throw new TclException( interp, "unmatched open quote in list" );
}
return new FindElemResult( i, sbuf.ToString(), openBraces );
}
 
c = s[i];
switch ( c )
{
 
// Open brace: don't treat specially unless the element is
// in braces. In this case, keep a nesting count.
case '{':
if ( openBraces != 0 )
{
openBraces++;
}
sbuf.Append( c );
i++;
break;
 
// Close brace: if element is in braces, keep nesting
// count and quit when the last close brace is seen.
 
 
case '}':
if ( openBraces == 1 )
{
if ( i == len - 1 || System.Char.IsWhiteSpace( s[i + 1] ) )
{
return new FindElemResult( i + 1, sbuf.ToString(), openBraces );
}
else
{
int errEnd;
for ( errEnd = i + 1; errEnd < len; errEnd++ )
{
if ( System.Char.IsWhiteSpace( s[errEnd] ) )
{
break;
}
}
throw new TclException( interp, "list element in braces followed by \"" + s.Substring( i + 1, ( errEnd ) - ( i + 1 ) ) + "\" instead of space" );
}
}
else if ( openBraces != 0 )
{
openBraces--;
}
sbuf.Append( c );
i++;
break;
 
// Backslash: skip over everything up to the end of the
// backslash sequence.
 
 
case '\\':
BackSlashResult bs = Interp.backslash( s, i, len );
if ( openBraces > 0 )
{
// Quotes are ignored in brace-quoted stuff
 
sbuf.Append( s.Substring( i, ( bs.nextIndex ) - ( i ) ) );
}
else
{
sbuf.Append( bs.c );
}
i = bs.nextIndex;
 
break;
 
// Space: ignore if element is in braces or quotes; otherwise
// terminate element.
 
 
case ' ':
case '\f':
case '\n':
case '\r':
case '\t':
if ( ( openBraces == 0 ) && !inQuotes )
{
return new FindElemResult( i + 1, sbuf.ToString(), openBraces );
}
else
{
sbuf.Append( c );
i++;
}
break;
 
// Double-quote: if element is in quotes then terminate it.
 
 
case '"':
if ( inQuotes )
{
if ( i == len - 1 || System.Char.IsWhiteSpace( s[i + 1] ) )
{
return new FindElemResult( i + 1, sbuf.ToString(), openBraces );
}
else
{
int errEnd;
for ( errEnd = i + 1; errEnd < len; errEnd++ )
{
if ( System.Char.IsWhiteSpace( s[errEnd] ) )
{
break;
}
}
throw new TclException( interp, "list element in quotes followed by \"" + s.Substring( i + 1, ( errEnd ) - ( i + 1 ) ) + "\" instead of space" );
}
}
else
{
sbuf.Append( c );
i++;
}
break;
 
 
default:
sbuf.Append( c );
i++;
break;
 
}
}
}
internal static int scanElement( Interp interp, string inString )
{
int flags, nestingLevel;
char c;
int len;
int i;
 
// This procedure and Tcl_ConvertElement together do two things:
//
// 1. They produce a proper list, one that will yield back the
// argument strings when evaluated or when disassembled with
// Tcl_SplitList. This is the most important thing.
//
// 2. They try to produce legible output, which means minimizing the
// use of backslashes (using braces instead). However, there are
// some situations where backslashes must be used (e.g. an element
// like "{abc": the leading brace will have to be backslashed. For
// each element, one of three things must be done:
//
// (a) Use the element as-is (it doesn't contain anything special
// characters). This is the most desirable option.
//
// (b) Enclose the element in braces, but leave the contents alone.
// This happens if the element contains embedded space, or if it
// contains characters with special interpretation ($, [, ;, or \),
// or if it starts with a brace or double-quote, or if there are
// no characters in the element.
//
// (c) Don't enclose the element in braces, but add backslashes to
// prevent special interpretation of special characters. This is a
// last resort used when the argument would normally fall under case
// (b) but contains unmatched braces. It also occurs if the last
// character of the argument is a backslash or if the element contains
// a backslash followed by newline.
//
// The procedure figures out how many bytes will be needed to store
// the result (actually, it overestimates). It also collects
// information about the element in the form of a flags word.
 
nestingLevel = 0;
flags = 0;
 
i = 0;
len = ( inString != null ? inString.Length : 0 );
if ( len == 0 )
{
inString = '\x0000'.ToString();
 
// FIXME : pizza compiler workaround
// We really should be able to use the "\0" form but there
// is a nasty bug in the pizza compiler shipped with kaffe
// that causes "\0" to be read as the empty string.
 
//string = "\0";
}
 
System.Diagnostics.Debug.WriteLine( "scanElement string is \"" + inString + "\"" );
 
c = inString[i];
if ( ( c == '{' ) || ( c == '"' ) || ( c == '\x0000' ) )
{
flags |= USE_BRACES;
}
for ( ; i < len; i++ )
{
System.Diagnostics.Debug.WriteLine( "getting char at index " + i );
System.Diagnostics.Debug.WriteLine( "char is '" + inString[i] + "'" );
 
c = inString[i];
switch ( c )
{
 
case '{':
nestingLevel++;
break;
 
case '}':
nestingLevel--;
if ( nestingLevel < 0 )
{
flags |= TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
}
break;
 
case '[':
case '$':
case ';':
case ' ':
case '\f':
case '\n':
case '\r':
case '\t':
case (char)( 0x0b ):
 
flags |= USE_BRACES;
break;
 
case '\\':
if ( ( i >= len - 1 ) || ( inString[i + 1] == '\n' ) )
{
flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
}
else
{
BackSlashResult bs = Interp.backslash( inString, i, len );
 
// Subtract 1 because the for loop will automatically
// add one on the next iteration.
 
i = ( bs.nextIndex - 1 );
flags |= USE_BRACES;
}
break;
}
}
if ( nestingLevel != 0 )
{
flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
}
 
return flags;
}
internal static string convertElement( string s, int flags )
// Flags produced by ccanElement
{
int i = 0;
char c;
int len = ( s != null ? s.Length : 0 );
 
// See the comment block at the beginning of the ScanElement
// code for details of how this works.
 
if ( ( (System.Object)s == null ) || ( s.Length == 0 ) || ( s[0] == '\x0000' ) )
{
return "{}";
}
 
StringBuilder sbuf = new StringBuilder();
 
if ( ( ( flags & USE_BRACES ) != 0 ) && ( ( flags & TCL_DONT_USE_BRACES ) == 0 ) )
{
sbuf.Append( '{' );
for ( i = 0; i < len; i++ )
{
sbuf.Append( s[i] );
}
sbuf.Append( '}' );
}
else
{
c = s[0];
if ( c == '{' )
{
// Can't have a leading brace unless the whole element is
// enclosed in braces. Add a backslash before the brace.
// Furthermore, this may destroy the balance between open
// and close braces, so set BRACES_UNMATCHED.
 
sbuf.Append( '\\' );
sbuf.Append( '{' );
i++;
flags |= BRACES_UNMATCHED;
}
 
for ( ; i < len; i++ )
{
c = s[i];
switch ( c )
{
 
case ']':
case '[':
case '$':
case ';':
case ' ':
case '\\':
case '"':
sbuf.Append( '\\' );
break;
 
 
case '{':
case '}':
 
if ( ( flags & BRACES_UNMATCHED ) != 0 )
{
sbuf.Append( '\\' );
}
break;
 
 
case '\f':
sbuf.Append( '\\' );
sbuf.Append( 'f' );
continue;
 
 
case '\n':
sbuf.Append( '\\' );
sbuf.Append( 'n' );
continue;
 
 
case '\r':
sbuf.Append( '\\' );
sbuf.Append( 'r' );
continue;
 
 
case '\t':
sbuf.Append( '\\' );
sbuf.Append( 't' );
continue;
 
case (char)( 0x0b ):
 
sbuf.Append( '\\' );
sbuf.Append( 'v' );
continue;
}
 
sbuf.Append( c );
}
}
 
return sbuf.ToString();
}
internal static string TrimLeft( string str, string pattern )
{
int i, j;
char c;
int strLen = str.Length;
int patLen = pattern.Length;
bool done = false;
 
for ( i = 0; i < strLen; i++ )
{
c = str[i];
done = true;
for ( j = 0; j < patLen; j++ )
{
if ( c == pattern[j] )
{
done = false;
break;
}
}
if ( done )
{
break;
}
}
return str.Substring( i, ( strLen ) - ( i ) );
}
internal static string TrimLeft( string str )
{
return TrimLeft( str, " \n\t\r" );
}
internal static string TrimRight( string str, string pattern )
{
int last = str.Length - 1;
char[] strArray = str.ToCharArray();
int c;
 
// Remove trailing characters...
 
while ( last >= 0 )
{
c = strArray[last];
if ( pattern.IndexOf( (System.Char)c ) == -1 )
{
break;
}
last--;
}
return str.Substring( 0, ( last + 1 ) - ( 0 ) );
}
 
internal static string TrimRight( string str )
{
return TrimRight( str, " \n\t\r" );
}
internal static bool getBoolean( Interp interp, string inString )
{
string s = inString.ToLower();
 
// The length of 's' needs to be > 1 if it begins with 'o',
// in order to compare between "on" and "off".
 
if ( s.Length > 0 )
{
if ( "yes".StartsWith( s ) )
{
return true;
}
else if ( "no".StartsWith( s ) )
{
return false;
}
else if ( "true".StartsWith( s ) )
{
return true;
}
else if ( "false".StartsWith( s ) )
{
return false;
}
else if ( "on".StartsWith( s ) && s.Length > 1 )
{
return true;
}
else if ( "off".StartsWith( s ) && s.Length > 1 )
{
return false;
}
else if ( s.Equals( "0" ) )
{
return false;
}
else if ( s.Equals( "1" ) )
{
return true;
}
}
 
throw new TclException( interp, "expected boolean value but got \"" + inString + "\"" );
}
internal static void setupPrecisionTrace( Interp interp )
// Current interpreter.
{
try
{
interp.traceVar( "tcl_precision", new PrecTraceProc(), TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.TRACE_WRITES | TCL.VarFlag.TRACE_READS | TCL.VarFlag.TRACE_UNSETS );
}
catch ( TclException e )
{
throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
}
}
internal static string printDouble( double number )
// The number to format into a string.
{
string s = FormatCmd.toString( number, precision, 10 ).Replace( "E", "e" );
int length = s.Length;
for ( int i = 0; i < length; i++ )
{
if ( ( s[i] == '.' ) || System.Char.IsLetter( s[i] ) )
{
return s;
}
}
return string.Concat( s, ".0" );
}
internal static string tryGetSystemProperty( string propName, string defautlValue )
// Default value.
{
try
{
 
// ATK return System_Renamed.getProperty(propName);
return System.Environment.GetEnvironmentVariable( "os.name" );
}
catch ( System.Security.SecurityException e )
{
return defautlValue;
}
}
static Util()
{
precision = DEFAULT_PRECISION;
}
} // end Util
 
/*
*----------------------------------------------------------------------
*
* PrecTraceProc.java --
*
* The PrecTraceProc class is used to implement variable traces for
* the tcl_precision variable to control precision used when
* converting floating-point values to strings.
*
*----------------------------------------------------------------------
*/
 
sealed class PrecTraceProc : VarTrace
{
 
// Maximal precision supported by Tcl.
 
internal const int TCL_MAX_PREC = 17;
 
public void traceProc( Interp interp, string name1, string name2, TCL.VarFlag flags )
{
// If the variable is unset, then recreate the trace and restore
// the default value of the format string.
 
if ( ( flags & TCL.VarFlag.TRACE_UNSETS ) != 0 )
{
if ( ( ( flags & TCL.VarFlag.TRACE_DESTROYED ) != 0 ) && ( ( flags & TCL.VarFlag.INTERP_DESTROYED ) == 0 ) )
{
interp.traceVar( name1, name2, new PrecTraceProc(), TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.TRACE_WRITES | TCL.VarFlag.TRACE_READS | TCL.VarFlag.TRACE_UNSETS );
Util.precision = Util.DEFAULT_PRECISION;
}
return;
}
 
// When the variable is read, reset its value from our shared
// value. This is needed in case the variable was modified in
// some other interpreter so that this interpreter's value is
// out of date.
 
if ( ( flags & TCL.VarFlag.TRACE_READS ) != 0 )
{
interp.setVar( name1, name2, TclInteger.newInstance( Util.precision ), flags & TCL.VarFlag.GLOBAL_ONLY );
return;
}
 
// The variable is being written. Check the new value and disallow
// it if it isn't reasonable.
//
// (ToDo) Disallow it if this is a safe interpreter (we don't want
// safe interpreters messing up the precision of other
// interpreters).
 
TclObject tobj = null;
try
{
tobj = interp.getVar( name1, name2, ( flags & TCL.VarFlag.GLOBAL_ONLY ) );
}
catch ( TclException e )
{
// Do nothing when fixme does not exist.
}
 
string value;
 
if ( tobj != null )
{
 
value = tobj.ToString();
}
else
{
value = "";
}
 
StrtoulResult r = Util.strtoul( value, 0, 10 );
 
if ( ( r == null ) || ( r.value <= 0 ) || ( r.value > TCL_MAX_PREC ) || ( r.value > 100 ) || ( r.index == 0 ) || ( r.index != value.Length ) )
{
interp.setVar( name1, name2, TclInteger.newInstance( Util.precision ), TCL.VarFlag.GLOBAL_ONLY );
throw new TclException( interp, "improper value for precision" );
}
 
Util.precision = (int)r.value;
}
} // end PrecTraceProc
}
/trunk/TCL/src/base/Var.cs
@@ -0,0 +1,2493 @@
/*
* Var.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: Var.java,v 1.11 2003/01/09 02:15:39 mdejong Exp $
*
*/
using System;
using System.Collections;
using System.Text;
 
namespace tcl.lang
{
 
/// <summary> Flag bits for variables. The first three (SCALAR, ARRAY, and
/// LINK) are mutually exclusive and give the "type" of the variable.
/// UNDEFINED is independent of the variable's type.
///
/// SCALAR - 1 means this is a scalar variable and not
/// an array or link. The value field points
/// to the variable's value, a Tcl object.
/// ARRAY - 1 means this is an array variable rather
/// than a scalar variable or link. The
/// table field points to the array's
/// hashtable for its elements.
/// LINK - 1 means this Var structure contains a
/// reference to another Var structure that
/// either has the real value or is itself
/// another LINK pointer. Variables like
/// this come about through "upvar" and "global"
/// commands, or through references to variables
/// in enclosing namespaces.
/// UNDEFINED - 1 means that the variable is in the process
/// of being deleted. An undefined variable
/// logically does not exist and survives only
/// while it has a trace, or if it is a global
/// variable currently being used by some
/// procedure.
/// IN_HASHTABLE - 1 means this variable is in a hashtable. 0 if
/// a local variable that was assigned a slot
/// in a procedure frame by the compiler so the
/// Var storage is part of the call frame.
/// TRACE_ACTIVE - 1 means that trace processing is currently
/// underway for a read or write access, so
/// new read or write accesses should not cause
/// trace procedures to be called and the
/// variable can't be deleted.
/// ARRAY_ELEMENT - 1 means that this variable is an array
/// element, so it is not legal for it to be
/// an array itself (the ARRAY flag had
/// better not be set).
/// NAMESPACE_VAR - 1 means that this variable was declared
/// as a namespace variable. This flag ensures
/// it persists until its namespace is
/// destroyed or until the variable is unset;
/// it will persist even if it has not been
/// initialized and is marked undefined.
/// The variable's refCount is incremented to
/// reflect the "reference" from its namespace.
///
/// </summary>
 
[Flags()]
public enum VarFlags
{
SCALAR = 0x1,
ARRAY = 0x2,
LINK = 0x4,
UNDEFINED = 0x8,
IN_HASHTABLE = 0x10,
TRACE_ACTIVE = 0x20,
ARRAY_ELEMENT = 0x40,
NAMESPACE_VAR = 0x80,
SQLITE3_LINK_INT = 0x100,
SQLITE3_LINK_DOUBLE = 0x200,
SQLITE3_LINK_BOOLEAN = 0x400,
SQLITE3_LINK_STRING = 0x800,
SQLITE3_LINK_WIDE_INT = 0x1000,
SQLITE3_LINK = 0x10000,
SQLITE3_LINK_READ_ONLY = 0x20000,
};
 
 
/*
* Implements variables in Tcl. The Var class encapsulates most of the functionality
* of the methods in generic/tclVar.c and the structure TCL.Tcl_Var from the C version.
*/
 
public class Var
{
/// <summary> Used by ArrayCmd to create a unique searchId string. If the
/// sidVec Vector is empty then simply return 1. Else return 1
/// plus the SearchId.index value of the last Object in the vector.
///
/// </summary>
/// <param name="">None
/// </param>
/// <returns> The int value for unique SearchId string.
/// </returns>
protected internal int NextIndex
{
get
{
lock ( this )
{
if ( sidVec.Count == 0 )
{
return 1;
}
SearchId sid = (SearchId)SupportClass.VectorLastElement( sidVec );
return ( sid.Index + 1 );
}
}
 
}
 
// internal const int SCALAR = 0x1;
// internal const int ARRAY = 0x2;
// internal const int LINK = 0x4;
// internal const int UNDEFINED = 0x8;
// internal const int IN_HASHTABLE = 0x10;
// internal const int TRACE_ACTIVE = 0x20;
// internal const int ARRAY_ELEMENT = 0x40;
// internal const int NAMESPACE_VAR = 0x80;
 
// Methods to read various flag bits of variables.
 
internal bool isVarScalar()
{
return ( ( flags & VarFlags.SCALAR ) != 0 );
}
 
internal bool isVarLink()
{
return ( ( flags & VarFlags.LINK ) != 0 );
}
 
internal bool isVarArray()
{
return ( ( flags & VarFlags.ARRAY ) != 0 );
}
 
internal bool isVarUndefined()
{
return ( ( flags & VarFlags.UNDEFINED ) != 0 );
}
 
internal bool isVarArrayElement()
{
return ( ( flags & VarFlags.ARRAY_ELEMENT ) != 0 );
}
 
// Methods to ensure that various flag bits are set properly for variables.
 
internal void setVarScalar()
{
flags = ( flags & ~( VarFlags.ARRAY | VarFlags.LINK ) ) | VarFlags.SCALAR;
}
 
internal void setVarArray()
{
flags = ( flags & ~( VarFlags.SCALAR | VarFlags.LINK ) ) | VarFlags.ARRAY;
}
 
internal void setVarLink()
{
flags = ( flags & ~( VarFlags.SCALAR | VarFlags.ARRAY ) ) | VarFlags.LINK;
}
 
internal void setVarArrayElement()
{
flags = ( flags & ~VarFlags.ARRAY ) | VarFlags.ARRAY_ELEMENT;
}
 
internal void setVarUndefined()
{
flags |= VarFlags.UNDEFINED;
}
 
internal void clearVarUndefined()
{
flags &= ~VarFlags.UNDEFINED;
}
 
/// <summary> Stores the "value" of the variable. It stored different information
/// depending on the type of the variable: <ul>
/// <li>Scalar variable - (TclObject) value is the object stored in the
/// variable.
/// <li> Array variable - (Hashtable) value is the hashtable that stores
/// all the elements. <p>
/// <li> Upvar (Link) - (Var) value is the variable associated by this upvar.
/// </ul>
/// </summary>
 
internal Object value;
 
/// <summary> Vector that holds the traces that were placed in this Var</summary>
 
internal ArrayList traces;
 
 
internal ArrayList sidVec;
 
/// <summary> Miscellaneous bits of information about variable.
///
/// </summary>
/// <seealso cref="Var#SCALAR">
/// </seealso>
/// <seealso cref="Var#ARRAY">
/// </seealso>
/// <seealso cref="Var#LINK">
/// </seealso>
/// <seealso cref="Var#UNDEFINED">
/// </seealso>
/// <seealso cref="Var#IN_HASHTABLE">
/// </seealso>
/// <seealso cref="Var#TRACE_ACTIVE">
/// </seealso>
/// <seealso cref="Var#ARRAY_ELEMENT">
/// </seealso>
/// <seealso cref="Var#NAMESPACE_VAR">
/// </seealso>
 
internal VarFlags flags;
 
/// <summary> If variable is in a hashtable, either the
/// hash table entry that refers to this
/// variable or null if the variable has been
/// detached from its hash table (e.g. an
/// array is deleted, but some of its
/// elements are still referred to in
/// upvars). null if the variable is not in a
/// hashtable. This is used to delete an
/// variable from its hashtable if it is no
/// longer needed.
/// </summary>
 
internal Hashtable table;
 
/// <summary> The key under which this variable is stored in the hash table.</summary>
 
internal string hashKey;
 
/// <summary> Counts number of active uses of this
/// variable, not including its entry in the
/// call frame or the hash table: 1 for each
/// additional variable whose link points
/// here, 1 for each nested trace active on
/// variable, and 1 if the variable is a
/// namespace variable. This record can't be
/// deleted until refCount becomes 0.
/// </summary>
 
internal int refCount;
 
/// <summary> Reference to the namespace that contains
/// this variable or null if the variable is
/// a local variable in a Tcl procedure.
/// </summary>
 
internal NamespaceCmd.Namespace ns;
 
public class SQLITE3_GETSET
{
string name = "";
int _Integer = 0; // Internal integer value
StringBuilder _StringBuilder = null; // Internal string value
public SQLITE3_GETSET( string name )
{
this._Integer = 0;
this._StringBuilder = new StringBuilder( 500 );
this.name = name;
}
public int iValue
{
get
{
return _Integer;
}
set
{
_Integer = value;
}
}
public string sValue
{
get
{
return _StringBuilder.ToString();
}
set
{
_StringBuilder.Length = 0;
_StringBuilder.Append( value );
}
}
public void Append( byte[] append )
{
_StringBuilder.Append( Encoding.UTF8.GetString( append, 0, append.Length ) );
}
 
public void Append( string append )
{
_StringBuilder.Append( append );
}
public void Trim()
{
_StringBuilder = new StringBuilder( _StringBuilder.ToString().Trim() );
}
 
public int Length
{
get
{
return _StringBuilder.Length;
}
}
}
/// <summary> Reference to the object the allows getting & setting the sqlite3 linked variable
/// </summary>
internal object sqlite3_get_set;
internal TclObject sqlite3_get()
{
TclObject to;
if ( ( flags & VarFlags.SQLITE3_LINK_READ_ONLY ) != 0 && ( flags & VarFlags.SQLITE3_LINK_INT ) != 0 )
if ( sqlite3_get_set.GetType().Name == "Int32" )
to = TclInteger.newInstance( (Int32)sqlite3_get_set );
else
to = TclInteger.newInstance( ( (SQLITE3_GETSET)sqlite3_get_set ).iValue );
else if ( ( flags & VarFlags.SQLITE3_LINK_INT ) != 0 )
{
if ( sqlite3_get_set.GetType().Name == "Int32" )
to = TclInteger.newInstance( (Int32)sqlite3_get_set );
else
to = TclInteger.newInstance( ( (SQLITE3_GETSET)sqlite3_get_set ).iValue );
}
else
to = TclString.newInstance( ( (SQLITE3_GETSET)sqlite3_get_set ).sValue );
to.preserve();
return to;
}
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();
}
}
 
internal bool isSQLITE3_Link()
{
return ( ( flags & VarFlags.SQLITE3_LINK ) != 0 );
}
 
 
/// <summary> NewVar -> Var
///
/// Construct a variable and initialize its fields.
/// </summary>
 
internal Var()
{
value = null;
//name = null; // Like hashKey in Jacl
ns = null;
hashKey = null; // Like hPtr in the C implementation
table = null; // Like hPtr in the C implementation
refCount = 0;
traces = null;
//search = null;
sidVec = null; // Like search in the C implementation
flags = ( VarFlags.SCALAR | VarFlags.UNDEFINED | VarFlags.IN_HASHTABLE );
}
 
/// <summary> Used to create a String that describes this variable
///
/// </summary>
 
public override string ToString()
{
StringBuilder sb = new StringBuilder();
sb.Append( ns );
if ( sb.Length == 2 )
{
// It is in the global namespace
sb.Append( hashKey );
}
else
{
// It is not in the global namespaces
sb.Append( "::" );
sb.Append( hashKey );
}
return sb.ToString();
}
 
/// <summary> Find the SearchId that in the sidVec Vector that is equal the
/// unique String s and returns the enumeration associated with
/// that SearchId.
///
/// </summary>
/// <param name="s">String that ia a unique identifier for a SearchId object
/// </param>
/// <returns> Enumeration if a match is found else null.
/// </returns>
 
protected internal SearchId getSearch( string s )
{
SearchId sid;
for ( int i = 0; i < sidVec.Count; i++ )
{
sid = (SearchId)sidVec[i];
if ( sid.equals( s ) )
{
return sid;
}
}
return null;
}
 
 
/// <summary> Find the SearchId object in the sidVec Vector and remove it.
///
/// </summary>
/// <param name="sid">String that ia a unique identifier for a SearchId object.
/// </param>
 
protected internal bool removeSearch( string sid )
{
SearchId curSid;
 
for ( int i = 0; i < sidVec.Count; i++ )
{
curSid = (SearchId)sidVec[i];
if ( curSid.equals( sid ) )
{
sidVec.RemoveAt( i );
return true;
}
}
return false;
}
 
 
 
 
 
// End of the instance method for the Var class, the rest of the methods
// are Var related methods ported from the code in generic/tclVar.c
 
 
 
// The strings below are used to indicate what went wrong when a
// variable access is denied.
 
internal const string noSuchVar = "no such variable";
internal const string isArray = "variable is array";
internal const string needArray = "variable isn't array";
internal const string noSuchElement = "no such element in array";
internal const string danglingElement = "upvar refers to element in deleted array";
internal const string danglingVar = "upvar refers to variable in deleted namespace";
internal const string badNamespace = "parent namespace doesn't exist";
internal const string missingName = "missing variable name";
 
 
 
/// <summary> TclLookupVar -> lookupVar
///
/// This procedure is used by virtually all of the variable
/// code to locate a variable given its name(s).
///
/// </summary>
/// <param name="part1">if part2 isn't NULL, this is the name of an array.
/// Otherwise, this is a full variable name that could include
/// a parenthesized array elemnt or a scalar.
/// </param>
/// <param name="part2">Name of an element within array, or null.
/// </param>
/// <param name="flags">Only the TCL.VarFlag.GLOBAL_ONLY bit matters.
/// </param>
/// <param name="msg">Verb to use in error messages, e.g. "read" or "set".
/// </param>
/// <param name="create">OR'ed combination of CRT_PART1 and CRT_PART2.
/// Tells which entries to create if they don't already exist.
/// </param>
/// <param name="throwException">true if an exception should be throw if the
/// variable cannot be found.
/// </param>
/// <returns> a two element array. a[0] is the variable indicated by
/// part1 and part2, or null if the variable couldn't be
/// found and throwException is false.
/// <p>
/// If the variable is found, a[1] is the array that
/// contains the variable (or null if the variable is a scalar).
/// If the variable can't be found and either createPart1 or
/// createPart2 are true, a new as-yet-undefined (VAR_UNDEFINED)
/// variable instance is created, entered into a hash
/// table, and returned.
/// Note: it's possible that var.value of the returned variable
/// may be null (variable undefined), even if createPart1 or createPart2
/// are true (these only cause the hash table entry or array to be created).
/// For example, the variable might be a global that has been unset but
/// is still referenced by a procedure, or a variable that has been unset
/// but it only being kept in existence by a trace.
/// </returns>
/// <exception cref=""> TclException if the variable cannot be found and
/// throwException is true.
///
/// </exception>
 
internal static Var[] lookupVar( Interp interp, string part1, string part2, TCL.VarFlag flags, string msg, bool createPart1, bool createPart2 )
{
CallFrame varFrame = interp.varFrame;
// Reference to the procedure call frame whose
// variables are currently in use. Same as
// the current procedure's frame, if any,
// unless an "uplevel" is executing.
Hashtable table; // to the hashtable, if any, in which
// to look up the variable.
Var var; // Used to search for global names.
string elName; // Name of array element or null.
int openParen;
// If this procedure parses a name into
// array and index, these point to the
// parens around the index. Otherwise they
// are -1. These are needed to restore
// the parens after parsing the name.
NamespaceCmd.Namespace varNs, cxtNs;
int p;
int i, result;
 
var = null;
openParen = -1;
varNs = null; // set non-null if a nonlocal variable
 
// Parse part1 into array name and index.
// Always check if part1 is an array element name and allow it only if
// part2 is not given.
// (if one does not care about creating array elements that can't be used
// from tcl, and prefer slightly better performance, one can put
// the following in an if (part2 == null) { ... } block and remove
// the part2's test and error reporting or move that code in array set)
elName = part2;
int len = part1.Length;
for ( p = 0; p < len; p++ )
{
if ( part1[p] == '(' )
{
openParen = p;
p = len - 1;
if ( part1[p] == ')' )
{
if ( (System.Object)part2 != null )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, msg, needArray );
}
return null;
}
elName = part1.Substring( openParen + 1, ( len - 1 ) - ( openParen + 1 ) );
part2 = elName; // same as elName, only used in error reporting
part1 = part1.Substring( 0, ( openParen ) - ( 0 ) );
}
break;
}
}
 
 
 
// If this namespace has a variable resolver, then give it first
// crack at the variable resolution. It may return a Var
// value, it may signal to continue onward, or it may signal
// an error.
 
if ( ( ( flags & TCL.VarFlag.GLOBAL_ONLY ) != 0 ) || ( interp.varFrame == null ) )
{
cxtNs = interp.globalNs;
}
else
{
cxtNs = interp.varFrame.ns;
}
 
if ( cxtNs.resolver != null || interp.resolvers != null )
{
try
{
if ( cxtNs.resolver != null )
{
var = cxtNs.resolver.resolveVar( interp, part1, cxtNs, flags );
}
else
{
var = null;
}
 
if ( var == null && interp.resolvers != null )
{
IEnumerator enum_Renamed = interp.resolvers.GetEnumerator();
foreach ( Interp.ResolverScheme res in interp.resolvers )
{
var = res.resolver.resolveVar( interp, part1, cxtNs, flags );
if ( var != null )
break;
}
}
}
catch ( TclException e )
{
var = null;
}
}
 
// Look up part1. Look it up as either a namespace variable or as a
// local variable in a procedure call frame (varFrame).
// Interpret part1 as a namespace variable if:
// 1) so requested by a TCL.VarFlag.GLOBAL_ONLY or TCL.VarFlag.NAMESPACE_ONLY flag,
// 2) there is no active frame (we're at the global :: scope),
// 3) the active frame was pushed to define the namespace context
// for a "namespace eval" or "namespace inscope" command,
// 4) the name has namespace qualifiers ("::"s).
// Otherwise, if part1 is a local variable, search first in the
// frame's array of compiler-allocated local variables, then in its
// hashtable for runtime-created local variables.
//
// If createPart1 and the variable isn't found, create the variable and,
// if necessary, create varFrame's local var hashtable.
 
if ( ( ( flags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ) ) != 0 ) || ( varFrame == null ) || !varFrame.isProcCallFrame || ( part1.IndexOf( "::" ) != -1 ) )
{
string tail;
 
// Don't pass TCL.VarFlag.LEAVE_ERR_MSG, we may yet create the variable,
// or otherwise generate our own error!
 
var = NamespaceCmd.findNamespaceVar( interp, part1, null, flags & ~TCL.VarFlag.LEAVE_ERR_MSG );
if ( var == null )
{
if ( createPart1 )
{
// var wasn't found so create it
 
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
NamespaceCmd.Namespace[] varNsArr = new NamespaceCmd.Namespace[1];
NamespaceCmd.Namespace[] dummyArr = new NamespaceCmd.Namespace[1];
string[] tailArr = new string[1];
 
NamespaceCmd.getNamespaceForQualName( interp, part1, null, flags, varNsArr, dummyArr, dummyArr, tailArr );
 
// Get the values out of the arrays!
varNs = varNsArr[0];
tail = tailArr[0];
 
if ( varNs == null )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, msg, badNamespace );
}
return null;
}
if ( (System.Object)tail == null )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, msg, missingName );
}
return null;
}
var = new Var();
varNs.varTable.Add( tail, var );
 
// There is no hPtr member in Jacl, The hPtr combines the table
// and the key used in a table lookup.
var.hashKey = tail;
var.table = varNs.varTable;
 
var.ns = varNs;
}
else
{
// var wasn't found and not to create it
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, msg, noSuchVar );
}
return null;
}
}
}
else
{
// local var: look in frame varFrame
// removed code block that searches for local compiled vars
 
if ( var == null )
{
// look in the frame's var hash table
table = varFrame.varTable;
if ( createPart1 )
{
if ( table == null )
{
table = new Hashtable();
varFrame.varTable = table;
}
var = (Var)table[part1];
if ( var == null )
{
// we are adding a new entry
var = new Var();
SupportClass.PutElement( table, part1, var );
 
// There is no hPtr member in Jacl, The hPtr combines
// the table and the key used in a table lookup.
var.hashKey = part1;
var.table = table;
 
var.ns = null; // a local variable
}
}
else
{
if ( table != null )
{
var = (Var)table[part1];
}
if ( var == null )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, msg, noSuchVar );
}
return null;
}
}
}
}
 
// If var is a link variable, we have a reference to some variable
// that was created through an "upvar" or "global" command. Traverse
// through any links until we find the referenced variable.
 
while ( var.isVarLink() )
{
var = (Var)var.value;
}
 
// If we're not dealing with an array element, return var.
 
if ( (System.Object)elName == null )
{
var ret = new Var[2];
ret[0] = var;
ret[1] = null;
return ret;
}
 
// We're dealing with an array element. Make sure the variable is an
// array and look up the element (create the element if desired).
 
if ( var.isVarUndefined() && !var.isVarArrayElement() )
{
if ( !createPart1 )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, msg, noSuchVar );
}
return null;
}
 
// Make sure we are not resurrecting a namespace variable from a
// deleted namespace!
 
if ( ( ( var.flags & VarFlags.IN_HASHTABLE ) != 0 ) && ( var.table == null ) )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, msg, danglingVar );
}
return null;
}
 
var.setVarArray();
var.clearVarUndefined();
var.value = new Hashtable();
}
else if ( !var.isVarArray() )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, msg, needArray );
}
return null;
}
 
Var arrayVar = var;
Hashtable arrayTable = (Hashtable)var.value;
if ( createPart2 )
{
Var searchvar = (Var)arrayTable[elName];
 
if ( searchvar == null )
{
// new entry
if ( var.sidVec != null )
{
deleteSearches( var );
}
 
var = new Var();
SupportClass.PutElement( arrayTable, elName, var );
 
// There is no hPtr member in Jacl, The hPtr combines the table
// and the key used in a table lookup.
var.hashKey = elName;
var.table = arrayTable;
 
var.ns = varNs;
var.setVarArrayElement();
}
else
{
var = searchvar;
}
}
else
{
var = (Var)arrayTable[elName];
if ( var == null )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, msg, noSuchElement );
}
return null;
}
}
 
var ret2 = new Var[2];
ret2[0] = var; // The Var in the array
ret2[1] = arrayVar; // The array (Hashtable) Var
return ret2;
}
 
 
/// <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> Query the value of a variable.
///
/// </summary>
/// <param name="interp">the interp that holds the variable
/// </param>
/// <param name="name">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, string name, TCL.VarFlag flags )
{
return getVar( interp, name, 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 );
}
 
/// <summary> TCL.Tcl_GetVar2Ex -> getVar
///
/// Query the value of a variable, given a two-part name consisting
/// of array name and element within array.
///
/// </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, string part1, string part2, TCL.VarFlag flags )
{
Var[] result = lookupVar( interp, part1, part2, flags, "read", false, true );
 
if ( result == null )
{
// lookupVar() returns null only if TCL.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];
 
try
{
// Invoke any traces that have been set for the variable.
 
if ( ( var.traces != null ) || ( ( array != null ) && ( array.traces != null ) ) )
{
string msg = callTraces( interp, array, var, part1, part2, ( flags & ( TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.GLOBAL_ONLY ) ) | TCL.VarFlag.TRACE_READS );
if ( (System.Object)msg != null )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, "read", msg );
}
return null;
}
}
 
if ( var.isVarScalar() && !var.isVarUndefined() )
{
return (TclObject)var.value;
}
 
if ( var.isSQLITE3_Link() )
return var.sqlite3_get();
 
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
string msg;
if ( var.isVarUndefined() && ( array != null ) && !array.isVarUndefined() )
{
msg = noSuchElement;
}
else if ( var.isVarArray() )
{
msg = isArray;
}
else
{
msg = noSuchVar;
}
throw new TclVarException( interp, part1, part2, "read", msg );
}
}
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 );
}
}
 
return null;
}
 
/// <summary> Set 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="value">the new value for the variable
/// </param>
/// <param name="flags">misc flags that control the actions of this method.
/// </param>
 
internal static TclObject setVar( Interp interp, TclObject nameObj, TclObject value, TCL.VarFlag flags )
{
 
return setVar( interp, nameObj.ToString(), null, value, flags );
}
 
/// <summary> Set a variable.
///
/// </summary>
/// <param name="interp">the interp that holds the variable
/// </param>
/// <param name="name">name of the variable.
/// </param>
/// <param name="value">the new value for the variable
/// </param>
/// <param name="flags">misc flags that control the actions of this method
/// </param>
 
internal static TclObject setVar( Interp interp, string name, TclObject value, TCL.VarFlag flags )
{
return setVar( interp, name, null, value, flags );
}
 
/// <summary> Tcl_ObjSetVar2 -> setVar
///
/// Set 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="newValue">the new value for the variable
/// </param>
/// <param name="flags">misc flags that control the actions of this method
/// </param>
 
internal static TclObject setVar( Interp interp, TclObject part1Obj, TclObject part2Obj, TclObject newValue, TCL.VarFlag flags )
{
string part1, part2;
 
 
part1 = part1Obj.ToString();
 
if ( part2Obj != null )
{
 
part2 = part2Obj.ToString();
}
else
{
part2 = null;
}
 
return setVar( interp, part1, part2, newValue, 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> TclIncrVar2 -> incrVar
///
/// Given a two-part variable name, which may refer either to a scalar
/// variable or an element of an array, increment the Tcl object value
/// of the variable by a specified amount.
///
/// </summary>
/// <param name="part1">1st part of the variable name.
/// </param>
/// <param name="part2">2nd part of the variable name.
/// </param>
/// <param name="incrAmount">Amount to be added to variable.
/// </param>
/// <param name="flags">misc flags that control the actions of this method
///
/// Results:
/// Returns a reference to the TclObject holding the new value of the
/// variable. If the specified variable doesn't exist, or there is a
/// clash in array usage, or an error occurs while executing variable
/// traces, then a TclException will be raised.
///
/// Side effects:
/// The value of the given variable is incremented by the specified
/// amount. If either the array or the entry didn't exist then a new
/// variable is created. The ref count for the returned object is _not_
/// incremented to reflect the returned reference; if you want to keep a
/// reference to the object you must increment its ref count yourself.
///
/// ----------------------------------------------------------------------
/// </param>
 
internal static TclObject incrVar( Interp interp, TclObject part1, TclObject part2, int incrAmount, TCL.VarFlag flags )
{
TclObject varValue = null;
bool createdNewObj; // Set to true if var's value object is shared
// so we must increment a copy (i.e. copy
// on write).
int i;
bool err;
 
// There are two possible error conditions that depend on the setting of
// TCL.VarFlag.LEAVE_ERR_MSG. an exception could be raised or null could be returned
err = false;
try
{
varValue = getVar( interp, part1, part2, flags );
}
catch ( TclException e )
{
err = true;
throw;
}
finally
{
// FIXME : is this the correct way to catch the error?
if ( err || varValue == null )
interp.addErrorInfo( "\n (reading value of variable to increment)" );
}
 
 
// Increment the variable's value. If the object is unshared we can
// modify it directly, otherwise we must create a new copy to modify:
// this is "copy on write". Then free the variable's old string
// representation, if any, since it will no longer be valid.
 
createdNewObj = false;
if ( varValue.Shared )
{
varValue = varValue.duplicate();
createdNewObj = true;
}
 
try
{
i = TclInteger.get( interp, varValue );
}
catch ( TclException e )
{
if ( createdNewObj )
{
varValue.release(); // free unneeded copy
}
throw;
}
 
TclInteger.set( varValue, ( i + incrAmount ) );
 
// Store the variable's new value and run any write traces.
 
return setVar( interp, part1, part2, varValue, flags );
}
 
/// <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> Unset a variable.
///
/// </summary>
/// <param name="name">name of the variable.
/// </param>
/// <param name="flags">misc flags that control the actions of this method.
/// </param>
 
internal static void unsetVar( Interp interp, string name, TCL.VarFlag flags )
{
unsetVar( interp, name, null, flags );
}
 
/// <summary> TCL.Tcl_UnsetVar2 -> unsetVar
///
/// Unset a variable, given a two-part name consisting of array
/// name and element within array.
///
/// </summary>
/// <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.
///
/// If part1 and part2 indicate a local or global variable in interp,
/// it is deleted. If part1 is an array name and part2 is null, then
/// the whole array is deleted.
///
/// </param>
 
internal static void unsetVar( Interp interp, string part1, string part2, TCL.VarFlag flags )
{
Var dummyVar;
Var var;
Var array;
//ActiveVarTrace active;
TclObject obj;
TCL.CompletionCode result;
 
// FIXME : what about the null return vs exception thing here?
Var[] lookup_result = lookupVar( interp, part1, part2, flags, "unset", false, false );
if ( lookup_result == null )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
throw new TclRuntimeError( "unexpected null reference" );
else
return;
}
 
var = lookup_result[0];
array = lookup_result[1];
 
result = ( var.isVarUndefined() ? TCL.CompletionCode.ERROR : TCL.CompletionCode.OK );
 
if ( ( array != null ) && ( array.sidVec != null ) )
{
deleteSearches( array );
}
 
 
// The code below is tricky, because of the possibility that
// a trace procedure might try to access a variable being
// deleted. To handle this situation gracefully, do things
// in three steps:
// 1. Copy the contents of the variable to a dummy variable
// structure, and mark the original Var structure as undefined.
// 2. Invoke traces and clean up the variable, using the dummy copy.
// 3. If at the end of this the original variable is still
// undefined and has no outstanding references, then delete
// it (but it could have gotten recreated by a trace).
 
dummyVar = new Var();
//FIXME: Var class really should implement clone to make a bit copy.
dummyVar.value = var.value;
dummyVar.traces = var.traces;
dummyVar.flags = var.flags;
dummyVar.hashKey = var.hashKey;
dummyVar.table = var.table;
dummyVar.refCount = var.refCount;
dummyVar.ns = var.ns;
 
var.setVarUndefined();
var.setVarScalar();
var.value = null; // dummyVar points to any value object
var.traces = null;
var.sidVec = null;
 
// Call trace procedures for the variable being deleted. Then delete
// its traces. Be sure to abort any other traces for the variable
// that are still pending. Special tricks:
// 1. We need to increment var's refCount around this: CallTraces
// will use dummyVar so it won't increment var's refCount itself.
// 2. Turn off the TRACE_ACTIVE flag in dummyVar: we want to
// call unset traces even if other traces are pending.
 
if ( ( dummyVar.traces != null ) || ( ( array != null ) && ( array.traces != null ) ) )
{
var.refCount++;
dummyVar.flags &= ~VarFlags.TRACE_ACTIVE;
callTraces( interp, array, dummyVar, part1, part2, ( flags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ) ) | TCL.VarFlag.TRACE_UNSETS );
 
dummyVar.traces = null;
 
// Active trace stuff is not part of Jacl's interp
 
var.refCount--;
}
 
// If the variable is an array, delete all of its elements. This must be
// done after calling the traces on the array, above (that's the way
// traces are defined). If it is a scalar, "discard" its object
// (decrement the ref count of its object, if any).
 
if ( dummyVar.isVarArray() && !dummyVar.isVarUndefined() )
{
deleteArray( interp, part1, dummyVar, ( flags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ) ) | TCL.VarFlag.TRACE_UNSETS );
}
if ( dummyVar.isVarScalar() && ( dummyVar.value != null ) )
{
obj = (TclObject)dummyVar.value;
obj.release();
dummyVar.value = null;
}
 
// If the variable was a namespace variable, decrement its reference count.
 
if ( ( var.flags & VarFlags.NAMESPACE_VAR ) != 0 )
{
var.flags &= ~VarFlags.NAMESPACE_VAR;
var.refCount--;
}
 
// Finally, if the variable is truly not in use then free up its Var
// structure and remove it from its hash table, if any. The ref count of
// its value object, if any, was decremented above.
 
cleanupVar( var, array );
 
// It's an error to unset an undefined variable.
 
if ( result != TCL.CompletionCode.OK )
{
if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclVarException( interp, part1, part2, "unset", ( ( array == null ) ? noSuchVar : noSuchElement ) );
}
}
}
 
 
/// <summary> Trace 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 add.
/// </param>
/// <param name="flags">misc flags that control the actions of this method.
/// </param>
 
internal static void traceVar( Interp interp, TclObject nameObj, TCL.VarFlag flags, VarTrace proc )
{
 
traceVar( interp, nameObj.ToString(), null, flags, proc );
}
 
/// <summary> Trace a variable.
///
/// </summary>
/// <param name="name">name of the variable.
/// </param>
/// <param name="trace">the trace to add.
/// </param>
/// <param name="flags">misc flags that control the actions of this method.
/// </param>
 
internal static void traceVar( Interp interp, string name, TCL.VarFlag flags, VarTrace proc )
{
traceVar( interp, name, null, flags, proc );
}
 
/// <summary> TCL.Tcl_TraceVar2 -> traceVar
///
/// Trace a variable, given a two-part name consisting of array
/// name and element within array.
///
/// </summary>
/// <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>
/// <param name="trace">the trace to comand to add.
/// </param>
 
internal static void traceVar( Interp interp, string part1, string part2, TCL.VarFlag flags, VarTrace proc )
{
Var[] result;
Var var, array;
 
// FIXME: what about the exception problem here?
result = lookupVar( interp, part1, part2, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ), "trace", true, true );
if ( result == null )
{
throw new TclException( interp, "" );
}
 
var = result[0];
array = result[1];
 
// Set up trace information.
 
if ( var.traces == null )
{
var.traces = new ArrayList( 10 );
}
 
var rec = new TraceRecord();
rec.trace = proc;
rec.flags = flags & ( TCL.VarFlag.TRACE_READS | TCL.VarFlag.TRACE_WRITES | TCL.VarFlag.TRACE_UNSETS | TCL.VarFlag.TRACE_ARRAY );
 
var.traces.Insert( 0, rec );
 
 
// FIXME: is this needed ?? It was in Jacl but not 8.1
 
/*
// When inserting a trace for an array on an UNDEFINED variable,
// the search IDs for that array are reset.
 
if (array != null && var.isVarUndefined()) {
array.sidVec = null;
}
*/
}
 
 
/// <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> Untrace a variable.
///
/// </summary>
/// <param name="name">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, string name, TCL.VarFlag flags, VarTrace proc )
{
untraceVar( interp, name, null, flags, proc );
}
 
/// <summary> TCL.Tcl_UntraceVar2 -> untraceVar
///
/// Untrace a variable, given a two-part name consisting of array
/// name and element within array. This will Remove a
/// previously-created trace for a variable.
///
/// </summary>
/// <param name="interp">Interpreter containing 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>
/// <param name="proc">the trace to delete.
/// </param>
 
internal static void untraceVar( Interp interp, string part1, string part2, TCL.VarFlag flags, VarTrace proc )
{
Var[] result = null;
Var var;
 
try
{
result = lookupVar( interp, part1, part2, flags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ), null, false, false );
if ( result == null )
{
return;
}
}
catch ( TclException e )
{
// FIXME: check for problems in exception in lookupVar
 
// We have set throwException argument to false in the
// lookupVar() call, so an exception should never be
// thrown.
 
throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
}
 
var = result[0];
 
if ( var.traces != null )
{
int len = var.traces.Count;
for ( int i = 0; i < len; i++ )
{
TraceRecord rec = (TraceRecord)var.traces[i];
if ( rec.trace == proc )
{
var.traces.RemoveAt( i );
break;
}
}
}
 
// If this is the last trace on the variable, and the variable is
// unset and unused, then free up the variable.
 
if ( var.isVarUndefined() )
{
cleanupVar( var, null );
}
}
 
/// <summary> TCL.Tcl_VarTraceInfo -> getTraces
///
/// </summary>
/// <param name="interp">Interpreter containing variable.
/// </param>
/// <param name="name">name of the variable.
/// </param>
/// <param name="flags">flags that control the actions of this method.
/// </param>
/// <returns> the Vector of traces of a variable.
/// </returns>
 
static protected internal ArrayList getTraces( Interp interp, string name, TCL.VarFlag flags )
{
return getTraces( interp, name, null, flags );
}
 
/// <summary> TCL.Tcl_VarTraceInfo2 -> getTraces
///
/// </summary>
/// <returns> the list of traces of a variable.
///
/// </returns>
/// <param name="interp">Interpreter containing variable.
/// </param>
/// <param name="part1">1st part of the variable name.
/// </param>
/// <param name="part2">2nd part of the variable name (can be null).
/// </param>
/// <param name="flags">misc flags that control the actions of this method.
/// </param>
 
static protected internal ArrayList getTraces( Interp interp, string part1, string part2, TCL.VarFlag flags )
{
Var[] result;
 
result = lookupVar( interp, part1, part2, flags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ), null, false, false );
 
if ( result == null )
{
return null;
}
 
return result[0].traces;
}
 
 
/// <summary> MakeUpvar -> makeUpvar
///
/// Create a reference of a variable in otherFrame in the current
/// CallFrame, given a two-part name consisting of array name and
/// element within array.
///
/// </summary>
/// <param name="interp">Interp containing the variables
/// </param>
/// <param name="frame">CallFrame containing "other" variable.
/// null means use global context.
/// </param>
/// <param name="otherP1">the 1st part name of the variable in the "other" frame.
/// </param>
/// <param name="otherP2">the 2nd part name of the variable in the "other" frame.
/// </param>
/// <param name="otherFlags">the flags for scaope of "other" variable
/// </param>
/// <param name="myName">Name of scalar variable which will refer to otherP1/otherP2.
/// </param>
/// <param name="myFlags">only the TCL.VarFlag.GLOBAL_ONLY bit matters,
/// indicating the scope of myName.
/// </param>
/// <exception cref=""> TclException if the upvar cannot be created.
/// </exception>
 
protected internal static void makeUpvar( Interp interp, CallFrame frame, string otherP1, string otherP2, TCL.VarFlag otherFlags, string myName, TCL.VarFlag myFlags )
{
Var other, var, array;
Var[] result;
CallFrame varFrame;
CallFrame savedFrame = null;
Hashtable table;
NamespaceCmd.Namespace ns, altNs;
string tail;
bool newvar = false;
 
// Find "other" in "frame". If not looking up other in just the
// current namespace, temporarily replace the current var frame
// pointer in the interpreter in order to use TclLookupVar.
 
if ( ( otherFlags & TCL.VarFlag.NAMESPACE_ONLY ) == 0 )
{
savedFrame = interp.varFrame;
interp.varFrame = frame;
}
result = lookupVar( interp, otherP1, otherP2, ( otherFlags | TCL.VarFlag.LEAVE_ERR_MSG ), "access", true, true );
 
if ( ( otherFlags & TCL.VarFlag.NAMESPACE_ONLY ) == 0 )
{
interp.varFrame = savedFrame;
}
 
other = result[0];
array = result[1];
 
if ( other == null )
{
// FIXME : leave error message thing again
throw new TclRuntimeError( "unexpected null reference" );
}
 
// Now create a hashtable entry for "myName". Create it as either a
// namespace variable or as a local variable in a procedure call
// frame. Interpret myName as a namespace variable if:
// 1) so requested by a TCL.VarFlag.GLOBAL_ONLY or TCL.VarFlag.NAMESPACE_ONLY flag,
// 2) there is no active frame (we're at the global :: scope),
// 3) the active frame was pushed to define the namespace context
// for a "namespace eval" or "namespace inscope" command,
// 4) the name has namespace qualifiers ("::"s).
// If creating myName in the active procedure, look in its
// hashtable for runtime-created local variables. Create that
// procedure's local variable hashtable if necessary.
 
varFrame = interp.varFrame;
if ( ( ( myFlags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ) ) != 0 ) || ( varFrame == null ) || !varFrame.isProcCallFrame || ( myName.IndexOf( "::" ) != -1 ) )
{
 
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
NamespaceCmd.Namespace[] nsArr = new NamespaceCmd.Namespace[1];
NamespaceCmd.Namespace[] altNsArr = new NamespaceCmd.Namespace[1];
NamespaceCmd.Namespace[] dummyNsArr = new NamespaceCmd.Namespace[1];
string[] tailArr = new string[1];
 
NamespaceCmd.getNamespaceForQualName( interp, myName, null, myFlags, nsArr, altNsArr, dummyNsArr, tailArr );
 
// Get the values out of the arrays!
ns = nsArr[0];
altNs = altNsArr[0];
tail = tailArr[0];
 
if ( ns == null )
{
ns = altNs;
}
if ( ns == null )
{
throw new TclException( interp, "bad variable name \"" + myName + "\": unknown namespace" );
}
 
// Check that we are not trying to create a namespace var linked to
// a local variable in a procedure. If we allowed this, the local
// variable in the shorter-lived procedure frame could go away
// leaving the namespace var's reference invalid.
 
if ( ( ( (System.Object)otherP2 != null ) ? array.ns : other.ns ) == null )
{
throw new TclException( interp, "bad variable name \"" + myName + "\": upvar won't create namespace variable that refers to procedure variable" );
}
 
// AKT var = (Var) ns.varTable.get(tail);
var = (Var)ns.varTable[tail];
if ( var == null )
{
// we are adding a new entry
newvar = true;
var = new Var();
// ATK ns.varTable.put(tail, var);
ns.varTable.Add( tail, var );
 
// There is no hPtr member in Jacl, The hPtr combines the table
// and the key used in a table lookup.
var.hashKey = tail;
var.table = ns.varTable;
 
var.ns = ns;
}
}
else
{
// Skip Compiled Local stuff
var = null;
if ( var == null )
{
// look in frame's local var hashtable
table = varFrame.varTable;
if ( table == null )
{
table = new Hashtable();
varFrame.varTable = table;
}
 
var = (Var)table[myName];
if ( var == null )
{
// we are adding a new entry
newvar = true;
var = new Var();
SupportClass.PutElement( table, myName, var );
 
// There is no hPtr member in Jacl, The hPtr combines the table
// and the key used in a table lookup.
var.hashKey = myName;
var.table = table;
 
var.ns = varFrame.ns;
}
}
}
 
if ( !newvar )
{
// The variable already exists. Make sure this variable "var"
// isn't the same as "other" (avoid circular links). Also, if
// it's not an upvar then it's an error. If it is an upvar, then
// just disconnect it from the thing it currently refers to.
 
if ( var == other )
{
throw new TclException( interp, "can't upvar from variable to itself" );
}
if ( var.isVarLink() )
{
Var link = (Var)var.value;
if ( link == other )
{
return;
}
link.refCount--;
if ( link.isVarUndefined() )
{
cleanupVar( link, null );
}
}
else if ( !var.isVarUndefined() )
{
throw new TclException( interp, "variable \"" + myName + "\" already exists" );
}
else if ( var.traces != null )
{
throw new TclException( interp, "variable \"" + myName + "\" has traces: can't use for upvar" );
}
}
 
var.setVarLink();
var.clearVarUndefined();
var.value = other;
other.refCount++;
return;
}
 
/*
*----------------------------------------------------------------------
*
* TCL.Tcl_GetVariableFullName -> getVariableFullName
*
* Given a Var token returned by NamespaceCmd.FindNamespaceVar, this
* procedure appends to an object the namespace variable's full
* name, qualified by a sequence of parent namespace names.
*
* Results:
* None.
*
* Side effects:
* The variable's fully-qualified name is returned.
*
*----------------------------------------------------------------------
*/
 
internal static string getVariableFullName( Interp interp, Var var )
{
StringBuilder buff = new StringBuilder();
 
// Add the full name of the containing namespace (if any), followed by
// the "::" separator, then the variable name.
 
if ( var != null )
{
if ( !var.isVarArrayElement() )
{
if ( var.ns != null )
{
buff.Append( var.ns.fullName );
if ( var.ns != interp.globalNs )
{
buff.Append( "::" );
}
}
// Jacl's Var class does not include the "name" member
// We use the "hashKey" member which is equivalent
 
if ( (System.Object)var.hashKey != null )
{
buff.Append( var.hashKey );
}
}
}
 
return buff.ToString();
}
 
/// <summary> CallTraces -> callTraces
///
/// This procedure is invoked to find and invoke relevant
/// trace procedures associated with a particular operation on
/// a variable. This procedure invokes traces both on the
/// variable and on its containing array (where relevant).
///
/// </summary>
/// <param name="interp">Interpreter containing variable.
/// </param>
/// <param name="array">array variable that contains the variable, or null
/// if the variable isn't an element of an array.
/// </param>
/// <param name="var">Variable whose traces are to be invoked.
/// </param>
/// <param name="part1">the first part of a variable name.
/// </param>
/// <param name="part2">the second part of a variable name.
/// </param>
/// <param name="flags">Flags to pass to trace procedures: indicates
/// what's happening to variable, plus other stuff like
/// TCL.VarFlag.GLOBAL_ONLY, TCL.VarFlag.NAMESPACE_ONLY, and TCL.VarFlag.INTERP_DESTROYED.
/// </param>
/// <returns> null if no trace procedures were invoked, or
/// if all the invoked trace procedures returned successfully.
/// The return value is non-null if a trace procedure returned an
/// error (in this case no more trace procedures were invoked
/// after the error was returned). In this case the return value
/// is a pointer to a string describing the error.
/// </returns>
 
static protected internal string callTraces( Interp interp, Var array, Var var, string part1, string part2, TCL.VarFlag flags )
{
TclObject oldResult;
int i;
 
// If there are already similar trace procedures active for the
// variable, don't call them again.
 
if ( ( var.flags & VarFlags.TRACE_ACTIVE ) != 0 )
{
return null;
}
var.flags |= VarFlags.TRACE_ACTIVE;
var.refCount++;
 
// If the variable name hasn't been parsed into array name and
// element, do it here. If there really is an array element,
// make a copy of the original name so that nulls can be
// inserted into it to separate the names (can't modify the name
// string in place, because the string might get used by the
// callbacks we invoke).
 
// FIXME : come up with parsing code to use for all situations!
if ( (System.Object)part2 == null )
{
int len = part1.Length;
 
if ( len > 0 )
{
if ( part1[len - 1] == ')' )
{
for ( i = 0; i < len - 1; i++ )
{
if ( part1[i] == '(' )
{
break;
}
}
if ( i < len - 1 )
{
if ( i < len - 2 )
{
part2 = part1.Substring( i + 1, ( len - 1 ) - ( i + 1 ) );
part1 = part1.Substring( 0, ( i ) - ( 0 ) );
}
}
}
}
}
 
oldResult = interp.getResult();
oldResult.preserve();
interp.resetResult();
 
try
{
// Invoke traces on the array containing the variable, if relevant.
 
if ( array != null )
{
array.refCount++;
}
if ( ( array != null ) && ( array.traces != null ) )
{
for ( i = 0; ( array.traces != null ) && ( i < array.traces.Count ); i++ )
{
TraceRecord rec = (TraceRecord)array.traces[i];
if ( ( rec.flags & flags ) != 0 )
{
try
{
rec.trace.traceProc( interp, part1, part2, flags );
}
catch ( TclException e )
{
if ( ( flags & TCL.VarFlag.TRACE_UNSETS ) == 0 )
{
 
return interp.getResult().ToString();
}
}
}
}
}
 
// Invoke traces on the variable itself.
 
if ( ( flags & TCL.VarFlag.TRACE_UNSETS ) != 0 )
{
flags |= TCL.VarFlag.TRACE_DESTROYED;
}
 
for ( i = 0; ( var.traces != null ) && ( i < var.traces.Count ); i++ )
{
TraceRecord rec = (TraceRecord)var.traces[i];
if ( ( rec.flags & flags ) != 0 )
{
try
{
rec.trace.traceProc( interp, part1, part2, flags );
}
catch ( TclException e )
{
if ( ( flags & TCL.VarFlag.TRACE_UNSETS ) == 0 )
{
 
return interp.getResult().ToString();
}
}
}
}
 
return null;
}
finally
{
if ( array != null )
{
array.refCount--;
}
var.flags &= ~VarFlags.TRACE_ACTIVE;
var.refCount--;
 
interp.setResult( oldResult );
oldResult.release();
}
}
 
/// <summary> DeleteSearches -> deleteSearches
///
/// This procedure is called to free up all of the searches
/// associated with an array variable.
///
/// </summary>
/// <param name="interp">Interpreter containing array.
/// </param>
/// <param name="arrayVar">the array variable to delete searches from.
/// </param>
 
static protected internal void deleteSearches( Var arrayVar )
// Variable whose searches are to be deleted.
{
arrayVar.sidVec = null;
}
 
/// <summary> TclDeleteVars -> deleteVars
///
/// This procedure is called to recycle all the storage space
/// associated with a table of variables. For this procedure
/// to work correctly, it must not be possible for any of the
/// variables in the table to be accessed from Tcl commands
/// (e.g. from trace procedures).
///
/// </summary>
/// <param name="interp">Interpreter containing array.
/// </param>
/// <param name="table">Hashtbale that holds the Vars to delete
/// </param>
 
static protected internal void deleteVars( Interp interp, Hashtable table )
{
IEnumerator search;
string hashKey;
Var var;
Var link;
TCL.VarFlag flags;
//ActiveVarTrace active;
TclObject obj;
NamespaceCmd.Namespace currNs = NamespaceCmd.getCurrentNamespace( interp );
 
// Determine what flags to pass to the trace callback procedures.
 
flags = TCL.VarFlag.TRACE_UNSETS;
if ( table == interp.globalNs.varTable )
{
flags |= ( TCL.VarFlag.INTERP_DESTROYED | TCL.VarFlag.GLOBAL_ONLY );
}
else if ( table == currNs.varTable )
{
flags |= TCL.VarFlag.NAMESPACE_ONLY;
}
 
 
for ( search = table.Values.GetEnumerator(); search.MoveNext(); )
{
var = (Var)search.Current;
 
// For global/upvar variables referenced in procedures, decrement
// the reference count on the variable referred to, and free
// the referenced variable if it's no longer needed. Don't delete
// the hash entry for the other variable if it's in the same table
// as us: this will happen automatically later on.
 
if ( var.isVarLink() )
{
link = (Var)var.value;
link.refCount--;
if ( ( link.refCount == 0 ) && link.isVarUndefined() && ( link.traces == null ) && ( ( link.flags & VarFlags.IN_HASHTABLE ) != 0 ) )
{
 
if ( (System.Object)link.hashKey == null )
{
var.value = null; // Drops reference to the link Var
}
else if ( link.table != table )
{
SupportClass.HashtableRemove( link.table, link.hashKey );
link.table = null; // Drops the link var's table reference
var.value = null; // Drops reference to the link Var
}
}
}
 
// free up the variable's space (no need to free the hash entry
// here, unless we're dealing with a global variable: the
// hash entries will be deleted automatically when the whole
// table is deleted). Note that we give callTraces the variable's
// fully-qualified name so that any called trace procedures can
// refer to these variables being deleted.
 
if ( var.traces != null )
{
string fullname = getVariableFullName( interp, var );
 
callTraces( interp, null, var, fullname, null, flags );
 
// The var.traces = null statement later will drop all the
// references to the traces which will free them up
}
 
if ( var.isVarArray() )
{
deleteArray( interp, var.hashKey, var, flags );
var.value = null;
}
if ( var.isVarScalar() && ( var.value != null ) )
{
obj = (TclObject)var.value;
obj.release();
var.value = null;
}
 
// There is no hPtr member in Jacl, The hPtr combines the table
// and the key used in a table lookup.
var.hashKey = null;
var.table = null;
var.traces = null;
var.setVarUndefined();
var.setVarScalar();
 
// If the variable was a namespace variable, decrement its
// reference count. We are in the process of destroying its
// namespace so that namespace will no longer "refer" to the
// variable.
 
if ( ( var.flags & VarFlags.NAMESPACE_VAR ) != 0 )
{
var.flags &= ~VarFlags.NAMESPACE_VAR;
var.refCount--;
}
 
// Recycle the variable's memory space if there aren't any upvar's
// pointing to it. If there are upvars to this variable, then the
// variable will get freed when the last upvar goes away.
 
if ( var.refCount == 0 )
{
// When we drop the last reference it will be freeded
}
}
table.Clear();
}
 
 
/// <summary> DeleteArray -> deleteArray
///
/// This procedure is called to free up everything in an array
/// variable. It's the caller's responsibility to make sure
/// that the array is no longer accessible before this procedure
/// is called.
///
/// </summary>
/// <param name="interp">Interpreter containing array.
/// </param>
/// <param name="arrayName">name of array (used for trace callbacks).
/// </param>
/// <param name="var">the array variable to delete.
/// </param>
/// <param name="flags">Flags to pass to CallTraces.
/// </param>
 
static protected internal void deleteArray( Interp interp, string arrayName, Var var, TCL.VarFlag flags )
{
IEnumerator search;
Var el;
TclObject obj;
 
deleteSearches( var );
Hashtable table = (Hashtable)var.value;
 
Var dummyVar;
for ( search = table.Values.GetEnumerator(); search.MoveNext(); )
{
el = (Var)search.Current;
 
if ( el.isVarScalar() && ( el.value != null ) )
{
obj = (TclObject)el.value;
obj.release();
el.value = null;
}
 
string tmpkey = (string)el.hashKey;
// There is no hPtr member in Jacl, The hPtr combines the table
// and the key used in a table lookup.
el.hashKey = null;
el.table = null;
if ( el.traces != null )
{
el.flags &= ~VarFlags.TRACE_ACTIVE;
// FIXME : Old Jacl impl passed a dummy var to callTraces, should we?
callTraces( interp, null, el, arrayName, tmpkey, flags );
el.traces = null;
// Active trace stuff is not part of Jacl
}
el.setVarUndefined();
el.setVarScalar();
if ( el.refCount == 0 )
{
// We are no longer using the element
// element Vars are IN_HASHTABLE
}
}
( (Hashtable)var.value ).Clear();
var.value = null;
}
 
 
/// <summary> CleanupVar -> cleanupVar
///
/// This procedure is called when it looks like it may be OK
/// to free up the variable's record and hash table entry, and
/// those of its containing parent. It's called, for example,
/// when a trace on a variable deletes the variable.
///
/// </summary>
/// <param name="var">variable that may be a candidate for being expunged.
/// </param>
/// <param name="array">Array that contains the variable, or NULL if this
/// variable isn't an array element.
/// </param>
 
static protected internal void cleanupVar( Var var, Var array )
{
if ( var.isVarUndefined() && ( var.refCount == 0 ) && ( var.traces == null ) && ( ( var.flags & VarFlags.IN_HASHTABLE ) != 0 ) )
{
if ( var.table != null )
{
SupportClass.HashtableRemove( var.table, var.hashKey );
var.table = null;
var.hashKey = null;
}
}
if ( array != null )
{
if ( array.isVarUndefined() && ( array.refCount == 0 ) && ( array.traces == null ) && ( ( array.flags & VarFlags.IN_HASHTABLE ) != 0 ) )
{
if ( array.table != null )
{
SupportClass.HashtableRemove( array.table, array.hashKey );
array.table = null;
array.hashKey = null;
}
}
}
}
} // End of Var class
}
/trunk/TCL/src/base/VarTrace.cs
@@ -0,0 +1,34 @@
/*
* VarTrace.java --
*
* Interface for creating variable traces.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: VarTrace.java,v 1.1.1.1 1998/10/14 21:09:14 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This interface is used to make variable traces. To make a variable
* trace, write a class that implements the VarTrace and call
* Interp.traceVar with an instance of that class.
*
*/
 
public interface VarTrace
{
 
void traceProc( Interp interp, string part1, string part2, TCL.VarFlag flags ); // The traceProc may throw a TclException
// to indicate an error during the trace.
} // end VarTrace
}
/trunk/TCL/src/base/WrappedCommand.cs
@@ -0,0 +1,91 @@
/*
* WrappedCommand.java
*
* Wrapper for commands located inside a Jacl interp.
*
* Copyright (c) 1999 Mo DeJong.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: WrappedCommand.java,v 1.2 1999/08/05 03:42:05 mo Exp $
*/
using System.Collections;
using System.Text;
 
namespace tcl.lang
{
 
/// <summary> A Wrapped Command is like the Command struct defined in the C version
/// in the file generic/tclInt.h. It is "wrapped" around a TclJava Command
/// interface reference. We need to wrap Command references so that we
/// can keep track of sticky issues like what namespace the command is
/// defined in without requiring that every implementation of a Command
/// interface provide method to do this. This class is only used in
/// the internal implementation of Jacl.
/// </summary>
 
public class WrappedCommand
{
internal Hashtable table; // Reference to the table that this command is
// defined inside. The hashKey member can be
// used to lookup this CommandWrapper instance
// in the table of CommandWrappers. The table
// member combined with the hashKey member are
// are equivilent to the C version's Command->hPtr.
internal string hashKey; // A string that stores the name of the command.
// This name is NOT fully qualified.
 
 
internal NamespaceCmd.Namespace ns; // The namespace where the command is located
 
internal Command cmd; // The actual Command interface that we are wrapping.
 
internal bool deleted; // Means that the command is in the process
// of being deleted. Other attempts to
// delete the command should be ignored.
 
internal ImportRef importRef; // List of each imported Command created in
// another namespace when this command is
// imported. These imported commands
// redirect invocations back to this
// command. The list is used to remove all
// those imported commands when deleting
// this "real" command.
 
internal Interp.dxObjCmdProc objProc;//cmdPtr->objProc = proc;
public object objClientData;//cmdPtr->objClientData = clientData;
//internal TclInvokeObjectCommand proc; //cmdPtr.proc = TclInvokeObjectCommand;
internal object clientData;//cmdPtr->clientData = (ClientData)cmdPtr;
internal Interp.dxCmdDeleteProc deleteProc;//cmdPtr->deleteProc = deleteProc;
internal object deleteData;//cmdPtr->deleteData = clientData;
internal int flags;//cmdPtr->flags = 0;
 
public override string ToString()
{
StringBuilder sb = new StringBuilder();
 
sb.Append( "Wrapper for " );
if ( ns != null )
{
sb.Append( ns.fullName );
if ( ns.fullName != "::" )
{
sb.Append( "::" );
}
}
if ( table != null )
{
sb.Append( hashKey );
}
 
sb.Append( " -> " );
sb.Append( cmd.GetType().FullName );
 
return sb.ToString();
}
}
}
/trunk/TCL/src/commands/AfterCmd.cs
@@ -0,0 +1,531 @@
/*
* AfterCmd.java --
*
* Implements the built-in "after" Tcl command.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: AfterCmd.java,v 1.2 2002/04/12 21:00:26 mdejong Exp $
*
*/
using System;
using System.Collections;
 
 
namespace tcl.lang
{
 
/*
* This class implements the built-in "after" command in Tcl.
*/
 
class AfterCmd : Command
{
 
/*
* The list of handler are stored as AssocData in the interp.
*/
 
internal AfterAssocData assocData = null;
 
/*
* Valid command options.
*/
 
private static readonly string[] validOpts = new string[] { "cancel", "idle", "info" };
 
internal const int OPT_CANCEL = 0;
internal const int OPT_IDLE = 1;
internal const int OPT_INFO = 2;
 
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;
}
private TclObject getCmdObject( TclObject[] argv )
// Argument list passed to the "after" command.
{
if ( argv.Length == 3 )
{
return argv[2];
}
else
{
TclObject cmd = TclString.newInstance( Util.concat( 2, argv.Length - 1, argv ) );
return cmd;
}
}
private Object getAfterEvent( string inString )
// Textual identifier for after event, such
// as "after#6".
{
if ( !inString.StartsWith( "after#" ) )
{
return null;
}
 
StrtoulResult res = Util.strtoul( inString, 6, 10 );
if ( res.errno != 0 )
{
return null;
}
 
for ( int i = 0; i < assocData.handlers.Count; i++ )
{
Object obj = assocData.handlers[i];
if ( obj is TimerInfo )
{
if ( ( (TimerInfo)obj ).id == res.value )
{
return obj;
}
}
else
{
if ( ( (IdleInfo)obj ).id == res.value )
{
return obj;
}
}
}
 
return null;
}
internal class AfterAssocData : AssocData
{
public AfterAssocData( AfterCmd enclosingInstance )
{
InitBlock( enclosingInstance );
}
private void InitBlock( AfterCmd enclosingInstance )
{
this.enclosingInstance = enclosingInstance;
handlers = new ArrayList( 10 );
}
private AfterCmd enclosingInstance;
public AfterCmd Enclosing_Instance
{
get
{
return enclosingInstance;
}
 
}
 
/*
* The set of handlers created but not yet fired.
*/
 
internal ArrayList handlers;
 
/*
* Timer identifier of most recently created timer.
*/
 
internal int lastAfterId = 0;
 
public void disposeAssocData( Interp interp )
// The interpreter in which this AssocData
// instance is registered in.
{
for ( int i = Enclosing_Instance.assocData.handlers.Count - 1; i >= 0; i-- )
{
Object info = Enclosing_Instance.assocData.handlers[i];
Enclosing_Instance.assocData.handlers.RemoveAt( i );
if ( info is TimerInfo )
{
( (TimerInfo)info ).cancel();
( (TimerInfo)info ).command.release();
}
else
{
( (IdleInfo)info ).cancel();
( (IdleInfo)info ).command.release();
}
}
Enclosing_Instance.assocData = null;
}
} // end AfterCmd.AfterAssocData
 
internal class TimerInfo : TimerHandler
{
private void InitBlock( AfterCmd enclosingInstance )
{
this.enclosingInstance = enclosingInstance;
}
private AfterCmd enclosingInstance;
public AfterCmd Enclosing_Instance
{
get
{
return enclosingInstance;
}
 
}
 
/*
* Interpreter in which the script should be executed.
*/
 
internal Interp interp;
 
/*
* Command to execute when the timer fires.
*/
 
internal TclObject command;
 
/*
* Integer identifier for command; used to cancel it.
*/
 
internal int id;
 
internal TimerInfo( AfterCmd enclosingInstance, Notifier n, int milliseconds )
: base( n, milliseconds )
{
InitBlock( enclosingInstance );
}
public override void processTimerEvent()
{
try
{
SupportClass.VectorRemoveElement( Enclosing_Instance.assocData.handlers, this );
interp.eval( command, TCL.EVAL_GLOBAL );
}
catch ( TclException e )
{
interp.addErrorInfo( "\n (\"after\" script)" );
interp.backgroundError();
}
finally
{
command.release();
command = null;
}
}
} // end AfterCmd.AfterInfo
 
internal class IdleInfo : IdleHandler
{
private void InitBlock( AfterCmd enclosingInstance )
{
this.enclosingInstance = enclosingInstance;
}
private AfterCmd enclosingInstance;
public AfterCmd Enclosing_Instance
{
get
{
return enclosingInstance;
}
 
}
 
/*
* Interpreter in which the script should be executed.
*/
 
internal Interp interp;
 
/*
* Command to execute when the idle event fires.
*/
 
internal TclObject command;
 
/*
* Integer identifier for command; used to cancel it.
*/
 
internal int id;
 
internal IdleInfo( AfterCmd enclosingInstance, Notifier n )
: base( n )
{
InitBlock( enclosingInstance );
}
public override void processIdleEvent()
{
try
{
SupportClass.VectorRemoveElement( Enclosing_Instance.assocData.handlers, this );
interp.eval( command, TCL.EVAL_GLOBAL );
}
catch ( TclException e )
{
interp.addErrorInfo( "\n (\"after\" script)" );
interp.backgroundError();
}
finally
{
command.release();
command = null;
}
}
} // end AfterCmd.AfterInfo
} // end AfterCmd
}
/trunk/TCL/src/commands/AppendCmd.cs
@@ -0,0 +1,61 @@
/*
* AppendCmd.java --
*
* Implements the built-in "append" Tcl command.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: AppendCmd.java,v 1.2 1999/07/28 01:59:49 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements the built-in "append" command in Tcl.
*/
 
class AppendCmd : Command
{
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;
}
} // end AppendCmd
}
/trunk/TCL/src/commands/ArrayCmd.cs
@@ -0,0 +1,554 @@
/*
* ArrayCmd.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ArrayCmd.java,v 1.4 2003/01/10 01:57:57 mdejong Exp $
*
*/
using System;
using System.Collections;
 
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "array" command in Tcl.</summary>
 
class ArrayCmd : Command
{
internal static Type procClass = null;
 
private static readonly string[] validCmds = new string[] { "anymore", "donesearch", "exists", "get", "names", "nextelement", "set", "size", "startsearch", "unset" };
 
internal const int OPT_ANYMORE = 0;
internal const int OPT_DONESEARCH = 1;
internal const int OPT_EXISTS = 2;
internal const int OPT_GET = 3;
internal const int OPT_NAMES = 4;
internal const int OPT_NEXTELEMENT = 5;
internal const int OPT_SET = 6;
internal const int OPT_SIZE = 7;
internal const int OPT_STARTSEARCH = 8;
internal const int OPT_UNSET = 9;
 
/// <summary> This procedure is invoked to process the "array" Tcl command.
/// See the user documentation for details on what it does.
/// </summary>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
Var var = null, array = null;
bool notArray = false;
string varName, msg;
int index;//, result;
 
if ( objv.Length < 3 )
{
throw new TclNumArgsException( interp, 1, objv, "option arrayName ?arg ...?" );
}
 
index = TclIndex.get( interp, objv[1], validCmds, "option", 0 );
 
// Locate the array variable (and it better be an array).
 
 
varName = objv[2].ToString();
Var[] retArray = Var.lookupVar( interp, varName, null, 0, null, false, false );
 
// Assign the values returned in the array
if ( retArray != null )
{
var = retArray[0];
array = retArray[1];
}
 
if ( ( var == null ) || !var.isVarArray() || var.isVarUndefined() )
{
notArray = true;
}
 
// Special array trace used to keep the env array in sync for
// array names, array get, etc.
 
if ( var != null && var.traces != null )
{
msg = Var.callTraces( interp, array, var, varName, null, ( TCL.VarFlag.LEAVE_ERR_MSG | TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.TRACE_ARRAY ) );
if ( (System.Object)msg != null )
{
throw new TclVarException( interp, varName, null, "trace array", msg );
}
}
 
switch ( index )
{
 
case OPT_ANYMORE:
{
if ( objv.Length != 4 )
{
throw new TclNumArgsException( interp, 2, objv, "arrayName searchId" );
}
if ( notArray )
{
 
errorNotArray( interp, objv[2].ToString() );
}
 
if ( var.sidVec == null )
{
 
errorIllegalSearchId( interp, objv[2].ToString(), objv[3].ToString() );
}
 
 
SearchId e = var.getSearch( objv[3].ToString() );
if ( e == null )
{
 
errorIllegalSearchId( interp, objv[2].ToString(), objv[3].ToString() );
}
 
if ( e.HasMore )
{
interp.setResult( "1" );
}
else
{
interp.setResult( "0" );
}
break;
}
 
case OPT_DONESEARCH:
{
 
if ( objv.Length != 4 )
{
throw new TclNumArgsException( interp, 2, objv, "arrayName searchId" );
}
if ( notArray )
{
 
errorNotArray( interp, objv[2].ToString() );
}
 
bool rmOK = true;
if ( var.sidVec != null )
{
 
rmOK = ( var.removeSearch( objv[3].ToString() ) );
}
if ( ( var.sidVec == null ) || !rmOK )
{
 
errorIllegalSearchId( interp, objv[2].ToString(), objv[3].ToString() );
}
break;
}
 
case OPT_EXISTS:
{
 
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "arrayName" );
}
interp.setResult( !notArray );
break;
}
 
case OPT_GET:
{
// Due to the differences in the hashtable implementation
// from the Tcl core and Java, the output will be rearranged.
// This is not a negative side effect, however, test results
// will differ.
 
if ( ( objv.Length != 3 ) && ( objv.Length != 4 ) )
{
throw new TclNumArgsException( interp, 2, objv, "arrayName ?pattern?" );
}
if ( notArray )
{
return TCL.CompletionCode.RETURN;
}
 
string pattern = null;
if ( objv.Length == 4 )
{
 
pattern = objv[3].ToString();
}
 
Hashtable table = (Hashtable)var.value;
TclObject tobj = TclList.newInstance();
 
string arrayName = objv[2].ToString();
string key, strValue;
Var var2;
 
// Go through each key in the hash table. If there is a
// pattern, test for a match. Each valid key and its value
// is written into sbuf, which is returned.
 
// FIXME : do we need to port over the 8.1 code for this loop?
 
for ( IDictionaryEnumerator e = table.GetEnumerator(); e.MoveNext(); )
{
key = ( (string)e.Key );
var2 = (Var)e.Value;
if ( var2.isVarUndefined() )
{
continue;
}
 
if ( (System.Object)pattern != null && !Util.stringMatch( key, pattern ) )
{
continue;
}
 
 
strValue = interp.getVar( arrayName, key, 0 ).ToString();
 
TclList.append( interp, tobj, TclString.newInstance( key ) );
TclList.append( interp, tobj, TclString.newInstance( strValue ) );
}
interp.setResult( tobj );
break;
}
 
case OPT_NAMES:
{
 
if ( ( objv.Length != 3 ) && ( objv.Length != 4 ) )
{
throw new TclNumArgsException( interp, 2, objv, "arrayName ?pattern?" );
}
if ( notArray )
{
return TCL.CompletionCode.RETURN;
}
 
string pattern = null;
if ( objv.Length == 4 )
{
 
pattern = objv[3].ToString();
}
 
Hashtable table = (Hashtable)var.value;
TclObject tobj = TclList.newInstance();
string key;
 
// Go through each key in the hash table. If there is a
// pattern, test for a match. Each valid key and its value
// is written into sbuf, which is returned.
 
for ( IDictionaryEnumerator e = table.GetEnumerator(); e.MoveNext(); )
{
key = (string)e.Key;
Var elem = (Var)e.Value;
if ( !elem.isVarUndefined() )
{
if ( (System.Object)pattern != null )
{
if ( !Util.stringMatch( key, pattern ) )
{
continue;
}
}
TclList.append( interp, tobj, TclString.newInstance( key ) );
}
}
interp.setResult( tobj );
break;
}
 
case OPT_NEXTELEMENT:
{
 
if ( objv.Length != 4 )
{
throw new TclNumArgsException( interp, 2, objv, "arrayName searchId" );
}
if ( notArray )
{
 
errorNotArray( interp, objv[2].ToString() );
}
 
if ( var.sidVec == null )
{
 
errorIllegalSearchId( interp, objv[2].ToString(), objv[3].ToString() );
}
 
 
SearchId e = var.getSearch( objv[3].ToString() );
if ( e == null )
{
 
errorIllegalSearchId( interp, objv[2].ToString(), objv[3].ToString() );
}
if ( e.HasMore )
{
Hashtable table = (Hashtable)var.value;
DictionaryEntry entry = e.nextEntry();
string key = (string)entry.Key;
Var elem = (Var)entry.Value;
if ( ( elem.flags & VarFlags.UNDEFINED ) == 0 )
{
interp.setResult( key );
}
else
{
interp.setResult( "" );
}
}
break;
}
 
case OPT_SET:
{
 
if ( objv.Length != 4 )
{
throw new TclNumArgsException( interp, 2, objv, "arrayName list" );
}
int size = TclList.getLength( interp, objv[3] );
if ( size % 2 != 0 )
{
throw new TclException( interp, "list must have an even number of elements" );
}
 
int i;
 
string name1 = objv[2].ToString();
string name2, strValue;
 
// Set each of the array variable names in the interp
 
for ( i = 0; i < size; i++ )
{
 
name2 = TclList.index( interp, objv[3], i++ ).ToString();
 
strValue = TclList.index( interp, objv[3], i ).ToString();
interp.setVar( name1, name2, TclString.newInstance( strValue ), 0 );
}
break;
}
 
case OPT_SIZE:
{
 
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "arrayName" );
}
if ( notArray )
{
interp.setResult( 0 );
}
else
{
Hashtable table = (Hashtable)var.value;
int size = 0;
for ( IDictionaryEnumerator e = table.GetEnumerator(); e.MoveNext(); )
{
Var elem = (Var)e.Value;
if ( ( elem.flags & VarFlags.UNDEFINED ) == 0 )
{
size++;
}
}
interp.setResult( size );
}
break;
}
 
case OPT_STARTSEARCH:
{
 
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "arrayName" );
}
if ( notArray )
{
 
errorNotArray( interp, objv[2].ToString() );
}
 
if ( var.sidVec == null )
{
var.sidVec = new ArrayList( 10 );
}
 
// Create a SearchId Object:
// To create a new SearchId object, a unique string
// identifier needs to be composed and we need to
// create an Enumeration of the array keys. The
// unique string identifier is created from three
// strings:
//
// "s-" is the default prefix
// "i" is a unique number that is 1+ the greatest
// SearchId index currently on the ArrayVar.
// "name" is the name of the array
//
// Once the SearchId string is created we construct a
// new SearchId object using the string and the
// Enumeration. From now on the string is used to
// uniquely identify the SearchId object.
 
int i = var.NextIndex;
 
string s = "s-" + i + "-" + objv[2].ToString();
IDictionaryEnumerator e = ( (Hashtable)var.value ).GetEnumerator();
var.sidVec.Add( new SearchId( e, s, i ) );
interp.setResult( s );
break;
}
 
case OPT_UNSET:
{
string pattern;
string name;
 
if ( ( objv.Length != 3 ) && ( objv.Length != 4 ) )
{
throw new TclNumArgsException( interp, 2, objv, "arrayName ?pattern?" );
}
if ( notArray )
{
 
//Ignot this error -- errorNotArray(interp, objv[2].ToString());
break;
}
if ( objv.Length == 3 )
{
// When no pattern is given, just unset the whole array
 
interp.unsetVar( objv[2], 0 );
}
else
{
 
pattern = objv[3].ToString();
Hashtable table = (Hashtable)( ( (Hashtable)var.value ).Clone() );
for ( IDictionaryEnumerator e = table.GetEnumerator(); e.MoveNext(); )
{
name = (string)e.Key;
Var elem = (Var)e.Value;
if ( var.isVarUndefined() )
{
continue;
}
if ( Util.stringMatch( name, pattern ) )
{
interp.unsetVar( varName, name, 0 );
}
}
}
break;
}
}
return TCL.CompletionCode.RETURN;
}
 
/// <summary> Error meassage thrown when an invalid identifier is used
/// to access an array.
///
/// </summary>
/// <param name="interp">currrent interpreter.
/// </param>
/// <param name="String">var is the string representation of the
/// variable that was passed in.
/// </param>
 
private static void errorNotArray( Interp interp, string var )
{
throw new TclException( interp, "\"" + var + "\" isn't an array" );
}
 
 
/// <summary> Error message thrown when an invalid SearchId is used. The
/// string used to reference the SearchId is parced to determine
/// the reason for the failure.
///
/// </summary>
/// <param name="interp">currrent interpreter.
/// </param>
/// <param name="String">sid is the string represenation of the
/// SearchId that was passed in.
/// </param>
 
internal static void errorIllegalSearchId( Interp interp, string varName, string sid )
{
 
int val = validSearchId( sid.ToCharArray(), varName );
 
if ( val == 1 )
{
throw new TclException( interp, "couldn't find search \"" + sid + "\"" );
}
else if ( val == 0 )
{
throw new TclException( interp, "illegal search identifier \"" + sid + "\"" );
}
else
{
throw new TclException( interp, "search identifier \"" + sid + "\" isn't for variable \"" + varName + "\"" );
}
}
 
/// <summary> A valid SearchId is represented by the format s-#-arrayName. If
/// the SearchId string does not match this format than it is illegal,
/// else we cannot find it. This method is used by the
/// ErrorIllegalSearchId method to determine the type of error message.
///
/// </summary>
/// <param name="char">pattern[] is the string use dto identify the SearchId
/// </param>
/// <returns> 1 if its a valid searchID; 0 if it is not a valid searchId,
/// but it is for the array, -1 if it is not a valid searchId and NOT
/// for the array.
/// </returns>
 
private static int validSearchId( char[] pattern, string varName )
{
int i;
 
if ( ( pattern[0] != 's' ) || ( pattern[1] != '-' ) || ( pattern[2] < '0' ) || ( pattern[2] > '9' ) )
{
return 0;
}
for ( i = 3; ( i < pattern.Length && pattern[i] != '-' ); i++ )
{
if ( pattern[i] < '0' || pattern[i] > '9' )
{
return 0;
}
}
if ( ++i >= pattern.Length )
{
return 0;
}
if ( varName.Equals( new string( pattern, i, ( pattern.Length - i ) ) ) )
{
return 1;
}
else
{
return -1;
}
}
}
}
/trunk/TCL/src/commands/BinaryCmd.cs
@@ -0,0 +1,1109 @@
/*
* BinaryCmd.java --
*
* Implements the built-in "binary" Tcl command.
*
* Copyright (c) 1999 Christian Krone.
* Copyright (c) 1997 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: BinaryCmd.java,v 1.2 2002/05/07 06:58:06 mdejong Exp $
*
*/
using System;
using System.Text;
using System.IO;
namespace tcl.lang
{
 
/*
* This class implements the built-in "binary" command in Tcl.
*/
 
class BinaryCmd : Command
{
 
private static readonly string[] validCmds = new string[] { "format", "scan" };
private const string HEXDIGITS = "0123456789abcdef";
 
private const int CMD_FORMAT = 0;
private const int CMD_SCAN = 1;
 
// The following constants are used by GetFormatSpec to indicate various
// special conditions in the parsing of a format specifier.
 
// Use all elements in the argument.
private const int BINARY_ALL = -1;
// No count was specified in format.
private const int BINARY_NOCOUNT = -2;
// End of format was found.
private const char FORMAT_END = ' ';
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
int arg; // Index of next argument to consume.
char[] format = null; // User specified format string.
char cmd; // Current format character.
int cursor; // Current position within result buffer.
int maxPos; // Greatest position within result buffer that
// cursor has visited.
int value = 0; // Current integer value to be packed.
// Initialized to avoid compiler warning.
int offset, size = 0, length;//, index;
 
if ( argv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, argv, "option ?arg arg ...?" );
}
int cmdIndex = TclIndex.get( interp, argv[1], validCmds, "option", 0 );
 
switch ( cmdIndex )
{
 
case CMD_FORMAT:
{
if ( argv.Length < 3 )
{
throw new TclNumArgsException( interp, 2, argv, "formatString ?arg arg ...?" );
}
 
// To avoid copying the data, we format the string in two passes.
// The first pass computes the size of the output buffer. The
// second pass places the formatted data into the buffer.
 
format = argv[2].ToString().ToCharArray();
arg = 3;
length = 0;
offset = 0;
System.Int32 parsePos = 0;
 
while ( ( cmd = GetFormatSpec( format, ref parsePos ) ) != FORMAT_END )
{
int count = GetFormatCount( format, ref parsePos );
 
switch ( cmd )
{
 
case 'a':
case 'A':
case 'b':
case 'B':
case 'h':
case 'H':
{
// For string-type specifiers, the count corresponds
// to the number of bytes in a single argument.
 
if ( arg >= argv.Length )
{
missingArg( interp );
}
if ( count == BINARY_ALL )
{
count = TclByteArray.getLength( interp, argv[arg] );
}
else if ( count == BINARY_NOCOUNT )
{
count = 1;
}
arg++;
switch ( cmd )
{
 
case 'a':
case 'A':
offset += count;
break;
 
case 'b':
case 'B':
offset += ( count + 7 ) / 8;
break;
 
case 'h':
case 'H':
offset += ( count + 1 ) / 2;
break;
}
break;
}
 
case 'c':
case 's':
case 'S':
case 'i':
case 'I':
case 'f':
case 'd':
{
if ( arg >= argv.Length )
{
missingArg( interp );
}
switch ( cmd )
{
 
case 'c':
size = 1;
break;
 
case 's':
case 'S':
size = 2;
break;
 
case 'i':
case 'I':
size = 4;
break;
 
case 'f':
size = 4;
break;
 
case 'd':
size = 8;
break;
}
 
// For number-type specifiers, the count corresponds
// to the number of elements in the list stored in
// a single argument. If no count is specified, then
// the argument is taken as a single non-list value.
 
if ( count == BINARY_NOCOUNT )
{
arg++;
count = 1;
}
else
{
int listc = TclList.getLength( interp, argv[arg++] );
if ( count == BINARY_ALL )
{
count = listc;
}
else if ( count > listc )
{
throw new TclException( interp, "number of elements in list" + " does not match count" );
}
}
offset += count * size;
break;
}
 
case 'x':
{
if ( count == BINARY_ALL )
{
throw new TclException( interp, "cannot use \"*\"" + " in format string with \"x\"" );
}
if ( count == BINARY_NOCOUNT )
{
count = 1;
}
offset += count;
break;
}
 
case 'X':
{
if ( count == BINARY_NOCOUNT )
{
count = 1;
}
if ( ( count > offset ) || ( count == BINARY_ALL ) )
{
count = offset;
}
if ( offset > length )
{
length = offset;
}
offset -= count;
break;
}
 
case '@':
{
if ( offset > length )
{
length = offset;
}
if ( count == BINARY_ALL )
{
offset = length;
}
else if ( count == BINARY_NOCOUNT )
{
alephWithoutCount( interp );
}
else
{
offset = count;
}
break;
}
 
default:
{
badField( interp, cmd );
}
break;
 
}
}
if ( offset > length )
{
length = offset;
}
if ( length == 0 )
{
return TCL.CompletionCode.RETURN;
}
 
// Prepare the result object by preallocating the calculated
// number of bytes and filling with nulls.
 
TclObject resultObj = TclByteArray.newInstance();
byte[] resultBytes = TclByteArray.setLength( interp, resultObj, length );
interp.setResult( resultObj );
 
// Pack the data into the result object. Note that we can skip
// the error checking during this pass, since we have already
// parsed the string once.
 
arg = 3;
cursor = 0;
maxPos = cursor;
parsePos = 0;
 
while ( ( cmd = GetFormatSpec( format, ref parsePos ) ) != FORMAT_END )
{
int count = GetFormatCount( format, ref parsePos );
 
if ( ( count == 0 ) && ( cmd != '@' ) )
{
arg++;
continue;
}
 
switch ( cmd )
{
 
case 'a':
case 'A':
{
byte pad = ( cmd == 'a' ) ? (byte)0 : (byte)SupportClass.Identity( ' ' );
byte[] bytes = TclByteArray.getBytes( interp, argv[arg++] );
length = bytes.Length;
 
if ( count == BINARY_ALL )
{
count = length;
}
else if ( count == BINARY_NOCOUNT )
{
count = 1;
}
if ( length >= count )
{
Array.Copy( bytes, 0, resultBytes, cursor, count );
}
else
{
Array.Copy( bytes, 0, resultBytes, cursor, length );
for ( int ix = 0; ix < count - length; ix++ )
{
resultBytes[cursor + length + ix] = pad;
}
}
cursor += count;
break;
}
 
case 'b':
case 'B':
{
char[] str = argv[arg++].ToString().ToCharArray();
if ( count == BINARY_ALL )
{
count = str.Length;
}
else if ( count == BINARY_NOCOUNT )
{
count = 1;
}
int last = cursor + ( ( count + 7 ) / 8 );
if ( count > str.Length )
{
count = str.Length;
}
if ( cmd == 'B' )
{
for ( offset = 0; offset < count; offset++ )
{
value <<= 1;
if ( str[offset] == '1' )
{
value |= 1;
}
else if ( str[offset] != '0' )
{
expectedButGot( interp, "binary", new string( str ) );
}
if ( ( ( offset + 1 ) % 8 ) == 0 )
{
resultBytes[cursor++] = (byte)value;
value = 0;
}
}
}
else
{
for ( offset = 0; offset < count; offset++ )
{
value >>= 1;
if ( str[offset] == '1' )
{
value |= 128;
}
else if ( str[offset] != '0' )
{
expectedButGot( interp, "binary", new string( str ) );
}
if ( ( ( offset + 1 ) % 8 ) == 0 )
{
resultBytes[cursor++] = (byte)value;
value = 0;
}
}
}
if ( ( offset % 8 ) != 0 )
{
if ( cmd == 'B' )
{
value <<= 8 - ( offset % 8 );
}
else
{
value >>= 8 - ( offset % 8 );
}
resultBytes[cursor++] = (byte)value;
}
while ( cursor < last )
{
resultBytes[cursor++] = 0;
}
break;
}
 
case 'h':
case 'H':
{
char[] str = argv[arg++].ToString().ToCharArray();
if ( count == BINARY_ALL )
{
count = str.Length;
}
else if ( count == BINARY_NOCOUNT )
{
count = 1;
}
int last = cursor + ( ( count + 1 ) / 2 );
if ( count > str.Length )
{
count = str.Length;
}
if ( cmd == 'H' )
{
for ( offset = 0; offset < count; offset++ )
{
value <<= 4;
int c = HEXDIGITS.IndexOf( Char.ToLower( str[offset] ) );
if ( c < 0 )
{
expectedButGot( interp, "hexadecimal", new string( str ) );
}
value |= ( c & 0xf );
if ( ( offset % 2 ) != 0 )
{
resultBytes[cursor++] = (byte)value;
value = 0;
}
}
}
else
{
for ( offset = 0; offset < count; offset++ )
{
value >>= 4;
int c = HEXDIGITS.IndexOf( Char.ToLower( str[offset] ) );
if ( c < 0 )
{
expectedButGot( interp, "hexadecimal", new string( str ) );
}
value |= ( ( c << 4 ) & 0xf0 );
if ( ( offset % 2 ) != 0 )
{
resultBytes[cursor++] = (byte)value;
value = 0;
}
}
}
if ( ( offset % 2 ) != 0 )
{
if ( cmd == 'H' )
{
value <<= 4;
}
else
{
value >>= 4;
}
resultBytes[cursor++] = (byte)value;
}
while ( cursor < last )
{
resultBytes[cursor++] = 0;
}
break;
}
 
case 'c':
case 's':
case 'S':
case 'i':
case 'I':
case 'f':
case 'd':
{
TclObject[] listv;
 
if ( count == BINARY_NOCOUNT )
{
listv = new TclObject[1];
listv[0] = argv[arg++];
count = 1;
}
else
{
listv = TclList.getElements( interp, argv[arg++] );
if ( count == BINARY_ALL )
{
count = listv.Length;
}
}
for ( int ix = 0; ix < count; ix++ )
{
cursor = FormatNumber( interp, cmd, listv[ix], resultBytes, cursor );
}
break;
}
 
case 'x':
{
if ( count == BINARY_NOCOUNT )
{
count = 1;
}
for ( int ix = 0; ix < count; ix++ )
{
resultBytes[cursor++] = 0;
}
break;
}
 
case 'X':
{
if ( cursor > maxPos )
{
maxPos = cursor;
}
if ( count == BINARY_NOCOUNT )
{
count = 1;
}
if ( count == BINARY_ALL || count > cursor )
{
cursor = 0;
}
else
{
cursor -= count;
}
break;
}
 
case '@':
{
if ( cursor > maxPos )
{
maxPos = cursor;
}
if ( count == BINARY_ALL )
{
cursor = maxPos;
}
else
{
cursor = count;
}
break;
}
}
}
break;
}
 
case CMD_SCAN:
{
if ( argv.Length < 4 )
{
throw new TclNumArgsException( interp, 2, argv, "value formatString ?varName varName ...?" );
}
byte[] src = TclByteArray.getBytes( interp, argv[2] );
length = src.Length;
format = argv[3].ToString().ToCharArray();
arg = 4;
cursor = 0;
offset = 0;
System.Int32 parsePos = 0;
 
while ( ( cmd = GetFormatSpec( format, ref parsePos ) ) != FORMAT_END )
{
int count = GetFormatCount( format, ref parsePos );
 
switch ( cmd )
{
 
case 'a':
case 'A':
{
if ( arg >= argv.Length )
{
missingArg( interp );
}
if ( count == BINARY_ALL )
{
count = length - offset;
}
else
{
if ( count == BINARY_NOCOUNT )
{
count = 1;
}
if ( count > length - offset )
{
break;
}
}
 
size = count;
 
// Trim trailing nulls and spaces, if necessary.
 
if ( cmd == 'A' )
{
while ( size > 0 )
{
if ( src[offset + size - 1] != '\x0000' && src[offset + size - 1] != ' ' )
{
break;
}
size--;
}
}
 
interp.setVar( argv[arg++], TclByteArray.newInstance( src, offset, size ), 0 );
 
offset += count;
break;
}
 
case 'b':
case 'B':
{
if ( arg >= argv.Length )
{
missingArg( interp );
}
if ( count == BINARY_ALL )
{
count = ( length - offset ) * 8;
}
else
{
if ( count == BINARY_NOCOUNT )
{
count = 1;
}
if ( count > ( length - offset ) * 8 )
{
break;
}
}
StringBuilder s = new StringBuilder( count );
int thisOffset = offset;
 
if ( cmd == 'b' )
{
for ( int ix = 0; ix < count; ix++ )
{
if ( ( ix % 8 ) != 0 )
{
value >>= 1;
}
else
{
value = src[thisOffset++];
}
s.Append( ( value & 1 ) != 0 ? '1' : '0' );
}
}
else
{
for ( int ix = 0; ix < count; ix++ )
{
if ( ( ix % 8 ) != 0 )
{
value <<= 1;
}
else
{
value = src[thisOffset++];
}
s.Append( ( value & 0x80 ) != 0 ? '1' : '0' );
}
}
 
interp.setVar( argv[arg++], TclString.newInstance( s.ToString() ), 0 );
 
offset += ( count + 7 ) / 8;
break;
}
 
case 'h':
case 'H':
{
if ( arg >= argv.Length )
{
missingArg( interp );
}
if ( count == BINARY_ALL )
{
count = ( length - offset ) * 2;
}
else
{
if ( count == BINARY_NOCOUNT )
{
count = 1;
}
if ( count > ( length - offset ) * 2 )
{
break;
}
}
StringBuilder s = new StringBuilder( count );
int thisOffset = offset;
 
if ( cmd == 'h' )
{
for ( int ix = 0; ix < count; ix++ )
{
if ( ( ix % 2 ) != 0 )
{
value >>= 4;
}
else
{
value = src[thisOffset++];
}
s.Append( HEXDIGITS[value & 0xf] );
}
}
else
{
for ( int ix = 0; ix < count; ix++ )
{
if ( ( ix % 2 ) != 0 )
{
value <<= 4;
}
else
{
value = src[thisOffset++];
}
s.Append( HEXDIGITS[value >> 4 & 0xf] );
}
}
 
interp.setVar( argv[arg++], TclString.newInstance( s.ToString() ), 0 );
 
offset += ( count + 1 ) / 2;
break;
}
 
case 'c':
case 's':
case 'S':
case 'i':
case 'I':
case 'f':
case 'd':
{
if ( arg >= argv.Length )
{
missingArg( interp );
}
switch ( cmd )
{
 
case 'c':
size = 1;
break;
 
case 's':
case 'S':
size = 2;
break;
 
case 'i':
case 'I':
size = 4;
break;
 
case 'f':
size = 4;
break;
 
case 'd':
size = 8;
break;
}
TclObject valueObj;
if ( count == BINARY_NOCOUNT )
{
if ( length - offset < size )
{
break;
}
valueObj = ScanNumber( src, offset, cmd );
offset += size;
}
else
{
if ( count == BINARY_ALL )
{
count = ( length - offset ) / size;
}
if ( length - offset < count * size )
{
break;
}
valueObj = TclList.newInstance();
int thisOffset = offset;
for ( int ix = 0; ix < count; ix++ )
{
TclList.append( null, valueObj, ScanNumber( src, thisOffset, cmd ) );
thisOffset += size;
}
offset += count * size;
}
 
interp.setVar( argv[arg++], valueObj, 0 );
 
break;
}
 
case 'x':
{
if ( count == BINARY_NOCOUNT )
{
count = 1;
}
if ( count == BINARY_ALL || count > length - offset )
{
offset = length;
}
else
{
offset += count;
}
break;
}
 
case 'X':
{
if ( count == BINARY_NOCOUNT )
{
count = 1;
}
if ( count == BINARY_ALL || count > offset )
{
offset = 0;
}
else
{
offset -= count;
}
break;
}
 
case '@':
{
if ( count == BINARY_NOCOUNT )
{
alephWithoutCount( interp );
}
if ( count == BINARY_ALL || count > length )
{
offset = length;
}
else
{
offset = count;
}
break;
}
 
default:
{
badField( interp, cmd );
}
break;
 
}
}
 
// Set the result to the last position of the cursor.
 
interp.setResult( arg - 4 );
}
break;
}
return TCL.CompletionCode.RETURN;
}
private char GetFormatSpec( char[] format, ref System.Int32 parsePos )
// Current position in input.
{
int ix = parsePos;
 
// Skip any leading blanks.
 
while ( ix < format.Length && format[ix] == ' ' )
{
ix++;
}
 
// The string was empty, except for whitespace, so fail.
 
if ( ix >= format.Length )
{
parsePos = ix;
return FORMAT_END;
}
 
// Extract the command character.
 
parsePos = ix + 1;
 
return format[ix++];
}
private int GetFormatCount( char[] format, ref System.Int32 parsePos )
// Current position in input.
{
int ix = parsePos;
 
// Extract any trailing digits or '*'.
 
if ( ix < format.Length && format[ix] == '*' )
{
parsePos = ix + 1;
return BINARY_ALL;
}
else if ( ix < format.Length && System.Char.IsDigit( format[ix] ) )
{
int length = 1;
while ( ix + length < format.Length && System.Char.IsDigit( format[ix + length] ) )
{
length++;
}
parsePos = ix + length;
return System.Int32.Parse( new string( format, ix, length ) );
}
else
{
return BINARY_NOCOUNT;
}
}
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;
}
private static TclObject ScanNumber( byte[] src, int pos, int type )
// Format character from "binary scan"
{
switch ( type )
{
 
case 'c':
{
return TclInteger.newInstance( (sbyte)src[pos] );
}
 
case 's':
{
short value = (short)( ( src[pos] & 0xff ) + ( ( src[pos + 1] & 0xff ) << 8 ) );
return TclInteger.newInstance( (int)value );
}
 
case 'S':
{
short value = (short)( ( src[pos + 1] & 0xff ) + ( ( src[pos] & 0xff ) << 8 ) );
return TclInteger.newInstance( (int)value );
}
 
case 'i':
{
int value = ( src[pos] & 0xff ) + ( ( src[pos + 1] & 0xff ) << 8 ) + ( ( src[pos + 2] & 0xff ) << 16 ) + ( ( src[pos + 3] & 0xff ) << 24 );
return TclInteger.newInstance( value );
}
case 'I':
{
int value = ( src[pos + 3] & 0xff ) + ( ( src[pos + 2] & 0xff ) << 8 ) + ( ( src[pos + 1] & 0xff ) << 16 ) + ( ( src[pos] & 0xff ) << 24 );
return TclInteger.newInstance( value );
}
case 'f':
{
MemoryStream ms = new MemoryStream( src, pos, 4, false );
BinaryReader reader = new BinaryReader( ms );
double fvalue = reader.ReadSingle();
reader.Close();
ms.Close();
return TclDouble.newInstance( fvalue );
}
case 'd':
{
MemoryStream ms = new MemoryStream( src, pos, 8, false );
BinaryReader reader = new BinaryReader( ms );
double dvalue = reader.ReadDouble();
reader.Close();
ms.Close();
return TclDouble.newInstance( dvalue );
}
}
return null;
}
 
/// <summary> Called whenever a format specifier was detected
/// but there are not enough arguments specified.
///
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method.
/// </param>
 
private static void missingArg( Interp interp )
{
throw new TclException( interp, "not enough arguments for all format specifiers" );
}
 
/// <summary> Called whenever an invalid format specifier was detected.
///
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method.
/// </param>
/// <param name="cmd"> - The invalid field specifier.
/// </param>
 
private static void badField( Interp interp, char cmd )
{
throw new TclException( interp, "bad field specifier \"" + cmd + "\"" );
}
 
/// <summary> Called whenever a letter aleph character (@) was detected
/// but there was no count specified.
///
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method.
/// </param>
 
private static void alephWithoutCount( Interp interp )
{
throw new TclException( interp, "missing count for \"@\" field specifier" );
}
 
/// <summary> Called whenever a format was found which restricts the valid range
/// of characters in the specified string, but the string contains
/// at least one char not in this range.
///
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method.
/// </param>
 
private static void expectedButGot( Interp interp, string expected, string str )
{
throw new TclException( interp, "expected " + expected + " string but got \"" + str + "\" instead" );
}
} // end BinaryCmd
}
/trunk/TCL/src/commands/BreakCmd.cs
@@ -0,0 +1,39 @@
/*
* BreakCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: BreakCmd.java,v 1.1.1.1 1998/10/14 21:09:18 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "break" command in Tcl.</summary>
 
class BreakCmd : Command
{
/// <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 );
}
}
}
/trunk/TCL/src/commands/CaseCmd.cs
@@ -0,0 +1,153 @@
/*
* CaseCmd.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: CaseCmd.java,v 1.2 1999/05/08 23:52:18 dejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "case" command in Tcl.</summary>
 
class CaseCmd : Command
{
/// <summary> Executes a "case" statement. See Tcl user
/// documentation for details.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="argv">command arguments.
/// </param>
/// <exception cref=""> TclException If incorrect number of arguments.
/// </exception>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
if ( argv.Length < 3 )
{
throw new TclNumArgsException( interp, 1, argv, "string ?in? patList body ... ?default body?" );
}
 
int i;
int body;
TclObject[] caseArgv;
string inString;
 
 
inString = argv[1].ToString();
caseArgv = argv;
body = -1;
 
 
if ( argv[2].ToString().Equals( "in" ) )
{
i = 3;
}
else
{
i = 2;
}
 
/*
* If all of the pattern/command pairs are lumped into a single
* argument, split them out again.
*/
 
if ( argv.Length - i == 1 )
{
caseArgv = TclList.getElements( interp, argv[i] );
i = 0;
}
 
{
for ( ; i < caseArgv.Length; i += 2 )
{
int j;
 
if ( i == ( caseArgv.Length - 1 ) )
{
throw new TclException( interp, "extra case pattern with no body" );
}
 
/*
* Check for special case of single pattern (no list) with
* no backslash sequences.
*/
 
 
string caseString = caseArgv[i].ToString();
int len = caseString.Length;
for ( j = 0; j < len; j++ )
{
char c = caseString[j];
if ( System.Char.IsWhiteSpace( c ) || ( c == '\\' ) )
{
break;
}
}
if ( j == len )
{
if ( caseString.Equals( "default" ) )
{
body = i + 1;
}
if ( Util.stringMatch( inString, caseString ) )
{
body = i + 1;
goto match_loop_brk;
}
continue;
}
 
/*
* Break up pattern lists, then check each of the patterns
* in the list.
*/
 
int numPats = TclList.getLength( interp, caseArgv[i] );
for ( j = 0; j < numPats; j++ )
{
 
if ( Util.stringMatch( inString, TclList.index( interp, caseArgv[i], j ).ToString() ) )
{
body = i + 1;
goto match_loop_brk;
}
}
}
}
 
match_loop_brk:
;
 
 
if ( body != -1 )
{
try
{
interp.eval( caseArgv[body], 0 );
}
catch ( TclException e )
{
if ( e.getCompletionCode() == TCL.CompletionCode.ERROR )
{
 
interp.addErrorInfo( "\n (\"" + caseArgv[body - 1] + "\" arm line " + interp.errorLine + ")" );
}
throw;
}
}
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/CatchCmd.cs
@@ -0,0 +1,73 @@
/*
* CatchCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: CatchCmd.java,v 1.2 2000/08/20 06:08:42 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "catch" command in Tcl.</summary>
 
class CatchCmd : Command
{
/// <summary> This procedure is invoked to process the "catch" 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 wrong number of arguments.
/// </exception>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
if ( argv.Length != 2 && argv.Length != 3 )
{
throw new TclNumArgsException( interp, 1, argv, "command ?varName?" );
}
 
TclObject result;
TCL.CompletionCode code = TCL.CompletionCode.OK;
 
try
{
interp.eval( argv[1], 0 );
}
catch ( TclException e )
{
code = e.getCompletionCode();
}
 
result = interp.getResult();
 
if ( argv.Length == 3 )
{
try
{
interp.setVar( argv[2], result, 0 );
}
catch ( TclException e )
{
throw new TclException( interp, "couldn't save command result in variable" );
}
}
 
interp.resetResult();
interp.setResult( TclInteger.newInstance( (int)code ) );
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/CdCmd.cs
@@ -0,0 +1,56 @@
/*
* CdCmd.java
*
* This file contains the Jacl implementation of the built-in Tcl "cd"
* command.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: CdCmd.java,v 1.2 1999/05/08 23:53:08 dejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
// This class implements the built-in "cd" command in Tcl.
 
class CdCmd : Command
{
 
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;
}
} // end CdCmd class
}
/trunk/TCL/src/commands/ClockCmd.cs
@@ -0,0 +1,1586 @@
#define DEBUG
/*
* ClockCmd.java --
*
* Implements the built-in "clock" Tcl command.
*
* Copyright (c) 1998-2000 Christian Krone.
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
* Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ClockCmd.java,v 1.6 2003/02/03 04:48:46 mdejong Exp $
*
*/
using System;
using System.Globalization;
using System.Text;
using System.Collections;
 
 
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "clock" command in Tcl.</summary>
 
class ClockCmd : Command
{
 
private static readonly string[] validCmds = new string[] { "clicks", "format", "scan", "seconds" };
 
private const int CMD_CLICKS = 0;
private const int CMD_FORMAT = 1;
private const int CMD_SCAN = 2;
private const int CMD_SECONDS = 3;
 
private static readonly string[] clicksOpts = new string[] { "-milliseconds" };
 
private const int OPT_CLICKS_MILLISECONDS = 0;
 
private static readonly string[] formatOpts = new string[] { "-format", "-gmt" };
 
private const int OPT_FORMAT_FORMAT = 0;
private const int OPT_FORMAT_GMT = 1;
 
private static readonly string[] scanOpts = new string[] { "-base", "-gmt" };
 
private const int OPT_SCAN_BASE = 0;
private const int OPT_SCAN_GMT = 1;
 
internal const int EPOCH_YEAR = 1970;
internal const int MILLIS_PER_HOUR = 60 * 60 * 1000;
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
int clockVal; // Time value as seconds of epoch.
string dateString; // Time value as string.
int argIx; // Counter over arguments.
string format = null; // User specified format string.
bool useGmt = false; // User specified flag to use gmt.
TclObject baseObj = null; // User specified raw value of baseClock.
System.DateTime baseClock; // User specified time value.
System.DateTime date; // Parsed date value.
 
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, objv, "option ?arg ...?" );
}
int cmd = TclIndex.get( interp, objv[1], validCmds, "option", 0 );
 
switch ( cmd )
{
 
case CMD_CLICKS:
{
if ( objv.Length > 3 )
{
throw new TclNumArgsException( interp, 2, objv, "?-milliseconds?" );
}
if ( objv.Length == 3 )
{
// We can safely ignore the -milliseconds options, since
// we measure the clicks in milliseconds anyway...
int clicksOpt = TclIndex.get( interp, objv[2], clicksOpts, "switch", 0 );
}
long millis = ( System.DateTime.Now.Ticks - 621355968000000000 ) / 10000;
int clicks = (int)( millis % System.Int32.MaxValue );
interp.setResult( clicks );
break;
}
 
 
case CMD_FORMAT:
{
if ( ( objv.Length < 3 ) || ( objv.Length > 7 ) )
{
throw new TclNumArgsException( interp, 2, objv, "clockval ?-format string? ?-gmt boolean?" );
}
clockVal = TclInteger.get( interp, objv[2] );
 
for ( argIx = 3; argIx + 1 < objv.Length; argIx += 2 )
{
int formatOpt = TclIndex.get( interp, objv[argIx], formatOpts, "switch", 0 );
switch ( formatOpt )
{
 
case OPT_FORMAT_FORMAT:
{
 
format = objv[argIx + 1].ToString();
break;
}
 
case OPT_FORMAT_GMT:
{
useGmt = TclBoolean.get( interp, objv[argIx + 1] );
break;
}
}
}
if ( argIx < objv.Length )
{
throw new TclNumArgsException( interp, 2, objv, "clockval ?-format string? ?-gmt boolean?" );
}
FormatClock( interp, clockVal, useGmt, format );
break;
}
 
 
case CMD_SCAN:
{
if ( ( objv.Length < 3 ) || ( objv.Length > 7 ) )
{
throw new TclNumArgsException( interp, 2, objv, "dateString ?-base clockValue? ?-gmt boolean?" );
}
 
dateString = objv[2].ToString();
 
for ( argIx = 3; argIx + 1 < objv.Length; argIx += 2 )
{
int scanOpt = TclIndex.get( interp, objv[argIx], scanOpts, "switch", 0 );
switch ( scanOpt )
{
 
case OPT_SCAN_BASE:
{
baseObj = objv[argIx + 1];
break;
}
 
case OPT_SCAN_GMT:
{
useGmt = TclBoolean.get( interp, objv[argIx + 1] );
break;
}
}
}
if ( argIx < objv.Length )
{
throw new TclNumArgsException( interp, 2, objv, "clockval ?-format string? ?-gmt boolean?" );
}
if ( baseObj != null )
{
long seconds = TclInteger.get( interp, baseObj );
baseClock = new System.DateTime( (long)seconds * 10000 * 1000 + 621355968000000000 );
}
else
{
baseClock = System.DateTime.Now;
}
try
{
date = GetDate( dateString, baseClock, useGmt );
}
catch ( FormatException )
{
throw new TclException( interp, "unable to convert date-time string \"" + dateString + "\"" );
}
long millis = ( date.Ticks - 621355968000000000 ) / 10000;
int seconds2 = (int)( millis / 1000 );
interp.setResult( seconds2 );
break;
}
 
 
case CMD_SECONDS:
{
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, objv, null );
}
long millis = ( System.DateTime.Now.Ticks - 621355968000000000 ) / 10000;
int seconds = (int)( millis / 1000 );
interp.setResult( seconds );
break;
}
}
return TCL.CompletionCode.RETURN;
}
private void FormatClock( Interp interp, int clockVal, bool useGMT, string format )
{
DateTime date = new DateTime( (long)clockVal * 10000 * 1000 + 621355968000000000 );
 
DateTimeFormatInfo formatInfo = new DateTimeFormatInfo();
string fmt, locFmt;
 
GregorianCalendar calendar = new GregorianCalendar();
 
System.Int32[] temp_int_array;
temp_int_array = new System.Int32[3];
temp_int_array[0] = 0;
temp_int_array[1] = 0;
temp_int_array[2] = 0;
System.Int32[] fp = temp_int_array;
StringBuilder result = new StringBuilder();
 
if ( (System.Object)format == null )
{
format = new StringBuilder( "%a %b %d %H:%M:%S %Z %Y" ).ToString();
}
 
if ( useGMT )
{
date = date.ToUniversalTime();
}
if ( format.Equals( "%Q" ) )
{
// Enterprise Stardate. (seems to be Star Track fan coding)
// ATK not tested
int trekYear = date.Year + 377 - 2323;
int trekDay = ( date.DayOfYear * 1000 ) / ( calendar.IsLeapYear( date.Year ) ? 366 : 365 );
int trekHour = ( 24 * 60 + date.Minute ) / 144;
 
interp.setResult( "Stardate " + ( trekYear < 10 ? "0" : "" ) + ( trekYear * 1000 + trekDay ) + '.' + trekHour );
return;
}
 
for ( int ix = 0; ix < format.Length; ix++ )
{
if ( format[ix] == '%' && ix + 1 < format.Length )
{
switch ( format[++ix] )
{
 
case '%':
result.Append( '%' );
break;
 
case 'a':
result.Append( date.ToString( "ddd", formatInfo ) );
break;
 
case 'A':
result.Append( date.ToString( "dddd", formatInfo ) );
break;
case 'b':
case 'h':
result.Append( date.ToString( "MMM", formatInfo ) );
break;
case 'B':
result.Append( date.ToString( "MMMM", formatInfo ) );
break;
case 'c':
result.Append( date.ToString() );
break;
case 'C':
int century = date.Year / 100;
result.Append( ( century < 10 ? "0" : "" ) + century );
break;
case 'd':
result.Append( date.ToString( "dd", formatInfo ) );
break;
case 'D':
result.Append( date.ToString( "MM/dd/yy", formatInfo ) );
break;
case 'e':
result.Append( date.ToString( "%d", formatInfo ) );
break;
case 'H':
result.Append( date.ToString( "HH", formatInfo ) );
break;
case 'I':
result.Append( date.ToString( "hh", formatInfo ) );
break;
case 'j':
result.Append( date.Year.ToString( "0###" ) );
break;
case 'k':
result.Append( date.ToString( "H", formatInfo ) );
break;
case 'l':
result.Append( date.ToString( "%h", formatInfo ) );
break;
case 'm':
// Month number (01 - 12).
result.Append( date.ToString( "MM", formatInfo ) );
break;
case 'M':
// Minute (00 - 59).
result.Append( date.ToString( "mm", formatInfo ) );
break;
case 'n':
// Insert a newline.
result.Append( '\n' );
break;
case 'p':
// AM/PM indicator.
result.Append( date.ToString( "tt", formatInfo ) );
break;
case 'r':
// %r
//Time in a locale-specific "meridian" format. The "meridian" format in the default "C" locale is "%I:%M:%S %p".
result.Append( date.ToString( "hh:mm:ss tt", formatInfo ) );
break;
case 'R':
//%R
//Time as %H:%M.
result.Append( date.ToString( "HH:MM", formatInfo ) );
break;
case 's':
//%s
//Count of seconds since the epoch, expressed as a decimal integer.
result.Append( ( date.Ticks / 1000 ).ToString() );
break;
 
case 'S':
//%S
//Seconds (00 - 59).
result.Append( date.ToString( "ss", formatInfo ) );
break;
case 't':
//%t
//Insert a tab.
result.Append( '\t' );
break;
 
case 'T':
//%T
//Time as %H:%M:%S.
result.Append( date.ToString( "HH:mm:ss", formatInfo ) );
break;
 
case 'u':
//%u
//Weekday number (Monday = 1, Sunday = 7).
if ( date.DayOfWeek == DayOfWeek.Sunday )
{
result.Append( "7" );
}
else
{
result.Append( ( (int)date.DayOfWeek ).ToString() );
}
break;
case 'U':
//%U
//Week of year (00 - 52), Sunday is the first day of the week.
int weekS = GetWeek( date, System.DayOfWeek.Sunday, false );
result.Append( ( weekS < 10 ? "0" : "" ) + weekS );
break;
 
case 'V':
//%V
//Week of year according to ISO-8601 rules. Week 1 of a given year is the week containing 4 January.
int isoWeek = GetWeek( date, System.DayOfWeek.Monday, true );
result.Append( ( isoWeek < 10 ? "0" : "" ) + isoWeek );
break;
 
case 'w':
//%w
//Weekday number (Sunday = 0, Saturday = 6).
result.Append( ( (int)date.DayOfWeek ).ToString() );
break;
 
case 'W':
//%W
//Week of year (00 - 52), Monday is the first day of the week.
int weekM = GetWeek( date, System.DayOfWeek.Monday, false );
result.Append( ( weekM < 10 ? "0" : "" ) + weekM );
break;
case 'x':
//%x
//Locale specific date format. The format for a date in the default "C" locale for Unix/Mac is "%m/%d/%y". On Windows, this value is the locale specific short date format, as specified in the Regional Options control panel settings.
result.Append( date.ToShortDateString() );
break;
 
case 'X':
//%X
//Locale specific 24-hour time format. The format for a 24-hour time in the default "C" locale for Unix/Mac is "%H:%M:%S". On Windows, this value is the locale specific time format, as specified in the Regional Options control panel settings.
result.Append( date.ToShortTimeString() );
break;
case 'y':
//%y
//Year without century (00 - 99).
result.Append( date.ToString( "yy", formatInfo ) );
break;
 
case 'Y':
//%Y
//Year with century (e.g. 1990)
result.Append( date.ToString( "yyyy", formatInfo ) );
break;
case 'Z':
//%Z
//Time zone name.
result.Append( date.ToString( "zzz", formatInfo ) );
break;
default:
result.Append( format[ix] );
break;
}
}
else
{
result.Append( format[ix] );
}
}
interp.setResult( result.ToString() );
}
private int GetWeek( DateTime date, System.DayOfWeek firstDayOfWeek, bool iso )
{
GregorianCalendar cal = new GregorianCalendar();
CalendarWeekRule weekRule = CalendarWeekRule.FirstFullWeek;
if ( iso )
{
firstDayOfWeek = System.DayOfWeek.Monday;
weekRule = CalendarWeekRule.FirstFourDayWeek;
}
return cal.GetWeekOfYear( date, weekRule, firstDayOfWeek );
}
private void SetWeekday( TclDateTime calendar, ClockRelTimespan diff )
// time difference to evaluate
{
int weekday = diff.getWeekday();
int dayOrdinal = diff.DayOrdinal;
 
// ATK
// while (SupportClass.CalendarManager.manager.Get(calendar, SupportClass.CalendarManager.DAY_OF_WEEK) != weekday)
// {
//
// calendar.add(SupportClass.CalendarManager.DATE, 1);
// }
// if (dayOrdinal > 1)
// {
//
// calendar.add(SupportClass.CalendarManager.DATE, 7 * (dayOrdinal - 1));
// }
}
private void SetOrdMonth( TclDateTime calendar, ClockRelTimespan diff )
// time difference to evaluate
{
int month = diff.Months;
int ordMonth = diff.OrdMonth;
 
// calendar.add(SupportClass.CalendarManager.MONTH, 1); /* we want to get the next month... */
// while (SupportClass.CalendarManager.manager.Get(calendar, SupportClass.CalendarManager.MONTH) != month)
// {
// calendar.add(SupportClass.CalendarManager.MONTH, 1);
// }
// if (ordMonth > 1)
// {
// calendar.add(SupportClass.CalendarManager.YEAR, ordMonth - 1);
// }
calendar.day = 1;
calendar.hour = 0;
calendar.minute = 0;
calendar.second = 0;
}
private System.DateTime GetDate( string dateString, System.DateTime baseDate, bool useGMT )
{
if ( useGMT )
{
baseDate = baseDate.ToUniversalTime();
}
TclDateTime calendar = new TclDateTime();
calendar.dateTime = baseDate;
calendar.hour = 0;
calendar.minute = 0;
calendar.second = 0;
calendar.millisecond = 0;
 
ClockToken[] dt = GetTokens( dateString, false );
 
System.Int32 parsePos = 0;
ClockRelTimespan diff = new ClockRelTimespan();
int hasTime = 0;
int hasZone = 0;
int hasDate = 0;
int hasDay = 0;
int hasOrdMonth = 0;
int hasRel = 0;
 
while ( parsePos < dt.Length )
{
if ( ParseTime( dt, ref parsePos, calendar ) )
{
hasTime++;
}
else if ( ParseZone( dt, ref parsePos, calendar ) )
{
hasZone++;
}
else if ( ParseIso( dt, ref parsePos, calendar ) )
{
hasDate++;
}
else if ( ParseDate( dt, ref parsePos, calendar ) )
{
hasDate++;
}
else if ( ParseDay( dt, ref parsePos, diff ) )
{
hasDay++;
}
else if ( ParseOrdMonth( dt, ref parsePos, diff ) )
{
hasOrdMonth++;
}
else if ( ParseRelSpec( dt, ref parsePos, diff ) )
{
hasRel++;
}
else if ( ParseNumber( dt, ref parsePos, calendar, hasDate > 0 && hasTime > 0 && hasRel == 0 ) )
{
if ( hasDate == 0 || hasTime == 0 || hasRel > 0 )
{
hasTime++;
}
}
else if ( ParseTrek( dt, ref parsePos, calendar ) )
{
hasDate++;
hasTime++;
}
else
{
goto failed;
}
}
 
if ( hasTime > 1 || hasZone > 1 || hasDate > 1 || hasDay > 1 || hasOrdMonth > 1 )
{
goto failed;
}
 
// The following line handles years that are specified using
// only two digits. The line of code below implements a policy
// defined by the X/Open workgroup on the millinium rollover.
// Note: some of those dates may not actually be valid on some
// platforms. The POSIX standard startes that the dates 70-99
// shall refer to 1970-1999 and 00-38 shall refer to 2000-2038.
// This later definition should work on all platforms.
 
int thisYear = calendar.year;
if ( thisYear < 100 )
{
if ( thisYear >= 69 )
{
calendar.year = thisYear + 1900;
}
else
{
calendar.year = thisYear + 2000;
}
}
 
if ( hasRel > 0 )
{
if ( hasTime == 0 && hasDate == 0 && hasDay == 0 )
{
calendar.dateTime = baseDate;
}
// Certain JDK implementations are buggy WRT DST.
// Work around this issue by adding a day instead
// of a days worth of seconds.
int seconds_in_day = ( 60 * 60 * 24 );
int seconds = diff.Seconds;
bool negative_seconds = ( seconds < 0 );
int days = 0;
if ( negative_seconds )
seconds *= ( -1 );
while ( seconds >= seconds_in_day )
{
seconds -= seconds_in_day;
days++;
}
if ( negative_seconds )
{
seconds *= ( -1 );
days *= ( -1 );
}
if ( days != 0 )
{
 
// calendar.add(SupportClass.CalendarManager.DATE, days);
}
if ( seconds != 0 )
{
 
// calendar.add(SupportClass.CalendarManager.SECOND, seconds);
}
 
// calendar.add(SupportClass.CalendarManager.MONTH, diff.Months);
}
 
if ( hasDay > 0 && hasDate == 0 )
{
SetWeekday( calendar, diff );
}
 
if ( hasOrdMonth > 0 )
{
SetOrdMonth( calendar, diff );
}
try
{
return calendar.dateTime;
}
catch ( Exception )
{
throw new FormatException();
}
failed:
throw new FormatException();
}
private bool ParseTime( ClockToken[] dt, ref System.Int32 parsePos, TclDateTime calendar )
// calendar object to set
{
int pos = parsePos;
 
if ( pos + 6 < dt.Length && dt[pos].UNumber && dt[pos + 1].is_Renamed( ':' ) && dt[pos + 2].UNumber && dt[pos + 3].is_Renamed( ':' ) && dt[pos + 4].UNumber && dt[pos + 5].is_Renamed( '-' ) && dt[pos + 6].UNumber )
{
ClockToken zone = GetTimeZoneFromRawOffset( ( -dt[pos + 6].Int ) / 100 );
if ( zone != null )
{
calendar.hour = dt[pos].Int;
calendar.minute = dt[pos + 2].Int;
calendar.second = dt[pos + 4].Int;
// TODO
// calendar.setTimeZone(zone.Zone);
parsePos = pos + 7;
return true;
}
}
if ( pos + 4 < dt.Length && dt[pos].UNumber && dt[pos + 1].is_Renamed( ':' ) && dt[pos + 2].UNumber && dt[pos + 3].is_Renamed( ':' ) && dt[pos + 4].UNumber )
{
parsePos = pos + 5;
ParseMeridianAndSetHour( dt, ref parsePos, calendar, dt[pos].Int );
calendar.minute = dt[pos + 2].Int;
calendar.second = dt[pos + 4].Int;
return true;
}
if ( pos + 4 < dt.Length && dt[pos].UNumber && dt[pos + 1].is_Renamed( ':' ) && dt[pos + 2].UNumber && dt[pos + 3].is_Renamed( '-' ) && dt[pos + 4].UNumber )
{
ClockToken zone = GetTimeZoneFromRawOffset( ( -dt[pos + 4].Int ) / 100 );
if ( zone != null )
{
calendar.hour = dt[pos].Int;
calendar.minute = dt[pos + 2].Int;
 
// calendar.setTimeZone(zone.Zone);
parsePos = pos + 5;
return true;
}
}
if ( pos + 2 < dt.Length && dt[pos].UNumber && dt[pos + 1].is_Renamed( ':' ) && dt[pos + 2].UNumber )
{
parsePos = pos + 3;
ParseMeridianAndSetHour( dt, ref parsePos, calendar, dt[pos].Int );
calendar.minute = dt[pos + 2].Int;
return true;
}
if ( pos + 1 < dt.Length && dt[pos].UNumber && dt[pos + 1].is_Renamed( ClockToken.MERIDIAN ) )
{
parsePos = pos + 1;
ParseMeridianAndSetHour( dt, ref parsePos, calendar, dt[pos].Int );
return true;
}
return false;
}
private bool ParseZone( ClockToken[] dt, ref System.Int32 parsePos, TclDateTime calendar )
// calendar object to set
{
int pos = parsePos;
 
if ( pos + 1 < dt.Length && dt[pos].is_Renamed( ClockToken.ZONE ) && dt[pos + 1].is_Renamed( ClockToken.DST ) )
{
 
// calendar.setTimeZone(dt[pos].Zone);
parsePos = pos + 2;
return true;
}
if ( pos < dt.Length && dt[pos].is_Renamed( ClockToken.ZONE ) )
{
 
// calendar.setTimeZone(dt[pos].Zone);
parsePos = pos + 1;
return true;
}
if ( pos < dt.Length && dt[pos].is_Renamed( ClockToken.DAYZONE ) )
{
 
// calendar.setTimeZone(dt[pos].Zone);
parsePos = pos + 1;
return true;
}
return false;
}
private bool ParseDay( ClockToken[] dt, ref System.Int32 parsePos, ClockRelTimespan diff )
// time difference to evaluate
{
int pos = parsePos;
 
if ( pos + 2 < dt.Length && dt[pos].is_Renamed( '+' ) && dt[pos + 1].UNumber && dt[pos + 2].is_Renamed( ClockToken.DAY ) )
{
diff.setWeekday( dt[pos + 2].Int, dt[pos + 1].Int );
parsePos = pos + 3;
return true;
}
if ( pos + 2 < dt.Length && dt[pos].is_Renamed( '-' ) && dt[pos + 1].UNumber && dt[pos + 2].is_Renamed( ClockToken.DAY ) )
{
diff.setWeekday( dt[pos + 2].Int, -dt[pos + 1].Int );
parsePos = pos + 3;
return true;
}
if ( pos + 1 < dt.Length && dt[pos].is_Renamed( ClockToken.NEXT ) && dt[pos + 1].is_Renamed( ClockToken.DAY ) )
{
diff.setWeekday( dt[pos + 1].Int, 2 );
parsePos = pos + 2;
return true;
}
if ( pos + 1 < dt.Length && dt[pos].is_Renamed( ClockToken.DAY ) && dt[pos + 1].is_Renamed( ',' ) )
{
diff.setWeekday( dt[pos].Int );
parsePos = pos + 2;
return true;
}
if ( pos + 1 < dt.Length && dt[pos].UNumber && dt[pos + 1].is_Renamed( ClockToken.DAY ) )
{
diff.setWeekday( dt[pos + 1].Int, dt[pos].Int );
parsePos = pos + 2;
return true;
}
if ( pos < dt.Length && dt[pos].is_Renamed( ClockToken.DAY ) )
{
diff.setWeekday( dt[pos].Int );
parsePos = pos + 1;
return true;
}
return false;
}
private bool ParseDate( ClockToken[] dt, ref System.Int32 parsePos, TclDateTime calendar )
// calendar object to set
{
int pos = parsePos;
 
if ( pos + 4 < dt.Length && dt[pos].UNumber && dt[pos + 1].is_Renamed( '/' ) && dt[pos + 2].UNumber && dt[pos + 3].is_Renamed( '/' ) && dt[pos + 4].UNumber )
{
calendar.day = dt[pos + 2].Int;
calendar.month = dt[pos].Int;
calendar.year = dt[pos + 4].Int;
parsePos = pos + 5;
return true;
}
if ( pos + 4 < dt.Length && dt[pos].UNumber && dt[pos + 1].is_Renamed( '-' ) && dt[pos + 2].is_Renamed( ClockToken.MONTH ) && dt[pos + 3].is_Renamed( '-' ) && dt[pos + 4].UNumber )
{
calendar.year = dt[pos + 4].Int;
calendar.month = dt[pos + 2].Int;
calendar.day = dt[pos].Int;
parsePos = pos + 5;
return true;
}
if ( pos + 4 < dt.Length && dt[pos].UNumber && dt[pos + 1].is_Renamed( '-' ) && dt[pos + 2].UNumber && dt[pos + 3].is_Renamed( '-' ) && dt[pos + 4].UNumber )
{
calendar.year = dt[pos].Int;
calendar.month = dt[pos + 2].Int;
calendar.day = dt[pos + 4].Int;
parsePos = pos + 5;
return true;
}
if ( pos + 3 < dt.Length && dt[pos].is_Renamed( ClockToken.MONTH ) && dt[pos + 1].UNumber && dt[pos + 2].is_Renamed( ',' ) && dt[pos + 3].UNumber )
{
calendar.day = dt[pos + 1].Int;
calendar.month = dt[pos].Int;
calendar.year = dt[pos + 3].Int;
parsePos = pos + 4;
return true;
}
if ( pos + 2 < dt.Length && dt[pos].UNumber && dt[pos + 1].is_Renamed( '/' ) && dt[pos + 2].UNumber )
{
calendar.day = dt[pos + 2].Int;
calendar.month = dt[pos].Int;
parsePos = pos + 3;
return true;
}
if ( pos + 2 < dt.Length && dt[pos].UNumber && dt[pos + 1].is_Renamed( ClockToken.MONTH ) && dt[pos + 2].UNumber )
{
calendar.day = dt[pos].Int;
calendar.month = dt[pos + 1].Int;
calendar.year = dt[pos + 2].Int;
parsePos = pos + 3;
return true;
}
if ( pos + 1 < dt.Length && dt[pos].is_Renamed( ClockToken.MONTH ) && dt[pos + 1].UNumber )
{
calendar.day = dt[pos + 1].Int;
calendar.month = dt[pos].Int;
parsePos = pos + 2;
return true;
}
if ( pos + 1 < dt.Length && dt[pos].UNumber && dt[pos + 1].is_Renamed( ClockToken.MONTH ) )
{
calendar.day = dt[pos].Int;
calendar.month = dt[pos + 1].Int;
parsePos = pos + 2;
return true;
}
if ( pos < dt.Length && dt[pos].IsoBase )
{
calendar.day = dt[pos].Int % 100;
calendar.month = ( dt[pos].Int % 10000 ) / 100;
calendar.year = dt[pos].Int / 10000;
parsePos = pos + 1;
return true;
}
if ( pos < dt.Length && dt[pos].is_Renamed( ClockToken.EPOCH ) )
{
calendar.day = 1;
calendar.month = 0;
calendar.year = EPOCH_YEAR;
parsePos = pos + 1;
return true;
}
return false;
}
private bool ParseNumber( ClockToken[] dt, ref System.Int32 parsePos, TclDateTime calendar, bool mayBeYear )
// number is considered to be year?
{
int pos = parsePos;
 
if ( pos < dt.Length && dt[pos].UNumber )
{
parsePos = pos + 1;
if ( mayBeYear )
{
calendar.year = dt[pos].Int;
}
else
{
calendar.hour = dt[pos].Int / 100;
calendar.minute = dt[pos].Int % 100;
calendar.second = 0;
}
return true;
}
return false;
}
private bool ParseRelSpec( ClockToken[] dt, ref System.Int32 parsePos, ClockRelTimespan diff )
// time difference to evaluate
{
if ( !ParseRelUnits( dt, ref parsePos, diff ) )
{
return false;
}
 
int pos = parsePos;
if ( pos < dt.Length && dt[pos].is_Renamed( ClockToken.AGO ) )
{
diff.negate();
parsePos = pos + 1;
}
return true;
}
private bool ParseRelUnits( ClockToken[] dt, ref System.Int32 parsePos, ClockRelTimespan diff )
// time difference to evaluate
{
int pos = parsePos;
 
if ( pos + 2 < dt.Length && dt[pos].is_Renamed( '+' ) && dt[pos + 1].UNumber && dt[pos + 2].Unit )
{
diff.addUnit( dt[pos + 2], dt[pos + 1].Int );
parsePos = pos + 3;
return true;
}
if ( pos + 2 < dt.Length && dt[pos].is_Renamed( '-' ) && dt[pos + 1].UNumber && dt[pos + 2].Unit )
{
diff.addUnit( dt[pos + 2], -dt[pos + 1].Int );
parsePos = pos + 3;
return true;
}
if ( pos + 1 < dt.Length && dt[pos].UNumber && dt[pos + 1].Unit )
{
diff.addUnit( dt[pos + 1], dt[pos].Int );
parsePos = pos + 2;
return true;
}
else if ( pos + 2 < dt.Length && dt[pos].is_Renamed( ClockToken.NEXT ) && dt[pos + 1].UNumber && dt[pos + 2].Unit )
{
diff.addUnit( dt[pos + 2], dt[pos + 1].Int );
parsePos = pos + 3;
return true;
}
if ( pos + 1 < dt.Length && dt[pos].is_Renamed( ClockToken.NEXT ) && dt[pos + 1].Unit )
{
diff.addUnit( dt[pos + 1] );
parsePos = pos + 2;
return true;
}
if ( pos < dt.Length && dt[pos].Unit )
{
diff.addUnit( dt[pos] );
parsePos = pos + 1;
return true;
}
return false;
}
private bool ParseOrdMonth( ClockToken[] dt, ref System.Int32 parsePos, ClockRelTimespan diff )
// time difference to evaluate
{
int pos = parsePos;
 
if ( pos + 2 < dt.Length && dt[pos].is_Renamed( ClockToken.NEXT ) && dt[pos + 1].UNumber && dt[pos + 2].is_Renamed( ClockToken.MONTH ) )
{
diff.addOrdMonth( dt[pos + 2].Int, dt[pos + 1].Int );
parsePos = pos + 3;
return true;
}
if ( pos + 1 < dt.Length && dt[pos].is_Renamed( ClockToken.NEXT ) && dt[pos + 1].is_Renamed( ClockToken.MONTH ) )
{
diff.addOrdMonth( dt[pos + 1].Int, 1 );
parsePos = pos + 2;
return true;
}
return false;
}
private bool ParseIso( ClockToken[] dt, ref System.Int32 parsePos, TclDateTime calendar )
// calendar object to set
{
int pos = parsePos;
 
if ( pos + 6 < dt.Length && dt[pos].IsoBase && dt[pos + 1].is_Renamed( ClockToken.ZONE ) && dt[pos + 2].UNumber && dt[pos + 3].is_Renamed( ':' ) && dt[pos + 4].UNumber && dt[pos + 5].is_Renamed( ':' ) && dt[pos + 6].UNumber )
{
calendar.day = dt[pos].Int % 100;
calendar.month = ( dt[pos].Int % 10000 ) / 100;
calendar.year = dt[pos].Int / 10000;
calendar.hour = dt[pos + 2].Int;
calendar.minute = dt[pos + 4].Int;
calendar.second = dt[pos + 6].Int;
parsePos = pos + 7;
return true;
}
if ( pos + 2 < dt.Length && dt[pos].IsoBase && dt[pos + 1].is_Renamed( ClockToken.ZONE ) && dt[pos + 1].Zone.GetUtcOffset( calendar.dateTime ).Hours == ( -7 ) * MILLIS_PER_HOUR && dt[pos + 2].IsoBase )
{
calendar.day = dt[pos].Int % 100;
calendar.month = ( dt[pos].Int % 10000 ) / 100;
calendar.year = dt[pos].Int / 10000;
calendar.hour = dt[pos + 2].Int / 10000;
calendar.minute = ( dt[pos + 2].Int % 10000 ) / 100;
calendar.second = dt[pos + 2].Int % 100;
parsePos = pos + 3;
return true;
}
if ( pos + 1 < dt.Length && dt[pos].IsoBase && dt[pos + 1].IsoBase )
{
calendar.day = dt[pos].Int % 100;
calendar.month = ( dt[pos].Int % 10000 ) / 100;
calendar.year = dt[pos].Int / 10000;
calendar.hour = dt[pos + 1].Int / 10000;
calendar.minute = ( dt[pos + 1].Int % 10000 ) / 100;
calendar.second = dt[pos + 1].Int % 100;
parsePos = pos + 2;
return true;
}
return false;
}
private bool ParseTrek( ClockToken[] dt, ref System.Int32 parsePos, TclDateTime calendar )
// calendar object to set
{
int pos = parsePos;
 
if ( pos + 3 < dt.Length && dt[pos].is_Renamed( ClockToken.STARDATE ) && dt[pos + 1].UNumber && dt[pos + 2].is_Renamed( '.' ) && dt[pos + 3].UNumber )
{
GregorianCalendar gcal = new GregorianCalendar();
int trekYear = dt[pos + 1].Int / 1000 + 2323 - 377;
int trekDay = 1 + ( ( dt[pos + 1].Int % 1000 ) * ( gcal.IsLeapYear( trekYear ) ? 366 : 365 ) ) / 1000;
int trekSeconds = dt[pos + 3].Int * 144 * 60;
calendar.year = trekYear;
calendar.dateTime = gcal.AddDays( calendar.dateTime, trekDay );
calendar.second = trekSeconds;
parsePos = pos + 4;
return true;
}
return false;
}
private void ParseMeridianAndSetHour( ClockToken[] dt, ref System.Int32 parsePos, TclDateTime calendar, int hour )
// hour value (1-12 or 0-23) to set.
{
int pos = parsePos;
int hourField;
 
if ( pos < dt.Length && dt[pos].is_Renamed( ClockToken.MERIDIAN ) )
{
// SupportClass.CalendarManager.manager.Set(calendar, SupportClass.CalendarManager.AM_PM, dt[pos].Int);
parsePos = pos + 1;
hourField = SupportClass.CalendarManager.HOUR;
}
else
{
hourField = SupportClass.CalendarManager.HOUR_OF_DAY;
}
 
if ( hourField == SupportClass.CalendarManager.HOUR && hour == 12 )
{
hour = 0;
}
calendar.hour = hour;
}
private ClockToken[] GetTokens( string in_Renamed, bool debug )
// Send the generated token list to stderr?
{
System.Int32 parsePos = 0;
ClockToken dt;
ArrayList tokenVector = new ArrayList( in_Renamed.Length );
 
while ( ( dt = GetNextToken( in_Renamed, ref parsePos ) ) != null )
{
tokenVector.Add( dt );
}
 
ClockToken[] tokenArray = new ClockToken[tokenVector.Count];
tokenVector.CopyTo( tokenArray );
 
#if DEBUG
for ( int ix = 0; ix < tokenArray.Length; ix++ )
{
if ( ix != 0 )
{
System.Console.Error.Write( "," );
}
 
System.Console.Error.Write( tokenArray[ix].ToString() );
}
System.Console.Error.WriteLine( "" );
#endif
 
return tokenArray;
}
private ClockToken GetNextToken( string in_Renamed, ref System.Int32 parsePos )
// Current position in input
{
int pos = parsePos;
int sign;
 
while ( true )
{
while ( pos < in_Renamed.Length && ( System.Char.GetUnicodeCategory( in_Renamed[pos] ) == System.Globalization.UnicodeCategory.SpaceSeparator ) )
{
pos++;
}
if ( pos >= in_Renamed.Length )
{
break;
}
 
char c = in_Renamed[pos];
if ( System.Char.IsDigit( c ) )
{
int number = 0;
int count = 0;
while ( pos < in_Renamed.Length && System.Char.IsDigit( c = in_Renamed[pos] ) )
{
number = 10 * number + c - '0';
pos++;
count++;
}
parsePos = pos;
return new ClockToken( number, count >= 6 );
}
if ( System.Char.IsLetter( c ) )
{
int beginPos = pos;
while ( ++pos < in_Renamed.Length )
{
c = in_Renamed[pos];
if ( !System.Char.IsLetter( c ) && c != '.' )
{
break;
}
}
parsePos = pos;
return LookupWord( in_Renamed.Substring( beginPos, ( pos ) - ( beginPos ) ) );
}
parsePos = pos + 1;
return new ClockToken( in_Renamed[pos] );
}
parsePos = pos + 1;
return null;
}
private ClockToken LookupWord( string word )
// word to lookup
{
int ix;
string[] names;
string[][] zones;
 
if ( word.ToUpper().Equals( "am".ToUpper() ) || word.ToUpper().Equals( "a.m.".ToUpper() ) )
{
return new ClockToken( ClockToken.MERIDIAN, SupportClass.CalendarManager.AM );
}
if ( word.ToUpper().Equals( "pm".ToUpper() ) || word.ToUpper().Equals( "p.m.".ToUpper() ) )
{
return new ClockToken( ClockToken.MERIDIAN, SupportClass.CalendarManager.PM );
}
 
// See if we have an abbreviation for a day or month.
 
bool abbrev;
if ( word.Length == 3 )
{
abbrev = true;
}
else if ( word.Length == 4 && word[3] == '.' )
{
abbrev = true;
word = word.Substring( 0, ( 3 ) - ( 0 ) );
}
else
{
abbrev = false;
}
 
 
DateTimeFormatInfo symbols = new CultureInfo( "en-US" ).DateTimeFormat;
if ( abbrev )
{
names = symbols.AbbreviatedMonthNames;
}
else
{
names = (string[])symbols.MonthNames;
}
for ( ix = 0; ix < names.Length; ix++ )
{
if ( word.ToUpper().Equals( names[ix].ToUpper() ) )
{
return new ClockToken( ClockToken.MONTH, ix + 1 );
}
}
if ( abbrev )
{
names = symbols.AbbreviatedDayNames;
}
else
{
names = symbols.DayNames;
}
for ( ix = 0; ix < names.Length; ix++ )
{
if ( word.ToUpper().Equals( names[ix].ToUpper() ) )
{
return new ClockToken( ClockToken.DAY, ix );
}
}
 
// Drop out any periods and try the timezone table.
 
StringBuilder withoutDotsBuf = new StringBuilder( word.Length );
for ( ix = 0; ix < word.Length; ix++ )
{
if ( word[ix] != '.' )
{
withoutDotsBuf.Append( word[ix] );
}
}
 
string withoutDots = new string( withoutDotsBuf.ToString().ToCharArray() );
 
// zones = symbols.getZoneStrings();
 
// for (ix = 0; ix < zones.Length; ix++)
// {
// if (withoutDots.ToUpper().Equals(zones[ix][2].ToUpper()) || withoutDots.ToUpper().Equals(zones[ix][4].ToUpper()))
// {
//
// System.TimeZone zone = TimeZone.getTimeZone(zones[ix][0]);
// return new ClockToken(ClockToken.ZONE, zone);
// }
// }
if ( withoutDots.ToUpper().Equals( "dst".ToUpper() ) )
{
return new ClockToken( ClockToken.DST, null );
}
 
// Strip off any plural and try the units.
 
string singular;
if ( word.EndsWith( "s" ) )
{
singular = word.Substring( 0, ( word.Length - 1 ) - ( 0 ) );
}
else
{
singular = word;
}
if ( singular.ToUpper().Equals( "year".ToUpper() ) )
{
return new ClockToken( ClockToken.MONTH_UNIT, 12 );
}
else if ( singular.ToUpper().Equals( "month".ToUpper() ) )
{
return new ClockToken( ClockToken.MONTH_UNIT, 1 );
}
else if ( singular.ToUpper().Equals( "fortnight".ToUpper() ) )
{
return new ClockToken( ClockToken.MINUTE_UNIT, 14 * 24 * 60 );
}
else if ( singular.ToUpper().Equals( "week".ToUpper() ) )
{
return new ClockToken( ClockToken.MINUTE_UNIT, 7 * 24 * 60 );
}
else if ( singular.ToUpper().Equals( "day".ToUpper() ) )
{
return new ClockToken( ClockToken.MINUTE_UNIT, 24 * 60 );
}
else if ( singular.ToUpper().Equals( "hour".ToUpper() ) )
{
return new ClockToken( ClockToken.MINUTE_UNIT, 60 );
}
else if ( singular.ToUpper().Equals( "minute".ToUpper() ) )
{
return new ClockToken( ClockToken.MINUTE_UNIT, 1 );
}
else if ( singular.ToUpper().Equals( "min".ToUpper() ) )
{
return new ClockToken( ClockToken.MINUTE_UNIT, 1 );
}
else if ( singular.ToUpper().Equals( "second".ToUpper() ) )
{
return new ClockToken( ClockToken.SEC_UNIT, 1 );
}
else if ( singular.ToUpper().Equals( "sec".ToUpper() ) )
{
return new ClockToken( ClockToken.SEC_UNIT, 1 );
}
 
if ( singular.ToUpper().Equals( "tomorrow".ToUpper() ) )
{
return new ClockToken( ClockToken.MINUTE_UNIT, 1 * 24 * 60 );
}
else if ( singular.ToUpper().Equals( "yesterday".ToUpper() ) )
{
return new ClockToken( ClockToken.MINUTE_UNIT, ( -1 ) * 24 * 60 );
}
else if ( singular.ToUpper().Equals( "today".ToUpper() ) )
{
return new ClockToken( ClockToken.MINUTE_UNIT, 0 );
}
else if ( singular.ToUpper().Equals( "now".ToUpper() ) )
{
return new ClockToken( ClockToken.MINUTE_UNIT, 0 );
}
else if ( singular.ToUpper().Equals( "last".ToUpper() ) )
{
return new ClockToken( -1, false );
}
else if ( singular.ToUpper().Equals( "this".ToUpper() ) )
{
return new ClockToken( ClockToken.MINUTE_UNIT, 0 );
}
else if ( singular.ToUpper().Equals( "next".ToUpper() ) )
{
return new ClockToken( ClockToken.NEXT, 1 );
}
else if ( singular.ToUpper().Equals( "ago".ToUpper() ) )
{
return new ClockToken( ClockToken.AGO, 1 );
}
else if ( singular.ToUpper().Equals( "epoch".ToUpper() ) )
{
return new ClockToken( ClockToken.EPOCH, 0 );
}
else if ( singular.ToUpper().Equals( "stardate".ToUpper() ) )
{
return new ClockToken( ClockToken.STARDATE, 0 );
}
 
// Since a military timezone (T) is used in the clock test of 8.3,
// we can't ignore these timezones any longer...
 
if ( withoutDots.Length == 1 )
{
int rawOffset = 0;
bool found = true;
char milTz = System.Char.ToLower( withoutDots[0] );
 
if ( milTz >= 'a' && milTz <= 'm' )
{
rawOffset = milTz - 'a' + 1;
}
else if ( milTz >= 'n' && milTz < 'z' )
{
rawOffset = 'n' - milTz - 1;
}
else if ( milTz != 'z' )
{
found = false;
}
if ( found )
{
ClockToken zone = GetTimeZoneFromRawOffset( rawOffset );
if ( zone != null )
{
return zone;
}
}
}
 
return new ClockToken( word );
}
private ClockToken GetTimeZoneFromRawOffset( int rawOffset )
{
 
// string[] tzNames = TimeZone.getAvailableIDs(rawOffset * MILLIS_PER_HOUR);
 
// if (tzNames.Length > 0)
// {
//
// System.TimeZone zone = TimeZone.getTimeZone(tzNames[0]);
// return new ClockToken(ClockToken.ZONE, zone);
// }
return null;
}
} // end ClockCmd
class ClockToken
{
public bool UNumber
{
get
{
return kind == UNUMBER;
}
 
}
public bool IsoBase
{
get
{
return kind == ISOBASE;
}
 
}
public bool Unit
{
get
{
return kind == MINUTE_UNIT || kind == MONTH_UNIT || kind == SEC_UNIT;
}
 
}
internal int Int
{
get
{
return number;
}
 
}
internal System.TimeZone Zone
{
get
{
return zone;
}
 
}
internal const int ISOBASE = 1;
internal const int UNUMBER = 2;
internal const int WORD = 3;
internal const int CHAR = 4;
internal const int MONTH = 5;
internal const int DAY = 6;
internal const int MONTH_UNIT = 7;
internal const int MINUTE_UNIT = 8;
internal const int SEC_UNIT = 9;
internal const int AGO = 10;
internal const int EPOCH = 11;
internal const int ZONE = 12;
internal const int DAYZONE = 13;
internal const int DST = 14;
internal const int MERIDIAN = 15;
internal const int NEXT = 16;
internal const int STARDATE = 17;
 
internal ClockToken( int number, bool isIsoBase )
{
this.kind = isIsoBase ? ISOBASE : UNUMBER;
this.number = number;
}
internal ClockToken( int kind, int number )
{
this.kind = kind;
this.number = number;
}
internal ClockToken( int kind, System.TimeZone zone )
{
this.kind = kind;
this.zone = zone;
}
internal ClockToken( string word )
{
this.kind = WORD;
this.word = word;
}
internal ClockToken( char c )
{
this.kind = CHAR;
this.c = c;
}
public bool is_Renamed( char c )
{
return this.kind == CHAR && this.c == c;
}
public bool is_Renamed( int kind )
{
return this.kind == kind;
}
 
public override string ToString()
{
if ( UNumber )
{
return "U" + System.Convert.ToString( Int );
}
else if ( IsoBase )
{
return "I" + System.Convert.ToString( Int );
}
else if ( kind == WORD )
{
return word;
}
else if ( kind == CHAR )
{
return c.ToString();
}
else if ( kind == ZONE || kind == DAYZONE )
{
return zone.StandardName;
}
else
{
return "(" + kind + "," + Int + ")";
}
}
 
private int kind;
private int number;
private string word;
private char c;
private System.TimeZone zone;
} // end ClockToken
class ClockRelTimespan
{
internal int Seconds
{
get
{
return seconds;
}
 
}
internal int Months
{
get
{
return months;
}
 
}
internal int OrdMonth
{
get
{
return ordMonth;
}
 
}
internal int DayOrdinal
{
get
{
return dayOrdinal;
}
 
}
internal ClockRelTimespan()
{
seconds = 0;
months = 0;
ordMonth = 0;
weekday = 0;
dayOrdinal = 0;
}
internal void addSeconds( int s )
{
seconds += s;
}
internal void addMonths( int m )
{
months += m;
}
internal void addOrdMonth( int m, int c )
{
months = m;
ordMonth += c;
}
internal void addUnit( ClockToken unit, int amount )
{
if ( unit.is_Renamed( ClockToken.SEC_UNIT ) )
{
addSeconds( unit.Int * amount );
}
else if ( unit.is_Renamed( ClockToken.MINUTE_UNIT ) )
{
addSeconds( unit.Int * 60 * amount );
}
else if ( unit.is_Renamed( ClockToken.MONTH_UNIT ) )
{
addMonths( unit.Int * amount );
}
}
internal void addUnit( ClockToken unit )
{
addUnit( unit, 1 );
}
internal void setWeekday( int w, int ord )
{
weekday = w;
dayOrdinal = ord;
}
internal void setWeekday( int w )
{
setWeekday( w, 1 );
}
internal void negate()
{
seconds = -seconds;
months = -months;
}
internal int getWeekday()
{
return weekday;
}
private int seconds;
private int months;
private int ordMonth;
private int weekday;
private int dayOrdinal;
}
class TclDateTime
{
public int year, month, day, hour, minute, second, millisecond;
public DateTime dateTime
{
get
{
return new DateTime( year, month, day, hour, minute, second, millisecond );
}
set
{
DateTime dt = value;
year = dt.Year;
month = dt.Month;
day = dt.Day;
hour = dt.Hour;
minute = dt.Minute;
second = dt.Second;
millisecond = dt.Millisecond;
}
}
}
}
/trunk/TCL/src/commands/CloseCmd.cs
@@ -0,0 +1,54 @@
/*
* CloseCmd.java --
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: CloseCmd.java,v 1.2 2000/08/01 06:50:48 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "close" command in Tcl.</summary>
 
class CloseCmd : Command
{
/// <summary> This procedure is invoked to process the "close" 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() + "\"" );
}
 
TclIO.unregisterChannel( interp, chan );
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/ConcatCmd.cs
@@ -0,0 +1,31 @@
/*
* ConcatCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ConcatCmd.java,v 1.1.1.1 1998/10/14 21:09:18 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "concat" command in Tcl.</summary>
class ConcatCmd : Command
{
 
/// <summary> See Tcl user documentation for details.</summary>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
interp.setResult( Util.concat( 1, argv.Length, argv ) );
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/ContinueCmd.cs
@@ -0,0 +1,39 @@
/*
* ContinueCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ContinueCmd.java,v 1.1.1.1 1998/10/14 21:09:20 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "continue" command in Tcl.</summary>
 
class ContinueCmd : Command
{
/// <summary> This procedure is invoked to process the "continue" 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.CONTINUE );
}
}
}
/trunk/TCL/src/commands/EncodingCmd.cs
@@ -0,0 +1,201 @@
/*
* EncodingCmd.java --
*
* Copyright (c) 2001 Bruce A. Johnson
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: EncodingCmd.java,v 1.2 2002/04/12 15:32:44 mdejong Exp $
*
*/
using System;
using System.Text;
using System.Collections;
using System.IO;
 
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "encoding" command in Tcl.</summary>
 
class EncodingCmd : Command
{
// FIXME: Make sure this is a global property and not a per-interp
// property!
internal static string systemTclEncoding = "utf-8";
internal static Encoding systemJavaEncoding = UTF8Encoding.UTF8;
 
internal static string[] tclNames = new string[] { "utf-8", "unicode", "ascii", "utf-7" };
 
internal static readonly Encoding[] encodings = new Encoding[] { UTF8Encoding.UTF8, UnicodeEncoding.Unicode, ASCIIEncoding.Unicode, UTF7Encoding.UTF7 };
 
internal static int[] bytesPerChar = new int[] { 1, 2, 1, 1 };
 
private static readonly string[] validCmds = new string[] { "convertfrom", "convertto", "names", "system" };
 
internal const int OPT_CONVERTFROM = 0;
internal const int OPT_CONVERTTO = 1;
internal const int OPT_NAMES = 2;
internal const int OPT_SYSTEM = 3;
 
/// <summary> This procedure is invoked to process the "encoding" 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 )
{
if ( argv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, argv, "option ?arg ...?" );
}
 
int index = TclIndex.get( interp, argv[1], validCmds, "option", 0 );
 
switch ( index )
{
 
case OPT_CONVERTTO:
case OPT_CONVERTFROM:
{
string tclEncoding;
Encoding javaEncoding;
TclObject data;
 
if ( argv.Length == 3 )
{
tclEncoding = systemTclEncoding;
data = argv[2];
}
else if ( argv.Length == 4 )
{
 
tclEncoding = argv[2].ToString();
data = argv[3];
}
else
{
throw new TclNumArgsException( interp, 2, argv, "?encoding? data" );
}
 
javaEncoding = getJavaName( tclEncoding );
 
if ( (System.Object)javaEncoding == null )
{
throw new TclException( interp, "unknown encoding \"" + tclEncoding + "\"" );
}
 
try
{
if ( index == OPT_CONVERTFROM )
{
// Treat the string as binary data
byte[] bytes = TclByteArray.getBytes( interp, data );
 
// ATK
interp.setResult( System.Text.Encoding.UTF8.GetString( bytes, 0, bytes.Length) );
}
else
{
// Store the result as binary data
 
 
// ATK byte[] bytes = data.ToString().getBytes(javaEncoding);
byte[] bytes = System.Text.Encoding.UTF8.GetBytes( data.ToString() );
interp.setResult( TclByteArray.newInstance( bytes ) );
}
}
catch ( IOException ex )
{
throw new TclRuntimeError( "Encoding.cmdProc() error: " + "unsupported java encoding \"" + javaEncoding + "\"" );
}
 
break;
}
 
case OPT_NAMES:
{
if ( argv.Length > 2 )
{
throw new TclNumArgsException( interp, 2, argv, null );
}
 
TclObject list = TclList.newInstance();
for ( int i = 0; i < tclNames.Length; i++ )
{
TclList.append( interp, list, TclString.newInstance( tclNames[i] ) );
}
interp.setResult( list );
break;
}
 
case OPT_SYSTEM:
{
if ( argv.Length > 3 )
throw new TclNumArgsException( interp, 2, argv, "?encoding?" );
 
if ( argv.Length == 2 )
{
interp.setResult( systemTclEncoding );
}
else
{
 
string tclEncoding = argv[2].ToString();
Encoding javaEncoding = getJavaName( tclEncoding );
 
if ( javaEncoding == null )
{
throw new TclException( interp, "unknown encoding \"" + tclEncoding + "\"" );
}
 
systemTclEncoding = tclEncoding;
systemJavaEncoding = javaEncoding;
}
 
break;
}
 
default:
{
throw new TclRuntimeError( "Encoding.cmdProc() error: " + "incorrect index returned from TclIndex.get()" );
}
 
}
return TCL.CompletionCode.RETURN;
}
 
internal static int getBytesPerChar( Encoding encoding )
{
return encoding.GetMaxByteCount( 1 );
}
 
internal static System.Text.Encoding getJavaName( string name )
{
for ( int x = 0; x < EncodingCmd.tclNames.Length; x++ )
{
if ( EncodingCmd.tclNames[x] == name )
return EncodingCmd.encodings[x];
}
return null;
}
 
internal static string getTclName( Encoding encoding )
{
for ( int x = 0; x < EncodingCmd.encodings.Length; x++ )
{
if ( EncodingCmd.encodings[x].EncodingName == encoding.EncodingName )
return EncodingCmd.tclNames[x];
}
return null;
}
}
}
/trunk/TCL/src/commands/EofCmd.cs
@@ -0,0 +1,61 @@
/*
* EofCmd.java --
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: EofCmd.java,v 1.1.1.1 1998/10/14 21:09:18 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "eof" command in Tcl.</summary>
 
class EofCmd : Command
{
/// <summary> This procedure is invoked to process the "eof" 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() + "\"" );
}
 
if ( chan.eof() )
{
interp.setResult( TclInteger.newInstance( 1 ) );
}
else
{
interp.setResult( TclInteger.newInstance( 0 ) );
}
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/ErrorCmd.cs
@@ -0,0 +1,57 @@
/*
* ErrorCmd.java --
*
* Implements the "error" command.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ErrorCmd.java,v 1.1.1.1 1998/10/14 21:09:19 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements the built-in "error" command in Tcl.
*/
 
class ErrorCmd : Command
{
 
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 );
}
} // end ErrorCmd
}
/trunk/TCL/src/commands/EvalCmd.cs
@@ -0,0 +1,65 @@
/*
* EvalCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: EvalCmd.java,v 1.1.1.1 1998/10/14 21:09:18 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "eval" command in Tcl.</summary>
 
class EvalCmd : Command
{
/// <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;
}
}
}
/trunk/TCL/src/commands/ExecCmd.cs
@@ -0,0 +1,357 @@
/*
* ExecCmd.java --
*
* This file contains the Jacl implementation of the built-in Tcl "exec"
* command. The exec command is not available on the Mac.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ExecCmd.java,v 1.8 2002/01/19 00:15:01 mdejong Exp $
*/
using System;
using System.Diagnostics;
using System.IO;
using System.Text;
 
namespace tcl.lang
{
 
 
/*
* This class implements the built-in "exec" command in Tcl.
*/
 
class ExecCmd : Command
{
 
/// <summary> Reference to Runtime.exec, null when JDK < 1.3</summary>
private static System.Reflection.MethodInfo execMethod;
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
int firstWord; /* Index to the first non-switch arg */
int argLen = argv.Length; /* No of args to copy to argStrs */
int exit; /* denotes exit status of process */
int errorBytes = 0; /* number of bytes of process stderr */
//bool background; /* Indicates a bg process */
//bool keepNewline; /* Retains newline in pipline output */
System.Diagnostics.Process p; /* The exec-ed process */
string argStr; /* Conversion of argv to a string */
StringBuilder sbuf;
 
/*
* Check for a leading "-keepnewline" argument.
*/
 
for ( firstWord = 1; firstWord < argLen; firstWord++ )
{
argStr = argv[firstWord].ToString();
if ( ( argStr.Length > 0 ) && ( argStr[0] == '-' ) )
{
//if (argStr.Equals("-keepnewline"))
//{
// keepNewline = true;
//}
//else
if ( argStr.Equals( "--" ) )
{
firstWord++;
break;
}
else
{
throw new TclException( interp, "bad switch \"" + argStr + "\": must be -keepnewline or --" );
}
}
}
 
if ( argLen <= firstWord )
{
throw new TclNumArgsException( interp, 1, argv, "?switches? arg ?arg ...?" );
}
 
 
/*
* See if the command is to be run in background.
* Currently this does nothing, it is just for compatibility
*/
 
 
//if (argv[argLen - 1].ToString().Equals("&"))
//{
// argLen--;
// background = true;
//}
 
try
{
/*
* It is necessary to perform system specific
* operations before calling exec. For now Solaris
* and Windows execs are somewhat supported, in all other cases
* we simply call exec and give it our "best shot"
*/
 
if ( execMethod != null )
{
p = execReflection( interp, argv, firstWord, argLen );
}
else if ( Util.Unix )
{
p = execUnix( interp, argv, firstWord, argLen );
}
else if ( Util.Windows )
{
p = execWin( interp, argv, firstWord, argLen );
}
else
{
p = execDefault( interp, argv, firstWord, argLen );
}
 
 
//note to self : buffer reading should be done in
//a separate thread and not by calling waitFor()
//because a process that is waited for can block
 
 
//Wait for the process to finish running,
try
{
p.Start();
p.WaitForExit();
exit = p.ExitCode;
}
catch ( Exception e )
{
throw new TclException( interp, "exception in exec process: " + e.Message );
}
 
 
//Make buffer for the results of the subprocess execution
sbuf = new StringBuilder();
 
//read data on stdout stream into result buffer
readStreamIntoBuffer( p.StandardOutput.BaseStream, sbuf );
 
//if there is data on the stderr stream then append
//this data onto the result StringBuffer
//check for the special case where there is no error
//data but the process returns an error result
 
errorBytes = readStreamIntoBuffer( p.StandardError.BaseStream, sbuf );
 
if ( ( errorBytes == 0 ) && ( exit != 0 ) )
{
sbuf.Append( "child process exited abnormally" );
}
 
//If the last character of the result buffer is a newline, then
//remove the newline character (the newline would just confuse
//things). Finally, we set pass the result to the interpreter.
 
 
 
// Tcl supports lots of child status conditions.
// Unfortunately, we can only find the child's
// exit status using the Java API
 
if ( exit != 0 )
{
TclObject childstatus = TclList.newInstance();
TclList.append( interp, childstatus, TclString.newInstance( "CHILDSTATUS" ) );
 
// We don't know how to find the child's pid
TclList.append( interp, childstatus, TclString.newInstance( "?PID?" ) );
 
TclList.append( interp, childstatus, TclInteger.newInstance( exit ) );
 
interp.setErrorCode( childstatus );
}
 
//when the subprocess writes to its stderr stream or returns
//a non zero result we generate an error
if ( ( exit != 0 ) || ( errorBytes != 0 ) )
{
throw new TclException( interp, sbuf.ToString() );
}
 
//otherwise things went well so set the result
interp.setResult( sbuf.ToString() );
}
catch ( IOException e )
{
//if exec fails we end up catching the exception here
 
 
throw new TclException( interp, "couldn't execute \"" + argv[firstWord].ToString() + "\": no such file or directory" );
}
catch ( System.Threading.ThreadInterruptedException e )
{
/*
* Do Nothing...
*/
}
return TCL.CompletionCode.RETURN;
}
 
 
internal static int readStreamIntoBuffer( Stream in_Renamed, StringBuilder sbuf )
{
int numRead = 0;
StreamReader br = new StreamReader( new StreamReader( in_Renamed ).BaseStream, System.Text.Encoding.UTF7 );
 
try
{
string line = br.ReadLine();
 
while ( (System.Object)line != null )
{
sbuf.Append( line );
numRead += line.Length;
sbuf.Append( '\n' );
numRead++;
line = br.ReadLine();
}
}
catch ( IOException e )
{
//do nothing just return numRead
}
finally
{
try
{
br.Close();
}
catch ( IOException e )
{
} //ignore IO error
}
 
return numRead;
}
 
 
internal static string escapeWinString( string str )
{
if ( str.IndexOf( (System.Char)'%' ) == -1 )
return str;
 
char[] arr = str.ToCharArray();
StringBuilder sb = new StringBuilder( 50 );
 
for ( int i = 0; i < arr.Length; i++ )
{
if ( arr[i] == '%' )
{
sb.Append( '%' );
}
sb.Append( arr[i] );
}
 
return sb.ToString();
}
 
 
private System.Diagnostics.Process execUnix( Interp interp, TclObject[] argv, int first, int last )
{
return execWin( interp, argv, first, last );
}
 
private System.Diagnostics.Process execWin( Interp interp, TclObject[] argv, int first, int last )
{
StringBuilder sb = new StringBuilder();
for ( int i = ( first + 1 ); i < last; i++ )
{
sb.Append( '"' );
sb.Append( escapeWinString( argv[i].ToString() ) );
sb.Append( '"' );
sb.Append( ' ' );
}
 
Process proc = new Process();
proc.StartInfo.UseShellExecute = false;
proc.StartInfo.RedirectStandardOutput = true;
proc.StartInfo.RedirectStandardError = true;
proc.StartInfo.RedirectStandardInput = true;
proc.StartInfo.WorkingDirectory = interp.getWorkingDir().FullName;
proc.StartInfo.FileName = argv[first].ToString();
proc.StartInfo.Arguments = sb.ToString();
return proc;
}
 
private System.Diagnostics.Process execDefault( Interp interp, TclObject[] argv, int first, int last )
{
return execWin( interp, argv, first, last );
}
 
private System.Diagnostics.Process execReflection( Interp interp, TclObject[] argv, int first, int last )
{
 
string[] strv = new string[last - first];
 
for ( int i = first, j = 0; i < last; j++, i++ )
{
 
strv[j] = argv[i].ToString();
}
 
Object[] methodArgs = new Object[3];
methodArgs[0] = strv; // exec command arguments
methodArgs[1] = null; // inherit all environment variables
methodArgs[2] = interp.getWorkingDir();
 
try
{
return (System.Diagnostics.Process)execMethod.Invoke( System.Diagnostics.Process.GetCurrentProcess(), (System.Object[])methodArgs );
}
catch ( System.UnauthorizedAccessException ex )
{
throw new TclRuntimeError( "IllegalAccessException in execReflection" );
}
catch ( System.ArgumentException ex )
{
throw new TclRuntimeError( "IllegalArgumentException in execReflection" );
}
catch ( System.Reflection.TargetInvocationException ex )
{
System.Exception t = ex.GetBaseException();
 
if ( t is System.ApplicationException )
{
throw (System.ApplicationException)t;
}
else if ( t is IOException )
{
throw (IOException)t;
}
else
{
throw new TclRuntimeError( "unexected exception in execReflection" );
}
}
}
static ExecCmd()
{
{
// Runtime.exec(String[] cmdArr, String[] envArr, File currDir)
Type[] parameterTypes = new Type[] { typeof( string[] ), typeof( string[] ), typeof( FileInfo ) };
try
{
execMethod = System.Diagnostics.Process.GetCurrentProcess().GetType().GetMethod( "exec", (System.Type[])parameterTypes );
}
catch ( System.MethodAccessException e )
{
execMethod = null;
}
}
}
} // end ExecCmd
}
/trunk/TCL/src/commands/ExitCmd.cs
@@ -0,0 +1,44 @@
/*
* ExitCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ExitCmd.java,v 1.1.1.1 1998/10/14 21:09:19 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "exit" command in Tcl.</summary>
class ExitCmd : Command
{
 
/// <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;
}
}
}
/trunk/TCL/src/commands/ExprCmd.cs
@@ -0,0 +1,58 @@
/*
* ExprCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ExprCmd.java,v 1.2 1999/05/08 23:59:30 dejong Exp $
*
*/
using System.Text;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "expr" command in Tcl.</summary>
 
class ExprCmd : Command
{
/// <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;
}
}
}
/trunk/TCL/src/commands/FblockedCmd.cs
@@ -0,0 +1,54 @@
/*
* FblockedCmd.java --
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: FblockedCmd.java,v 1.5 2003/03/08 03:42:43 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "fblocked" command in Tcl.</summary>
 
class FblockedCmd : Command
{
/// <summary> This procedure is invoked to process the "fblocked" 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() + "\"" );
}
 
interp.setResult( chan.isBlocked( interp ) );
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/FconfigureCmd.cs
@@ -0,0 +1,452 @@
/*
* FconfigureCmd.java --
*
* Copyright (c) 2001 Bruce A. Johnson
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: FconfigureCmd.java,v 1.11 2003/03/08 03:42:43 mdejong Exp $
*
*/
using System;
using System.Text;
 
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "fconfigure" command in Tcl.</summary>
 
class FconfigureCmd : Command
{
 
private static readonly string[] validCmds = new string[] { "-blocking", "-buffering", "-buffersize", "-encoding", "-eofchar", "-translation" };
 
internal const int OPT_BLOCKING = 0;
internal const int OPT_BUFFERING = 1;
internal const int OPT_BUFFERSIZE = 2;
internal const int OPT_ENCODING = 3;
internal const int OPT_EOFCHAR = 4;
internal const int OPT_TRANSLATION = 5;
 
 
/// <summary> This procedure is invoked to process the "fconfigure" 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 ) || ( ( ( argv.Length % 2 ) == 1 ) && ( argv.Length != 3 ) ) )
{
throw new TclNumArgsException( interp, 1, argv, "channelId ?optionName? ?value? ?optionName value?..." );
}
 
 
chan = TclIO.getChannel( interp, argv[1].ToString() );
if ( chan == null )
{
 
throw new TclException( interp, "can not find channel named \"" + argv[1].ToString() + "\"" );
}
 
if ( argv.Length == 2 )
{
// return list of all name/value pairs for this channelId
TclObject list = TclList.newInstance();
 
TclList.append( interp, list, TclString.newInstance( "-blocking" ) );
TclList.append( interp, list, TclBoolean.newInstance( chan.Blocking ) );
 
TclList.append( interp, list, TclString.newInstance( "-buffering" ) );
TclList.append( interp, list, TclString.newInstance( TclIO.getBufferingString( chan.Buffering ) ) );
 
TclList.append( interp, list, TclString.newInstance( "-buffersize" ) );
TclList.append( interp, list, TclInteger.newInstance( chan.BufferSize ) );
 
// -encoding
 
TclList.append( interp, list, TclString.newInstance( "-encoding" ) );
 
System.Text.Encoding javaEncoding = chan.Encoding;
string tclEncoding;
if ( (System.Object)javaEncoding == null )
{
tclEncoding = "binary";
}
else
{
tclEncoding = EncodingCmd.getTclName( javaEncoding );
}
TclList.append( interp, list, TclString.newInstance( tclEncoding ) );
 
// -eofchar
 
TclList.append( interp, list, TclString.newInstance( "-eofchar" ) );
if ( chan.ReadOnly )
{
char eofChar = chan.InputEofChar;
TclList.append( interp, list, ( eofChar == 0 ) ? TclString.newInstance( "" ) : TclString.newInstance( eofChar ) );
}
else if ( chan.WriteOnly )
{
char eofChar = chan.OutputEofChar;
TclList.append( interp, list, ( eofChar == 0 ) ? TclString.newInstance( "" ) : TclString.newInstance( eofChar ) );
}
else if ( chan.ReadWrite )
{
char inEofChar = chan.InputEofChar;
char outEofChar = chan.OutputEofChar;
 
TclObject eofchar_pair = TclList.newInstance();
 
TclList.append( interp, eofchar_pair, ( inEofChar == 0 ) ? TclString.newInstance( "" ) : TclString.newInstance( inEofChar ) );
 
TclList.append( interp, eofchar_pair, ( outEofChar == 0 ) ? TclString.newInstance( "" ) : TclString.newInstance( outEofChar ) );
 
TclList.append( interp, list, eofchar_pair );
}
else
{
// Not readable or writeable, do nothing
}
 
// -translation
 
TclList.append( interp, list, TclString.newInstance( "-translation" ) );
 
if ( chan.ReadOnly )
{
TclList.append( interp, list, TclString.newInstance( TclIO.getTranslationString( chan.InputTranslation ) ) );
}
else if ( chan.WriteOnly )
{
TclList.append( interp, list, TclString.newInstance( TclIO.getTranslationString( chan.OutputTranslation ) ) );
}
else if ( chan.ReadWrite )
{
TclObject translation_pair = TclList.newInstance();
 
TclList.append( interp, translation_pair, TclString.newInstance( TclIO.getTranslationString( chan.InputTranslation ) ) );
TclList.append( interp, translation_pair, TclString.newInstance( TclIO.getTranslationString( chan.OutputTranslation ) ) );
 
TclList.append( interp, list, translation_pair );
}
else
{
// Not readable or writeable, do nothing
}
 
interp.setResult( list );
}
 
if ( argv.Length == 3 )
{
// return value for supplied name
 
int index = TclIndex.get( interp, argv[2], validCmds, "option", 0 );
 
switch ( index )
{
 
case OPT_BLOCKING:
{
// -blocking
interp.setResult( chan.Blocking );
break;
}
 
case OPT_BUFFERING:
{
// -buffering
interp.setResult( TclIO.getBufferingString( chan.Buffering ) );
break;
}
 
case OPT_BUFFERSIZE:
{
// -buffersize
interp.setResult( chan.BufferSize );
break;
}
 
case OPT_ENCODING:
{
// -encoding
System.Text.Encoding javaEncoding = chan.Encoding;
if ( (System.Object)javaEncoding == null )
{
interp.setResult( "binary" );
}
else
{
interp.setResult( EncodingCmd.getTclName( javaEncoding ) );
}
break;
}
 
case OPT_EOFCHAR:
{
// -eofchar
if ( chan.ReadOnly )
{
char eofChar = chan.InputEofChar;
interp.setResult( ( eofChar == 0 ) ? TclString.newInstance( "" ) : TclString.newInstance( eofChar ) );
}
else if ( chan.WriteOnly )
{
char eofChar = chan.OutputEofChar;
interp.setResult( ( eofChar == 0 ) ? TclString.newInstance( "" ) : TclString.newInstance( eofChar ) );
}
else if ( chan.ReadWrite )
{
char inEofChar = chan.InputEofChar;
char outEofChar = chan.OutputEofChar;
 
TclObject eofchar_pair = TclList.newInstance();
 
TclList.append( interp, eofchar_pair, ( inEofChar == 0 ) ? TclString.newInstance( "" ) : TclString.newInstance( inEofChar ) );
 
TclList.append( interp, eofchar_pair, ( outEofChar == 0 ) ? TclString.newInstance( "" ) : TclString.newInstance( outEofChar ) );
 
interp.setResult( eofchar_pair );
}
else
{
// Not readable or writeable, do nothing
}
 
break;
}
 
case OPT_TRANSLATION:
{
// -translation
if ( chan.ReadOnly )
{
interp.setResult( TclIO.getTranslationString( chan.InputTranslation ) );
}
else if ( chan.WriteOnly )
{
interp.setResult( TclIO.getTranslationString( chan.OutputTranslation ) );
}
else if ( chan.ReadWrite )
{
TclObject translation_pair = TclList.newInstance();
 
TclList.append( interp, translation_pair, TclString.newInstance( TclIO.getTranslationString( chan.InputTranslation ) ) );
TclList.append( interp, translation_pair, TclString.newInstance( TclIO.getTranslationString( chan.OutputTranslation ) ) );
 
interp.setResult( translation_pair );
}
else
{
// Not readable or writeable, do nothing
}
 
break;
}
 
default:
{
throw new TclRuntimeError( "Fconfigure.cmdProc() error: " + "incorrect index returned from TclIndex.get()" );
}
 
}
}
for ( int i = 3; i < argv.Length; i += 2 )
{
// Iterate through the list setting the name with the
// corresponding value.
 
int index = TclIndex.get( interp, argv[i - 1], validCmds, "option", 0 );
 
switch ( index )
{
 
case OPT_BLOCKING:
{
// -blocking
chan.Blocking = TclBoolean.get( interp, argv[i] );
break;
}
 
case OPT_BUFFERING:
{
// -buffering
 
int id = TclIO.getBufferingID( argv[i].ToString() );
 
if ( id == -1 )
{
throw new TclException( interp, "bad value for -buffering: must be " + "one of full, line, or none" );
}
 
chan.Buffering = id;
break;
}
 
case OPT_BUFFERSIZE:
{
// -buffersize
chan.BufferSize = TclInteger.get( interp, argv[i] );
break;
}
 
case OPT_ENCODING:
{
// -encoding
 
string tclEncoding = argv[i].ToString();
 
if ( tclEncoding.Equals( "" ) || tclEncoding.Equals( "binary" ) )
{
chan.Encoding = null;
}
else
{
System.Text.Encoding javaEncoding = EncodingCmd.getJavaName( tclEncoding );
if ( (System.Object)javaEncoding == null )
{
throw new TclException( interp, "unknown encoding \"" + tclEncoding + "\"" );
}
chan.Encoding = javaEncoding;
}
 
break;
}
 
case OPT_EOFCHAR:
{
// -eofchar
TclList.setListFromAny( interp, argv[i] );
int length = TclList.getLength( interp, argv[i] );
 
if ( length > 2 )
{
throw new TclException( interp, "bad value for -eofchar: " + "should be a list of zero, one, or two elements" );
}
 
char inputEofChar, outputEofChar;
string s;
 
if ( length == 0 )
{
inputEofChar = outputEofChar = (char)( 0 );
}
else if ( length == 1 )
{
 
s = TclList.index( interp, argv[i], 0 ).ToString();
inputEofChar = outputEofChar = s[0];
}
else
{
 
s = TclList.index( interp, argv[i], 0 ).ToString();
inputEofChar = s[0];
 
 
s = TclList.index( interp, argv[i], 1 ).ToString();
outputEofChar = s[0];
}
 
chan.InputEofChar = inputEofChar;
chan.OutputEofChar = outputEofChar;
 
break;
}
 
case OPT_TRANSLATION:
{
// -translation
TclList.setListFromAny( interp, argv[i] );
int length = TclList.getLength( interp, argv[i] );
 
if ( length < 1 || length > 2 )
{
throw new TclException( interp, "bad value for -translation: " + "must be a one or two element list" );
}
 
string inputTranslationArg, outputTranslationArg;
int inputTranslation, outputTranslation;
 
if ( length == 2 )
{
 
inputTranslationArg = TclList.index( interp, argv[i], 0 ).ToString();
inputTranslation = TclIO.getTranslationID( inputTranslationArg );
 
outputTranslationArg = TclList.index( interp, argv[i], 1 ).ToString();
outputTranslation = TclIO.getTranslationID( outputTranslationArg );
}
else
{
 
outputTranslationArg = inputTranslationArg = argv[i].ToString();
outputTranslation = inputTranslation = TclIO.getTranslationID( outputTranslationArg );
}
 
if ( ( inputTranslation == -1 ) || ( outputTranslation == -1 ) )
{
throw new TclException( interp, "bad value for -translation: " + "must be one of auto, binary, cr, lf, " + "crlf, or platform" );
}
 
if ( outputTranslation == TclIO.TRANS_AUTO )
outputTranslation = TclIO.TRANS_PLATFORM;
 
if ( chan.ReadOnly )
{
chan.InputTranslation = inputTranslation;
if ( inputTranslationArg.Equals( "binary" ) )
{
chan.Encoding = null;
}
}
else if ( chan.WriteOnly )
{
chan.OutputTranslation = outputTranslation;
if ( outputTranslationArg.Equals( "binary" ) )
{
chan.Encoding = null;
}
}
else if ( chan.ReadWrite )
{
chan.InputTranslation = inputTranslation;
chan.OutputTranslation = outputTranslation;
if ( inputTranslationArg.Equals( "binary" ) || outputTranslationArg.Equals( "binary" ) )
{
chan.Encoding = null;
}
}
else
{
// Not readable or writeable, do nothing
}
 
break;
}
 
default:
{
throw new TclRuntimeError( "Fconfigure.cmdProc() error: " + "incorrect index returned from TclIndex.get()" );
}
 
}
}
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/FileCmd.cs
@@ -0,0 +1,1163 @@
/*
* FileCmd.java --
*
* This file contains the Jacl implementation of the built-in Tcl "file"
* command.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: FileCmd.java,v 1.9 2003/02/03 01:39:02 mdejong Exp $
*
*/
using System;
using System.IO;
namespace tcl.lang
{
 
/*
* This class implements the built-in "file" command in Tcl.
*/
 
class FileCmd : Command
{
 
/// <summary> Reference to File.listRoots, null when JDK < 1.2</summary>
private static System.Reflection.MethodInfo listRootsMethod;
 
internal static Type procClass = null;
 
private static readonly string[] validCmds = new string[] { "atime", "attributes", "channels", "copy", "delete", "dirname", "executable", "exists", "extension", "isdirectory", "isfile", "join", "link", "lstat", "mtime", "mkdir", "nativename", "normalize", "owned", "pathtype", "readable", "readlink", "rename", "rootname", "separator", "size", "split", "stat", "system", "tail", "type", "volumes", "writable" };
 
private const int OPT_ATIME = 0;
private const int OPT_ATTRIBUTES = 1;
private const int OPT_CHANNELS = 2;
private const int OPT_COPY = 3;
private const int OPT_DELETE = 4;
private const int OPT_DIRNAME = 5;
private const int OPT_EXECUTABLE = 6;
private const int OPT_EXISTS = 7;
private const int OPT_EXTENSION = 8;
private const int OPT_ISDIRECTORY = 9;
private const int OPT_ISFILE = 10;
private const int OPT_JOIN = 11;
private const int OPT_LINK = 12;
private const int OPT_LSTAT = 13;
private const int OPT_MTIME = 14;
private const int OPT_MKDIR = 15;
private const int OPT_NATIVENAME = 16;
private const int OPT_NORMALIZE = 17;
private const int OPT_OWNED = 18;
private const int OPT_PATHTYPE = 19;
private const int OPT_READABLE = 20;
private const int OPT_READLINK = 21;
private const int OPT_RENAME = 22;
private const int OPT_ROOTNAME = 23;
private const int OPT_SEPARATOR = 24;
private const int OPT_SIZE = 25;
private const int OPT_SPLIT = 26;
private const int OPT_STAT = 27;
private const int OPT_SYSTEM = 28;
private const int OPT_TAIL = 29;
private const int OPT_TYPE = 30;
private const int OPT_VOLUMES = 31;
private const int OPT_WRITABLE = 32;
 
private static readonly string[] validOptions = new string[] { "-force", "--" };
 
private const int OPT_FORCE = 0;
private const int OPT_LAST = 1;
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
if ( argv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, argv, "option ?arg ...?" );
}
 
int opt = TclIndex.get( interp, argv[1], validCmds, "option", 0 );
string path;
FileInfo fileObj = null;
 
switch ( opt )
{
 
case OPT_ATIME:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
// FIXME: Currently returns the same thing as MTIME.
// Java does not support retrieval of access time.
 
 
 
fileObj = FileUtil.getNewFileObj( interp, argv[2].ToString() );
 
interp.setResult( getMtime( interp, argv[2].ToString(), fileObj ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_ATTRIBUTES:
if ( argv[3].ToString() == "-readonly" )
fileSetReadOnly( interp, argv );
else
throw new TclException( interp, "sorry, \"file attributes\" is not implemented yet" );
return TCL.CompletionCode.RETURN;
 
 
case OPT_CHANNELS:
 
throw new TclException( interp, "sorry, \"file channels\" is not implemented yet" );
 
 
case OPT_COPY:
fileCopyRename( interp, argv, true );
return TCL.CompletionCode.RETURN;
 
 
case OPT_DELETE:
fileDelete( interp, argv );
return TCL.CompletionCode.RETURN;
 
 
case OPT_DIRNAME:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
path = argv[2].ToString();
 
// Return all but the last component. If there is only one
// component, return it if the path was non-relative, otherwise
// return the current directory.
 
 
TclObject[] splitArrayObj = TclList.getElements( interp, FileUtil.splitAndTranslate( interp, path ) );
 
if ( splitArrayObj.Length > 1 )
{
interp.setResult( FileUtil.joinPath( interp, splitArrayObj, 0, splitArrayObj.Length - 1 ) );
}
else if ( ( splitArrayObj.Length == 0 ) || ( FileUtil.getPathType( path ) == FileUtil.PATH_RELATIVE ) )
{
if ( JACL.PLATFORM == JACL.PLATFORM_MAC )
{
interp.setResult( ":" );
}
else
{
interp.setResult( "." );
}
}
else
{
 
interp.setResult( splitArrayObj[0].ToString() );
}
return TCL.CompletionCode.RETURN;
 
 
case OPT_EXECUTABLE:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
bool isExe = false;
 
fileObj = FileUtil.getNewFileObj( interp, argv[2].ToString() );
 
// A file must exist to be executable. Directories are always
// executable.
 
bool tmpBool;
if ( File.Exists( fileObj.FullName ) )
tmpBool = true;
else
tmpBool = Directory.Exists( fileObj.FullName );
if ( tmpBool )
{
isExe = Directory.Exists( fileObj.FullName );
if ( isExe )
{
interp.setResult( isExe );
return TCL.CompletionCode.RETURN;
}
 
if ( Util.Windows )
{
// File that ends with .exe, .com, or .bat is executable.
 
 
string fileName = argv[2].ToString();
isExe = ( fileName.EndsWith( ".exe" ) || fileName.EndsWith( ".com" ) || fileName.EndsWith( ".bat" ) );
}
else if ( Util.Mac )
{
// FIXME: Not yet implemented on Mac. For now, return true.
// Java does not support executability checking.
 
isExe = true;
}
else
{
// FIXME: Not yet implemented on Unix. For now, return true.
// Java does not support executability checking.
 
isExe = true;
}
}
interp.setResult( isExe );
return TCL.CompletionCode.RETURN;
 
 
case OPT_EXISTS:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
fileObj = FileUtil.getNewFileObj( interp, argv[2].ToString() );
bool tmpBool2;
if ( File.Exists( fileObj.FullName ) )
tmpBool2 = true;
else
tmpBool2 = Directory.Exists( fileObj.FullName );
interp.setResult( tmpBool2 );
return TCL.CompletionCode.RETURN;
 
 
case OPT_EXTENSION:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
interp.setResult( getExtension( argv[2].ToString() ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_ISDIRECTORY:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
fileObj = FileUtil.getNewFileObj( interp, argv[2].ToString() );
interp.setResult( Directory.Exists( fileObj.FullName ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_ISFILE:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
fileObj = FileUtil.getNewFileObj( interp, argv[2].ToString() );
interp.setResult( File.Exists( fileObj.FullName ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_JOIN:
if ( argv.Length < 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name ?name ...?" );
}
interp.setResult( FileUtil.joinPath( interp, argv, 2, argv.Length ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_LINK:
 
throw new TclException( interp, "sorry, \"file link\" is not implemented yet" );
 
 
case OPT_LSTAT:
if ( argv.Length != 4 )
{
throw new TclNumArgsException( interp, 2, argv, "name varName" );
}
 
// FIXME: Not yet implemented.
// Java does not support link access.
 
 
throw new TclException( interp, "file command with opt " + argv[1].ToString() + " is not yet implemented" );
 
 
 
case OPT_MTIME:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
fileObj = FileUtil.getNewFileObj( interp, argv[2].ToString() );
 
interp.setResult( getMtime( interp, argv[2].ToString(), fileObj ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_MKDIR:
fileMakeDirs( interp, argv );
return TCL.CompletionCode.RETURN;
 
 
case OPT_NATIVENAME:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
 
interp.setResult( FileUtil.translateFileName( interp, argv[2].ToString() ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_NORMALIZE:
 
throw new TclException( interp, "sorry, \"file normalize\" is not implemented yet" );
 
 
case OPT_OWNED:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
fileObj = FileUtil.getNewFileObj( interp, argv[2].ToString() );
interp.setResult( isOwner( interp, fileObj ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_PATHTYPE:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
switch ( FileUtil.getPathType( argv[2].ToString() ) )
{
 
case FileUtil.PATH_RELATIVE:
interp.setResult( "relative" );
return TCL.CompletionCode.RETURN;
 
case FileUtil.PATH_VOLUME_RELATIVE:
interp.setResult( "volumerelative" );
return TCL.CompletionCode.RETURN;
 
case FileUtil.PATH_ABSOLUTE:
interp.setResult( "absolute" );
break;
}
return TCL.CompletionCode.RETURN;
 
 
case OPT_READABLE:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
fileObj = FileUtil.getNewFileObj( interp, argv[2].ToString() );
 
// interp.setResult(fileObj.canRead());
// HACK
interp.setResult( true );
return TCL.CompletionCode.RETURN;
 
 
case OPT_READLINK:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
// FIXME: Not yet implemented.
// Java does not support link access.
 
 
throw new TclException( interp, "file command with opt " + argv[1].ToString() + " is not yet implemented" );
 
 
case OPT_RENAME:
fileCopyRename( interp, argv, false );
return TCL.CompletionCode.RETURN;
 
 
case OPT_ROOTNAME:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
string fileName2 = argv[2].ToString();
string extension = getExtension( fileName2 );
int diffLength = fileName2.Length - extension.Length;
interp.setResult( fileName2.Substring( 0, ( diffLength ) - ( 0 ) ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_SEPARATOR:
 
throw new TclException( interp, "sorry, \"file separator\" is not implemented yet" );
 
 
case OPT_SIZE:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
fileObj = FileUtil.getNewFileObj( interp, argv[2].ToString() );
bool tmpBool3;
if ( File.Exists( fileObj.FullName ) )
tmpBool3 = true;
else
tmpBool3 = Directory.Exists( fileObj.FullName );
if ( !tmpBool3 )
{
 
throw new TclPosixException( interp, TclPosixException.ENOENT, true, "could not read \"" + argv[2].ToString() + "\"" );
}
interp.setResult( (int)SupportClass.FileLength( fileObj ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_SPLIT:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
interp.setResult( FileUtil.splitPath( interp, argv[2].ToString() ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_STAT:
if ( argv.Length != 4 )
{
throw new TclNumArgsException( interp, 2, argv, "name varName" );
}
 
getAndStoreStatData( interp, argv[2].ToString(), argv[3].ToString() );
return TCL.CompletionCode.RETURN;
 
 
case OPT_SYSTEM:
 
throw new TclException( interp, "sorry, \"file system\" is not implemented yet" );
 
 
case OPT_TAIL:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
interp.setResult( getTail( interp, argv[2].ToString() ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_TYPE:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
fileObj = FileUtil.getNewFileObj( interp, argv[2].ToString() );
 
interp.setResult( getType( interp, argv[2].ToString(), fileObj ) );
return TCL.CompletionCode.RETURN;
 
 
case OPT_VOLUMES:
if ( argv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, argv, null );
}
 
// use Java 1.2's File.listRoots() method if available
 
if ( listRootsMethod == null )
throw new TclException( interp, "\"file volumes\" is not supported" );
 
try
{
FileInfo[] roots = (FileInfo[])listRootsMethod.Invoke( null, (System.Object[])new System.Object[0] );
if ( roots != null )
{
TclObject list = TclList.newInstance();
for ( int i = 0; i < roots.Length; i++ )
{
string root = roots[i].FullName;
TclList.append( interp, list, TclString.newInstance( root ) );
}
interp.setResult( list );
}
}
catch ( System.UnauthorizedAccessException ex )
{
throw new TclRuntimeError( "IllegalAccessException in volumes cmd" );
}
catch ( System.ArgumentException ex )
{
throw new TclRuntimeError( "IllegalArgumentException in volumes cmd" );
}
catch ( System.Reflection.TargetInvocationException ex )
{
System.Exception t = ex.GetBaseException();
 
if ( t is System.ApplicationException )
{
throw (System.ApplicationException)t;
}
else
{
throw new TclRuntimeError( "unexected exception in volumes cmd" );
}
}
 
return TCL.CompletionCode.RETURN;
 
case OPT_WRITABLE:
if ( argv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, argv, "name" );
}
 
fileObj = FileUtil.getNewFileObj( interp, argv[2].ToString() );
interp.setResult( SupportClass.FileCanWrite( fileObj ) );
return TCL.CompletionCode.RETURN;
 
default:
 
throw new TclRuntimeError( "file command with opt " + argv[1].ToString() + " is not implemented" );
 
}
}
private static bool isOwner( Interp interp, FileInfo fileObj )
{
// If the file doesn't exist, return false;
 
bool tmpBool;
if ( File.Exists( fileObj.FullName ) )
tmpBool = true;
else
tmpBool = Directory.Exists( fileObj.FullName );
if ( !tmpBool )
{
return false;
}
bool owner = true;
 
// For Windows and Macintosh, there are no user ids
// associated with a file, so we always return 1.
 
if ( Util.Unix )
{
// FIXME: Not yet implemented on Unix. Do no checking, for now.
// Java does not support ownership checking.
}
return owner;
}
private static int getMtime( Interp interp, string fileName, FileInfo fileObj )
{
bool tmpBool;
if ( File.Exists( fileObj.FullName ) )
tmpBool = true;
else
tmpBool = Directory.Exists( fileObj.FullName );
if ( !tmpBool )
{
throw new TclPosixException( interp, TclPosixException.ENOENT, true, "could not read \"" + fileName + "\"" );
}
// Divide to convert msecs to seconds
return (int)( fileObj.LastWriteTime.Ticks / 1000 );
}
private static string getType( Interp interp, string fileName, FileInfo fileObj )
{
bool tmpBool;
if ( File.Exists( fileObj.FullName ) )
tmpBool = true;
else
tmpBool = Directory.Exists( fileObj.FullName );
if ( !tmpBool )
{
throw new TclPosixException( interp, TclPosixException.ENOENT, true, "could not read \"" + fileName + "\"" );
}
 
if ( File.Exists( fileObj.FullName ) )
{
return "file";
}
else if ( Directory.Exists( fileObj.FullName ) )
{
return "directory";
}
return "link";
}
private static void getAndStoreStatData( Interp interp, string fileName, string varName )
{
FileInfo fileObj = FileUtil.getNewFileObj( interp, fileName );
 
bool tmpBool;
if ( File.Exists( fileObj.FullName ) )
tmpBool = true;
else
tmpBool = Directory.Exists( fileObj.FullName );
if ( !tmpBool )
{
throw new TclPosixException( interp, TclPosixException.ENOENT, true, "could not read \"" + fileName + "\"" );
}
 
try
{
int mtime = getMtime( interp, fileName, fileObj );
TclObject mtimeObj = TclInteger.newInstance( mtime );
TclObject atimeObj = TclInteger.newInstance( mtime );
TclObject ctimeObj = TclInteger.newInstance( mtime );
interp.setVar( varName, "atime", atimeObj, 0 );
interp.setVar( varName, "ctime", ctimeObj, 0 );
interp.setVar( varName, "mtime", mtimeObj, 0 );
}
catch ( System.Security.SecurityException e )
{
throw new TclException( interp, e.Message );
}
catch ( TclException e )
{
throw new TclException( interp, "can't set \"" + varName + "(dev)\": variable isn't array" );
}
 
try
{
TclObject sizeObj = TclInteger.newInstance( (int)SupportClass.FileLength( fileObj ) );
interp.setVar( varName, "size", sizeObj, 0 );
}
catch ( System.Exception e )
{
// Do nothing.
}
 
try
{
TclObject typeObj = TclString.newInstance( getType( interp, fileName, fileObj ) );
interp.setVar( varName, "type", typeObj, 0 );
}
catch ( System.Exception e )
{
}
 
try
{
TclObject uidObj = TclBoolean.newInstance( isOwner( interp, fileObj ) );
interp.setVar( varName, "uid", uidObj, 0 );
}
catch ( TclException e )
{
// Do nothing.
}
}
private static string getExtension( string path )
// Path for which we find extension.
{
if ( path.Length < 1 )
{
return "";
}
 
// Set lastSepIndex to the first index in the last component of the path.
 
int lastSepIndex = -1;
switch ( JACL.PLATFORM )
{
 
case JACL.PLATFORM_WINDOWS:
string tmpPath = path.Replace( '\\', '/' ).Replace( ':', '/' );
lastSepIndex = tmpPath.LastIndexOf( (System.Char)'/' );
break;
 
case JACL.PLATFORM_MAC:
lastSepIndex = path.LastIndexOf( (System.Char)':' );
if ( lastSepIndex == -1 )
{
lastSepIndex = path.LastIndexOf( (System.Char)'/' );
}
break;
 
default:
lastSepIndex = path.LastIndexOf( (System.Char)'/' );
break;
 
}
++lastSepIndex;
 
// Return "" if the last character is a separator.
 
if ( lastSepIndex >= path.Length )
{
return ( "" );
}
 
// Find the last dot in the last component of the path.
 
string lastSep = path.Substring( lastSepIndex );
int dotIndex = lastSep.LastIndexOf( (System.Char)'.' );
 
// Return "" if no dot was found in the file's name.
 
if ( dotIndex == -1 )
{
return "";
}
 
// In earlier versions, we used to back up to the first period in a series
// so that "foo..o" would be split into "foo" and "..o". This is a
// confusing and usually incorrect behavior, so now we split at the last
// period in the name.
 
return ( lastSep.Substring( dotIndex ) );
}
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 fileMakeDirs( Interp interp, TclObject[] argv )
{
bool madeDir = false;
 
for ( int currentDir = 2; currentDir < argv.Length; currentDir++ )
{
 
string dirName = argv[currentDir].ToString();
if ( dirName.Length == 0 )
{
throw new TclPosixException( interp, TclPosixException.ENOENT, true, "can't create directory \"\"" );
}
FileInfo dirObj = FileUtil.getNewFileObj( interp, dirName );
bool tmpBool;
if ( File.Exists( dirObj.FullName ) )
tmpBool = true;
else
tmpBool = Directory.Exists( dirObj.FullName );
if ( tmpBool )
{
// If the directory already exists, do nothing.
if ( Directory.Exists( dirObj.FullName ) )
{
continue;
}
throw new TclPosixException( interp, TclPosixException.EEXIST, true, "can't create directory \"" + dirName + "\"" );
}
try
{
Directory.CreateDirectory( dirObj.FullName );
madeDir = true;
}
catch ( Exception e )
{
throw new TclException( interp, e.Message );
}
if ( !madeDir )
{
throw new TclPosixException( interp, TclPosixException.EACCES, true, "can't create directory \"" + dirName + "\": best guess at reason" );
}
}
}
private static void fileDelete( Interp interp, TclObject[] argv )
{
bool force = false;
int firstSource = 2;
 
for ( bool last = false; ( firstSource < argv.Length ) && ( !last ); firstSource++ )
{
 
 
if ( !argv[firstSource].ToString().StartsWith( "-" ) )
{
break;
}
int opt = TclIndex.get( interp, argv[firstSource], validOptions, "option", 1 );
switch ( opt )
{
 
case OPT_FORCE:
force = true;
break;
 
case OPT_LAST:
last = true;
break;
 
default:
throw new TclRuntimeError( "FileCmd.cmdProc: bad option " + opt + " index to validOptions" );
 
}
}
 
if ( firstSource >= argv.Length )
{
throw new TclNumArgsException( interp, 2, argv, "?options? file ?file ...?" );
}
 
for ( int i = firstSource; i < argv.Length; i++ )
{
 
deleteOneFile( interp, argv[i].ToString(), force );
}
}
private static void deleteOneFile( Interp interp, string fileName, bool force )
{
if ( fileName == ":memory:" )
return;
bool isDeleted = true;
FileInfo fileObj = FileUtil.getNewFileObj( interp, fileName );
 
// Trying to delete a file that does not exist is not
// considered an error, just a no-op
 
bool tmpBool;
if ( File.Exists( fileObj.FullName ) )
tmpBool = true;
else
tmpBool = Directory.Exists( fileObj.FullName );
if ( ( !tmpBool ) || ( fileName.Length == 0 ) )
{
return;
}
 
// If the file is a non-empty directory, recursively delete its children if
// the -force option was chosen. Otherwise, throw an error.
 
if ( Directory.Exists( fileObj.FullName ) && ( Directory.GetFileSystemEntries( fileObj.FullName ).Length > 0 ) )
{
if ( force )
{
string[] fileList = Directory.GetFileSystemEntries( fileObj.FullName );
for ( int i = 0; i < fileList.Length; i++ )
{
 
TclObject[] joinArrayObj = new TclObject[2];
joinArrayObj[0] = TclString.newInstance( fileName );
joinArrayObj[1] = TclString.newInstance( fileList[i] );
 
string child = FileUtil.joinPath( interp, joinArrayObj, 0, 2 );
deleteOneFile( interp, child, force );
}
}
else
{
throw new TclPosixException( interp, TclPosixException.ENOTEMPTY, "error deleting \"" + fileName + "\": directory not empty" );
}
}
try
{
bool tmpBool2;
if ( File.Exists( fileObj.FullName ) )
{
fileObj.Attributes = FileAttributes.Normal;
File.Delete( fileObj.FullName );
tmpBool2 = true;
}
else if ( Directory.Exists( fileObj.FullName ) )
{
Directory.Delete( fileObj.FullName );
tmpBool2 = true;
}
else
tmpBool2 = false;
isDeleted = tmpBool2;
}
catch ( IOException e )
{
throw new TclException( interp, e.Message );
}
catch ( System.Security.SecurityException e )
{
throw new TclException( interp, e.Message );
}
if ( !isDeleted )
{
throw new TclPosixException( interp, TclPosixException.EACCES, true, "error deleting \"" + fileName + "\": best guess at reason" );
}
}
private static void fileCopyRename( Interp interp, TclObject[] argv, bool copyFlag )
{
int firstSource = 2;
bool force = false;
 
for ( bool last = false; ( firstSource < argv.Length ) && ( !last ); firstSource++ )
{
 
 
if ( !argv[firstSource].ToString().StartsWith( "-" ) )
{
break;
}
int opt = TclIndex.get( interp, argv[firstSource], validOptions, "option", 1 );
switch ( opt )
{
 
case OPT_FORCE:
force = true;
break;
 
case OPT_LAST:
last = true;
break;
 
default:
throw new TclRuntimeError( "FileCmd.cmdProc: bad option " + opt + " index to validOptions" );
 
}
}
 
if ( firstSource >= ( argv.Length - 1 ) )
{
throw new TclNumArgsException( interp, firstSource, argv, "?options? source ?source ...? target" );
}
 
// WARNING: ignoring links because Java does not support them.
 
int target = argv.Length - 1;
 
string targetName = argv[target].ToString();
 
FileInfo targetObj = FileUtil.getNewFileObj( interp, targetName );
if ( Directory.Exists( targetObj.FullName ) )
{
// If the target is a directory, move each source file into target
// directory. Extract the tailname from each source, and append it to
// the end of the target path.
 
for ( int source = firstSource; source < target; source++ )
{
 
 
string sourceName = argv[source].ToString();
 
if ( targetName.Length == 0 )
{
copyRenameOneFile( interp, sourceName, targetName, copyFlag, force );
}
else
{
string tailName = getTail( interp, sourceName );
 
TclObject[] joinArrayObj = new TclObject[2];
joinArrayObj[0] = TclString.newInstance( targetName );
joinArrayObj[1] = TclString.newInstance( tailName );
 
string fullTargetName = FileUtil.joinPath( interp, joinArrayObj, 0, 2 );
 
copyRenameOneFile( interp, sourceName, fullTargetName, copyFlag, force );
}
}
}
else
{
// If there is more than 1 source file and the target is not a
// directory, then throw an exception.
 
if ( firstSource + 1 != target )
{
string action;
if ( copyFlag )
{
action = "copying";
}
else
{
action = "renaming";
}
 
throw new TclPosixException( interp, TclPosixException.ENOTDIR, "error " + action + ": target \"" + argv[target].ToString() + "\" is not a directory" );
}
 
string sourceName = argv[firstSource].ToString();
copyRenameOneFile( interp, sourceName, targetName, copyFlag, force );
}
}
private static void copyRenameOneFile( Interp interp, string sourceName, string targetName, bool copyFlag, bool force )
{
// Copying or renaming a file onto itself is a no-op if force is chosen,
// otherwise, it will be caught later as an EEXISTS error.
 
if ( force && sourceName.Equals( targetName ) )
{
return;
}
 
// Check that the source exists and that if -force was not specified, the
// target doesn't exist.
//
// Prevent copying/renaming a file onto a directory and
// vice-versa. This is a policy decision based on the fact that
// existing implementations of copy and rename on all platforms
// also prevent this.
 
string action;
if ( copyFlag )
{
action = "copying";
}
else
{
action = "renaming";
}
 
FileInfo sourceFileObj = FileUtil.getNewFileObj( interp, sourceName );
bool tmpBool;
if ( File.Exists( sourceFileObj.FullName ) )
tmpBool = true;
else
tmpBool = Directory.Exists( sourceFileObj.FullName );
if ( ( !tmpBool ) || ( sourceName.Length == 0 ) )
{
throw new TclPosixException( interp, TclPosixException.ENOENT, true, "error " + action + " \"" + sourceName + "\"" );
}
 
if ( targetName.Length == 0 )
{
throw new TclPosixException( interp, TclPosixException.ENOENT, true, "error " + action + " \"" + sourceName + "\" to \"" + targetName + "\"" );
}
FileInfo targetFileObj = FileUtil.getNewFileObj( interp, targetName );
bool tmpBool2;
if ( File.Exists( targetFileObj.FullName ) )
tmpBool2 = true;
else
tmpBool2 = Directory.Exists( targetFileObj.FullName );
if ( tmpBool2 && !force )
{
throw new TclPosixException( interp, TclPosixException.EEXIST, true, "error " + action + " \"" + sourceName + "\" to \"" + targetName + "\"" );
}
 
if ( Directory.Exists( sourceFileObj.FullName ) && !Directory.Exists( targetFileObj.FullName ) )
{
throw new TclPosixException( interp, TclPosixException.EISDIR, "can't overwrite file \"" + targetName + "\" with directory \"" + sourceName + "\"" );
}
if ( Directory.Exists( targetFileObj.FullName ) && !Directory.Exists( sourceFileObj.FullName ) )
{
throw new TclPosixException( interp, TclPosixException.EISDIR, "can't overwrite directory \"" + targetName + "\" with file \"" + sourceName + "\"" );
}
 
if ( !copyFlag )
{
// Perform the rename procedure.
 
try
{
sourceFileObj.MoveTo( targetFileObj.FullName );
}
catch ( Exception e )
{
throw new TclPosixException( interp, TclPosixException.EACCES, true, "error renaming \"" + sourceName + "\" to \"" + targetName + "\"" );
}
// {
//
// if (Directory.Exists(targetFileObj.FullName))
// {
// throw new TclPosixException(interp, TclPosixException.EEXIST, true, "error renaming \"" + sourceName + "\" to \"" + targetName + "\"");
// }
//
// throw new TclPosixException(interp, TclPosixException.EACCES, true, "error renaming \"" + sourceName + "\" to \"" + targetName + "\": best guess at reason");
// }
}
else
{
// Perform the copy procedure.
 
try
{
sourceFileObj.CopyTo( targetFileObj.FullName, true );
}
catch ( IOException e )
{
throw new TclException( interp, "error copying: " + e.Message );
}
}
}
private static void fileSetReadOnly( Interp interp, TclObject[] argv )
{
int firstSource = 2;
 
for ( bool last = false; ( firstSource < argv.Length ) && ( !last ); firstSource++ )
{
if ( !argv[firstSource].ToString().StartsWith( "-" ) )
{
break;
}
}
 
if ( firstSource >= argv.Length )
{
throw new TclNumArgsException( interp, 2, argv, "?options? file ?file ...?" );
}
 
for ( int i = firstSource; i < argv.Length; i++ )
{
 
setReadOnlyOneFile( interp, argv[i].ToString() );
}
}
private static void setReadOnlyOneFile( Interp interp, string fileName )
{
FileInfo fileObj = FileUtil.getNewFileObj( interp, fileName );
try
{
fileObj.Attributes = FileAttributes.ReadOnly;
}
catch ( IOException e )
{
throw new TclException( interp, e.Message );
}
catch ( System.Security.SecurityException e )
{
throw new TclException( interp, e.Message );
}
}
static FileCmd()
{
{
// File.listRoots()
Type[] parameterTypes = new Type[0];
try
{
listRootsMethod = typeof( FileInfo ).GetMethod( "listRoots", (System.Type[])parameterTypes );
}
catch ( System.MethodAccessException e )
{
listRootsMethod = null;
}
}
}
} // end FileCmd class
}
/trunk/TCL/src/commands/FlushCmd.cs
@@ -0,0 +1,63 @@
/*
* FlushCmd.java --
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: FlushCmd.java,v 1.1.1.1 1998/10/14 21:09:18 cvsadmin Exp $
*
*/
using System;
using System.IO;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "flush" command in Tcl.</summary>
 
class FlushCmd : Command
{
 
/// <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;
}
}
}
/trunk/TCL/src/commands/ForCmd.cs
@@ -0,0 +1,126 @@
/*
* ForCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ForCmd.java,v 1.1.1.1 1998/10/14 21:09:19 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "for" command in Tcl.</summary>
 
class ForCmd : Command
{
/*
* This procedure is invoked to process the "for" Tcl command.
* See the user documentation for details on what it does.
*
* @param interp the current interpreter.
* @param argv command arguments.
* @exception TclException if script causes error.
*/
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
if ( argv.Length != 5 )
{
throw new TclNumArgsException( interp, 1, argv, "start test next command" );
}
 
TclObject start = argv[1];
 
string test = argv[2].ToString();
TclObject next = argv[3];
TclObject command = argv[4];
 
bool done = false;
try
{
interp.eval( start, 0 );
}
catch ( TclException e )
{
interp.addErrorInfo( "\n (\"for\" initial command)" );
throw;
}
 
while ( !done )
{
if ( !interp.expr.evalBoolean( interp, test ) )
{
break;
}
 
try
{
interp.eval( command, 0 );
}
catch ( TclException e )
{
switch ( e.getCompletionCode() )
{
 
case TCL.CompletionCode.BREAK:
done = true;
break;
 
 
case TCL.CompletionCode.CONTINUE:
break;
 
 
case TCL.CompletionCode.ERROR:
interp.addErrorInfo( "\n (\"for\" body line " + interp.errorLine + ")" );
throw;
 
 
default:
throw;
 
}
}
 
if ( !done )
{
try
{
interp.eval( next, 0 );
}
catch ( TclException e )
{
switch ( e.getCompletionCode() )
{
 
case TCL.CompletionCode.BREAK:
done = true;
break;
 
 
case TCL.CompletionCode.CONTINUE:
break;
 
 
default:
interp.addErrorInfo( "\n (\"for\" loop-end command)" );
throw;
 
}
}
}
}
 
interp.resetResult();
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/ForeachCmd.cs
@@ -0,0 +1,161 @@
/*
* ForeachCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ForeachCmd.java,v 1.4 1999/08/07 06:44:04 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "Foreach" command in Tcl.</summary>
 
class ForeachCmd : Command
{
/// <summary> Tcl_ForeachObjCmd -> ForeachCmd.cmdProc
///
/// This procedure is invoked to process the "foreach" Tcl command.
/// See the user documentation for details on what it does.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="objv">command arguments.
/// </param>
/// <exception cref=""> TclException if script causes error.
/// </exception>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
if ( objv.Length < 4 || ( objv.Length % 2 ) != 0 )
{
throw new TclNumArgsException( interp, 1, objv, "varList list ?varList list ...? command" );
}
 
// foreach {n1 n2} {1 2 3 4} {n3} {1 2} {puts $n1-$n2-$n3}
// name[0] = {n1 n2} value[0] = {1 2 3 4}
// name[1] = {n3} value[0] = {1 2}
 
TclObject[] name = new TclObject[( objv.Length - 2 ) / 2];
TclObject[] value = new TclObject[( objv.Length - 2 ) / 2];
 
int c, i, j, base_;
int maxIter = 0;
TclObject command = objv[objv.Length - 1];
bool done = false;
 
for ( i = 0; i < objv.Length - 2; i += 2 )
{
int x = i / 2;
name[x] = objv[i + 1];
value[x] = objv[i + 2];
 
int nSize = TclList.getLength( interp, name[x] );
int vSize = TclList.getLength( interp, value[x] );
 
if ( nSize == 0 )
{
throw new TclException( interp, "foreach varlist is empty" );
}
 
int iter = ( vSize + nSize - 1 ) / nSize;
if ( maxIter < iter )
{
maxIter = iter;
}
}
 
for ( c = 0; !done && c < maxIter; c++ )
{
// Set up the variables
 
for ( i = 0; i < objv.Length - 2; i += 2 )
{
int x = i / 2;
int nSize = TclList.getLength( interp, name[x] );
base_ = nSize * c;
for ( j = 0; j < nSize; j++ )
{
// Test and see if the name variable is an array.
 
 
Var[] result = Var.lookupVar( interp, name[x].ToString(), null, 0, null, false, false );
Var var = null;
 
if ( result != null )
{
if ( result[1] != null )
{
var = result[1];
}
else
{
var = result[0];
}
}
 
try
{
if ( base_ + j >= TclList.getLength( interp, value[x] ) )
{
interp.setVar( TclList.index( interp, name[x], j ), TclString.newInstance( "" ), 0 );
}
else
{
interp.setVar( TclList.index( interp, name[x], j ), TclList.index( interp, value[x], base_ + j ), 0 );
}
}
catch ( TclException e )
{
 
throw new TclException( interp, "couldn't set loop variable: \"" + TclList.index( interp, name[x], j ) + "\"" );
}
}
}
 
// Execute the script
 
try
{
interp.eval( command, 0 );
}
catch ( TclException e )
{
switch ( e.getCompletionCode() )
{
 
case TCL.CompletionCode.BREAK:
done = true;
break;
 
 
case TCL.CompletionCode.CONTINUE:
continue;
 
 
case TCL.CompletionCode.ERROR:
interp.addErrorInfo( "\n (\"foreach\" body line " + interp.errorLine + ")" );
throw;
 
 
default:
throw;
 
}
}
}
 
interp.resetResult();
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/FormatCmd.cs
@@ -0,0 +1,1220 @@
/*
* FormatCmd.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: FormatCmd.java,v 1.7 2003/02/01 00:56:29 mdejong Exp $
*
*/
using System;
using System.Text;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "format" command in Tcl.</summary>
 
class FormatCmd : Command
{
 
private const int LEFT_JUSTIFY = 1;
private const int SHOW_SIGN = 2;
private const int SPACE_OR_SIGN = 4;
private const int PAD_W_ZERO = 8;
private const int ALT_OUTPUT = 16;
private const int SIGNED_VALUE = 32;
private const int RADIX = 1; // Integer types. %d, %x, %o
private const int FLOAT = 2; // Floating point. %f
private const int EXP = 3; // Exponentional. %e and %E
private const int GENERIC = 4; // Floating or exponential,
// depending on exponent. %g
 
/// <summary> This procedure is invoked to process the "format" Tcl command.
/// See the user documentation for details on what it does.
///
/// The first argument to the cmdProc is the formatString. The cmdProc
/// simply copies all the chars into the sbuf until a '%' is found. At
/// this point the cmdProc parces the formatString and determines the
/// format parameters. The parcing of the formatString can be broken into
/// six possible phases:
///
/// Phase 0 - Simply Print: If the next char is %
/// Phase 1 - XPG3 Position Specifier: If the format [1-n]$ is used
/// Phase 2 - A Set of Flags: One or more of the following + -
/// [space] 0 #
/// Phase 3 - A Minimun Field Width Either [integer] or *
/// Phase 4 - A Precision If the format .[integer] or .*
/// Phase 5 - A Length Modifier If h is present
/// Phase 6 - A Conversion Character If one of the following is used
/// d u i o x X c s f E g G
///
/// Any phase can skip ahead one or more phases, but are not allowed
/// to move back to previous phases. Once the parameters are determined
/// the cmdProc calls one of three private methods that returns a fully
/// formatted string. This loop occurs for ever '%' in the formatString.
/// </summary>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
 
 
StringBuilder sbuf; // Stores the return value of the parsed
// format string
StrtoulResult stoul; // A return object to the strtoul call
char[] format; // The format argument is converted to a char
// array and manipulated as such
int phase; // Stores the current phase of the parsing
int width; // Minimum field width
int precision; // Field precision from field specifier
int fmtFlags; // Used to store the format flags ( #,+,etc)
int argIndex; // Index of argument to substitute next.
int fmtIndex; // Used to locate end of the format fields.
int endIndex; // Used to locate end of numerical fields.
int intValue; // Generic storage variable
long lngValue; // Store the TclInteger.get() result
double dblValue; // Store the TclDouble.get() result
bool noPercent; // Special case for speed: indicates there's
// no field specifier, just a string to copy.
bool xpgSet; // Indicates that xpg has been used for the
// particular format of the main while loop
bool gotXpg; // True means that an XPG3 %n$-style
// specifier has been seen.
bool gotSequential; // True means that a regular sequential
// (non-XPG3) conversion specifier has
// been seen.
bool useShort; // Value to be printed is short
// (half word).
bool precisionSet; // Used for f, e, and E conversions
bool cont; // Used for phase 3
 
if ( argv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, argv, "formatString ?arg arg ...?" );
}
 
argIndex = 2;
fmtIndex = 0;
gotXpg = gotSequential = false;
 
format = argv[1].ToString().ToCharArray();
sbuf = new StringBuilder();
 
// So, what happens here is to scan the format string one % group
// at a time, making many individual appends to the StringBuffer.
 
while ( fmtIndex < format.Length )
{
fmtFlags = phase = width = 0;
noPercent = true;
xpgSet = precisionSet = useShort = false;
precision = -1;
 
// Append all characters to sbuf that are not used for the
// format specifier.
 
 
if ( format[fmtIndex] != '%' )
{
int i;
for ( i = fmtIndex; ( i < format.Length ); i++ )
{
if ( format[i] == '%' )
{
noPercent = false;
break;
}
}
sbuf.Append( new string( format, fmtIndex, i - fmtIndex ) );
fmtIndex = i;
if ( noPercent )
{
break;
}
}
 
// If true, then a % has been indicated but we are at the end
// of the format string. Call function to throw exception.
 
if ( fmtIndex + 1 >= format.Length )
{
errorEndMiddle( interp );
}
 
// Phase 0:
// Check for %%. If true then simply write a single '%'
// to the list.
 
checkOverFlow( interp, format, fmtIndex + 1 );
if ( format[fmtIndex + 1] == '%' )
{
sbuf.Append( "%" );
fmtIndex += 2;
// Re-enter the loop
 
continue;
}
 
fmtIndex++;
checkOverFlow( interp, format, fmtIndex );
if ( System.Char.IsDigit( format[fmtIndex] ) )
{
// Parce the format array looking for the end of
// the number.
 
stoul = strtoul( format, fmtIndex );
intValue = (int)stoul.value;
endIndex = stoul.index;
 
if ( format[endIndex] == '$' )
{
if ( intValue == 0 )
{
errorBadIndex( interp, true );
}
 
// Phase 1:
// Check for an XPG3-style %n$ specification.
// Note: there must not be a mixture of XPG3
// specs and non-XPG3 specs in the same format string.
 
if ( gotSequential )
{
errorMixedXPG( interp );
}
gotXpg = true;
xpgSet = true;
phase = 2;
fmtIndex = endIndex + 1;
argIndex = intValue + 1;
if ( ( argIndex < 2 ) || ( argIndex >= argv.Length ) )
{
errorBadIndex( interp, gotXpg );
}
}
else
{
// Phase 3:
// Format jumped straight to phase 3; Setting
// width field. Again, verify that all format
// specifiers are sequential.
 
if ( gotXpg )
{
errorMixedXPG( interp );
}
gotSequential = true;
if ( format[fmtIndex] != '0' )
{
fmtIndex = endIndex;
width = intValue;
phase = 4;
}
}
}
else
{
if ( gotXpg )
{
errorMixedXPG( interp );
}
gotSequential = true;
}
 
// Phase 2:
// Setting the Format Flags. At this point the phase value
// can be either zero or three. Anything greater is an
// incorrect format.
 
if ( phase < 3 )
{
checkOverFlow( interp, format, fmtIndex );
char ch = format[fmtIndex];
cont = true;
while ( cont )
{
switch ( ch )
{
 
case '-':
{
fmtFlags |= LEFT_JUSTIFY;
break;
}
 
case '#':
{
fmtFlags |= ALT_OUTPUT;
break;
}
 
case '0':
{
fmtFlags |= PAD_W_ZERO;
break;
}
 
case ' ':
{
fmtFlags |= SPACE_OR_SIGN;
break;
}
 
case '+':
{
fmtFlags |= SHOW_SIGN;
break;
}
 
default:
{
cont = false;
}
break;
 
}
if ( cont )
{
fmtIndex++;
checkOverFlow( interp, format, fmtIndex );
ch = format[fmtIndex];
}
}
phase = 3;
}
 
// Phase 3:
// Setting width field. Partially redundant code from the
// Phase 1 if/else statement, but this is made to run fast.
 
checkOverFlow( interp, format, fmtIndex );
if ( System.Char.IsDigit( format[fmtIndex] ) )
{
stoul = strtoul( format, fmtIndex );
width = (int)stoul.value;
fmtIndex = stoul.index;
}
else if ( format[fmtIndex] == '*' )
{
if ( argv.Length > argIndex )
{
width = TclInteger.get( interp, argv[argIndex] );
if ( width < 0 )
{
width = -width;
fmtFlags |= LEFT_JUSTIFY;
}
argIndex++;
fmtIndex++;
}
}
 
// Phase 4:
// Setting the precision field.
 
checkOverFlow( interp, format, fmtIndex );
if ( format[fmtIndex] == '.' )
{
fmtIndex++;
checkOverFlow( interp, format, fmtIndex );
if ( System.Char.IsDigit( format[fmtIndex] ) )
{
precisionSet = true;
 
stoul = strtoul( format, fmtIndex );
precision = (int)stoul.value;
fmtIndex = stoul.index;
}
else if ( format[fmtIndex] == '*' )
{
if ( argv.Length > argIndex )
{
precisionSet = true;
precision = TclInteger.get( interp, argv[argIndex] );
argIndex++;
fmtIndex++;
checkOverFlow( interp, format, fmtIndex );
}
}
else
{
// Format field had a '.' without an integer or '*'
// preceeding it (eg %2.d or %2.-5d)
 
errorBadField( interp, format[fmtIndex] );
}
}
 
// Phase 5:
// Setting the length modifier.
 
if ( format[fmtIndex] == 'h' )
{
fmtIndex++;
checkOverFlow( interp, format, fmtIndex );
useShort = true;
}
else if ( format[fmtIndex] == 'l' )
{
fmtIndex++;
checkOverFlow( interp, format, fmtIndex );
 
// 'l' is ignored, but should still be processed.
}
 
if ( ( argIndex < 2 ) || ( argIndex >= argv.Length ) )
{
errorBadIndex( interp, gotXpg );
}
 
// Phase 6:
// Setting conversion field.
// At this point, variables are initialized as follows:
//
// width The specified field width. This is always
// non-negative. Zero is the default.
// precision The specified precision. The default
// is -1.
// argIndex The argument index from the argv array
// for the appropriate arg.
// fmtFlags The format flags are set via bitwise
// operations. Below are the bits
// and their meanings.
 
// ALT_OUTPUT set if a '#' is present.
// SHOW_SIGN set if a '+' is present.
// SPACE_OR_SIGN set if a ' ' is present.
// LEFT_JUSTIFY set if a '-' is present or if the
// field width was negative.
// PAD_W_ZERO set if a '0' is present
 
string strValue = "";
char index = format[fmtIndex];
 
switch ( index )
{
 
case 'u':
case 'd':
case 'o':
case 'x':
case 'X':
case 'i':
{
if ( index == 'u' )
{
// Since Java does not provide unsigned ints we need to
// make our own. If the value is negative we need to
// clear out all of the leading bits from the 33rd bit
// and on. The result is a long value equal to that
// of an unsigned int.
 
lngValue = (long)TclInteger.get( interp, argv[argIndex] );
if ( lngValue < 0 )
{
lngValue = ( lngValue << 32 );
lngValue = ( SupportClass.URShift( lngValue, 32 ) );
}
}
else
{
fmtFlags |= SIGNED_VALUE;
lngValue = (long)TclInteger.get( interp, argv[argIndex] );
}
 
// If the useShort option has been selected, we need
// to clear all but the first 16 bits.
 
if ( useShort )
{
lngValue = ( lngValue << 48 );
lngValue = ( lngValue >> 48 );
}
 
if ( index == 'o' )
{
sbuf.Append( cvtLngToStr( lngValue, width, precision, fmtFlags, 8, "01234567".ToCharArray(), "0" ) );
}
else if ( index == 'x' )
{
sbuf.Append( cvtLngToStr( lngValue, width, precision, fmtFlags, 16, "0123456789abcdef".ToCharArray(), "0x" ) );
}
else if ( index == 'X' )
{
sbuf.Append( cvtLngToStr( lngValue, width, precision, fmtFlags, 16, "0123456789ABCDEF".ToCharArray(), "0X" ) );
}
else
{
sbuf.Append( cvtLngToStr( lngValue, width, precision, fmtFlags, 10, "0123456789".ToCharArray(), "" ) );
}
break;
}
 
case 'c':
{
intValue = 0;
char[] arr = new char[] { (char)TclInteger.get( interp, argv[argIndex] ) };
strValue = new string( arr );
sbuf.Append( cvtStrToStr( strValue, width, precision, fmtFlags ) );
break;
}
 
case 's':
{
 
strValue = argv[argIndex].ToString();
sbuf.Append( cvtStrToStr( strValue, width, precision, fmtFlags ) );
break;
}
 
case 'f':
{
dblValue = TclDouble.get( interp, argv[argIndex] );
sbuf.Append( cvtDblToStr( dblValue, width, precision, fmtFlags, 10, "0123456789".ToCharArray(), "", FLOAT ) );
break;
}
 
case 'e':
{
dblValue = TclDouble.get( interp, argv[argIndex] );
sbuf.Append( cvtDblToStr( dblValue, width, precision, fmtFlags, 10, "e".ToCharArray(), "", EXP ) );
break;
}
 
case 'E':
{
dblValue = TclDouble.get( interp, argv[argIndex] );
sbuf.Append( cvtDblToStr( dblValue, width, precision, fmtFlags, 10, "E".ToCharArray(), "", EXP ) );
break;
}
 
case 'g':
{
dblValue = TclDouble.get( interp, argv[argIndex] );
sbuf.Append( cvtDblToStr( dblValue, width, precision, fmtFlags, 10, "e".ToCharArray(), "", GENERIC ) );
break;
}
 
case 'G':
{
dblValue = TclDouble.get( interp, argv[argIndex] );
sbuf.Append( cvtDblToStr( dblValue, width, precision, fmtFlags, 10, "E".ToCharArray(), "", GENERIC ) );
break;
}
 
default:
{
errorBadField( interp, format[fmtIndex] );
}
break;
 
}
fmtIndex++;
argIndex++;
}
interp.setResult( sbuf.ToString() );
return TCL.CompletionCode.RETURN;
}
 
 
/// <summary> This procedure is invoked in "phase 6" od the Format cmdProc. It
/// converts the lngValue to a string with a specified format determined by
/// the other input variables.
/// </summary>
/// <param name="lngValue"> - Is the value of the argument input
/// </param>
/// <param name="width"> - The minimum width of the string.
/// </param>
/// <param name="precision">- The minimum width if the integer. If the string len
/// is less than precision, leading 0 are appended.
/// </param>
/// <param name="flags"> - Specifies various formatting to the string
/// representation (-, +, space, 0, #)
/// </param>
/// <param name="base"> - The base of the integer (8, 10, 16)
/// </param>
/// <param name="charSet"> - The char set to use for the conversion to ascii OR
/// The char used for sci notation.
/// </param>
/// <param name="altPrefix">- If not empty, str to append on the beginnig of the
/// resulting string (eg 0 or 0x or 0X ).
/// </param>
/// <returns> String representation of the long.
/// </returns>
 
private string cvtLngToStr( long lngValue, int width, int precision, int flags, int base_, char[] charSet, string altPrefix )
{
StringBuilder sbuf = new StringBuilder( 100 );
StringBuilder tmpBuf = new StringBuilder( 0 ).Append( "" );
 
int i;
int length;
int nspace;
int prefixSize = 0;
char prefix = (char)( 0 );
 
// For the format %#x, the value zero is printed "0" not "0x0".
// I think this is stupid.
 
if ( lngValue == 0 )
{
flags = ( flags | ALT_OUTPUT );
}
 
 
if ( ( flags & SIGNED_VALUE ) != 0 )
{
if ( lngValue < 0 )
{
if ( altPrefix.Length > 0 )
{
lngValue = ( lngValue << 32 );
lngValue = ( SupportClass.URShift( lngValue, 32 ) );
}
else
{
lngValue = -lngValue;
prefix = '-';
prefixSize = 1;
}
}
else if ( ( flags & SHOW_SIGN ) != 0 )
{
prefix = '+';
prefixSize = 1;
}
else if ( ( flags & SPACE_OR_SIGN ) != 0 )
{
prefix = ' ';
prefixSize = 1;
}
}
 
if ( ( ( PAD_W_ZERO & flags ) != 0 ) && ( precision < width - prefixSize ) )
{
precision = width - prefixSize;
}
 
// Convert to ascii
 
do
{
sbuf.Insert( 0, charSet[(int)( lngValue % base_ )] );
lngValue = lngValue / base_;
}
while ( lngValue > 0 );
 
length = sbuf.Length;
for ( i = ( precision - length ); i > 0; i-- )
{
sbuf.Insert( 0, '0' );
}
if ( prefix != 0 )
{
sbuf.Insert( 0, prefix );
}
if ( ( flags & ALT_OUTPUT ) != 0 )
{
if ( ( altPrefix.Length > 0 ) && ( sbuf[0] != altPrefix[0] ) )
{
sbuf.Insert( 0, altPrefix );
}
}
 
// The text of the conversion is pointed to by "bufpt" and is
// "length" characters long. The field width is "width". Do
// the output.
 
nspace = width - sbuf.Length;
if ( nspace > 0 )
{
tmpBuf = new StringBuilder( nspace );
for ( i = 0; i < nspace; i++ )
{
tmpBuf.Append( " " );
}
}
 
if ( ( LEFT_JUSTIFY & flags ) != 0 )
{
// left justified
 
return sbuf.ToString() + tmpBuf.ToString();
}
else
{
// right justified
 
return tmpBuf.ToString() + sbuf.ToString();
}
}
 
internal static string toString( double dblValue, int precision, int base_ )
{
return cvtDblToStr( dblValue, 0, precision, 0, base_, "e".ToCharArray(), null, GENERIC );
}
 
/// <summary> This procedure is invoked in "phase 6" od the Format cmdProc. It
/// converts the lngValue to a string with a specified format determined
/// by the other input variables.
/// </summary>
/// <param name="dblValue"> - Is the value of the argument input
/// </param>
/// <param name="width"> - The minimum width of the string.
/// </param>
/// <param name="precision">- The minimum width if the integer. If the string len
/// is less than precision, leading 0 are appended.
/// </param>
/// <param name="flags"> - Specifies various formatting to the string
/// representation (-, +, space, 0, #)
/// </param>
/// <param name="base"> - The base of the integer (8, 10, 16)
/// </param>
/// <param name="charSet"> - The char set to use for the conversion to ascii OR
/// The char used for sci notation.
/// </param>
/// <param name="altPrefix">- If not empty, str to append on the beginnig of the
/// resulting string (eg 0 or 0x or 0X ).
/// </param>
/// <param name="xtype"> - Either FLOAT, EXP, or GENERIC depending on the
/// format specifier.
/// </param>
/// <returns> String representation of the long.
/// </returns>
 
private static string cvtDblToStr( double dblValue, int width, int precision, int flags, int base_, char[] charSet, string altPrefix, int xtype )
{
if ( base_ == 10 )
return dblValue.ToString();
StringBuilder sbuf = new StringBuilder( 100 );
int i;
int exp;
int length;
int count;
int digit;
int prefixSize = 0;
char prefix = (char)( 0 );
double rounder;
bool flag_exp = false; // Flag for exponential representation
bool flag_rtz = true; // Flag for "remove trailing zeros"
bool flag_dp = true; // Flag for remove "decimal point"
 
if ( System.Double.IsNaN( dblValue ) )
{
return "NaN";
}
if ( dblValue == System.Double.NegativeInfinity )
{
return "-Inf";
}
if ( dblValue == System.Double.PositiveInfinity )
{
return "Inf";
}
 
// If precision < 0 (eg -1) then the precision defaults
 
if ( precision < 0 )
{
precision = 6;
}
 
if ( dblValue < 0.0 )
{
dblValue = -dblValue;
prefix = '-';
prefixSize = 1;
}
// ATK I do not know how C# can note negative 0
// else if (dblValue == 0.0 && (dblValue).Equals((- 0.0)))
// {
// // Handle -0.0
// //
// // 15.19.1 "Numerical Comparison Operators <, <=, >, and >= "
// // of the Java Language Spec says:
// // "Positive zero and negative zero are considered
// // equal. Therefore, -0.0<0.0 is false, for example, but
// // -0.0<=0.0 is true."
// //
// // The Double.equal man page says:
// // "If d1 represents +0.0 while d2 represents -0.0, or
// // vice versa, the equal test has the value false, even
// // though +0.0==-0.0 has the value true. This allows
// // hashtables to operate properly.
//
// dblValue = - dblValue;
// prefix = '-';
// prefixSize = 1;
// }
else if ( ( flags & SHOW_SIGN ) != 0 )
{
prefix = '+';
prefixSize = 1;
}
else if ( ( flags & SPACE_OR_SIGN ) != 0 )
{
prefix = ' ';
prefixSize = 1;
}
 
// For GENERIC xtypes the precision includes the ones digit
// so just decrement to get the correct precision.
 
if ( xtype == GENERIC && precision > 0 )
{
precision--;
}
 
// Rounding works like BSD when the constant 0.4999 is used. Wierd!
//for (i = precision, rounder = 0.4999; i > 0; i--, rounder *= 0.1)
//;
string ss = "0." + new String( '0', precision ) + "4999";
rounder = Convert.ToDouble( ss );
if ( xtype == FLOAT )
{
dblValue += rounder;
}
 
// Normalize dblValue to within 10.0 > dblValue >= 1.0
 
exp = 0;
if ( dblValue > 0.0 )
{
int k = 0;
while ( ( dblValue >= 1e8 ) && ( k++ < 100 ) )
{
dblValue *= 1e-8;
exp += 8;
}
while ( ( dblValue >= 10.0 ) && ( k++ < 100 ) )
{
dblValue *= 0.1;
exp++;
}
while ( ( dblValue < 1e-8 ) && ( k++ < 100 ) )
{
dblValue *= 1e8;
exp -= 8;
}
while ( ( dblValue < 1.0 ) && ( k++ < 100 ) )
{
dblValue *= 10.0;
exp--;
}
if ( k >= 100 )
{
return "NaN";
}
}
 
// If the field type is GENERIC, then convert to either EXP
// or FLOAT, as appropriate.
 
flag_exp = xtype == EXP;
if ( xtype != FLOAT )
{
//dblValue += rounder;
if ( dblValue >= 10.0 )
{
dblValue *= 0.1;
exp++;
}
}
if ( xtype == GENERIC )
{
flag_rtz = !( ( flags & ALT_OUTPUT ) != 0 );
if ( ( exp < -4 ) || ( exp > precision ) )
{
xtype = EXP;
}
else
{
precision = ( precision - exp );
xtype = FLOAT;
}
}
else
{
flag_rtz = false;
}
 
// The "exp+precision" test causes output to be of type EXP if
// the precision is too large to fit in buf[].
 
count = 0;
if ( xtype == FLOAT )
{
flag_dp = ( ( precision > 0 ) || ( ( flags & ALT_OUTPUT ) != 0 ) );
if ( prefixSize > 0 )
{
// Sign
 
sbuf.Append( prefix );
}
if ( exp < 0 )
{
// Digits before "."
 
sbuf.Append( '0' );
}
for ( ; exp >= 0; exp-- )
{
if ( count++ >= 16 )
{
sbuf.Append( '0' );
}
else
{
 
digit = (int)dblValue;
dblValue = ( dblValue - digit ) * 10.0;
sbuf.Append( digit );
}
}
if ( flag_dp )
{
sbuf.Append( '.' );
}
for ( exp++; ( exp < 0 ) && ( precision > 0 ); precision--, exp++ )
{
sbuf.Append( '0' );
}
while ( ( precision-- ) > 0 )
{
if ( count++ >= 16 )
{
sbuf.Append( '0' );
}
else
{
 
digit = (int)dblValue;
dblValue = ( dblValue - digit ) * 10.0;
sbuf.Append( digit );
}
}
 
if ( flag_rtz && flag_dp )
{
// Remove trailing zeros and "."
 
int len, index;
len = index = 0;
for ( len = ( sbuf.Length - 1 ), index = 0; ( len >= 0 ) && ( sbuf[len] == '0' ); len--, index++ )
;
 
if ( ( len >= 0 ) && ( sbuf[len] == '.' ) )
{
index++;
}
 
if ( index > 0 )
{
sbuf = new StringBuilder( sbuf.ToString().Substring( 0, ( sbuf.Length - index ) - ( 0 ) ) );
}
}
}
else
{
// EXP or GENERIC
 
flag_dp = ( ( precision > 0 ) || ( ( flags & ALT_OUTPUT ) != 0 ) );
 
if ( prefixSize > 0 )
{
sbuf.Append( prefix );
}
 
digit = (int)dblValue;
dblValue = ( dblValue - digit ) * 10.0;
sbuf.Append( digit );
if ( flag_dp )
{
sbuf.Append( '.' );
}
while ( precision-- > 0 )
{
if ( count++ >= 16 )
{
sbuf.Append( '0' );
}
else
{
 
digit = (int)dblValue;
dblValue = ( dblValue - digit ) * 10.0;
sbuf.Append( digit );
}
}
 
if ( flag_rtz && flag_dp )
{
// Remove trailing zeros and "."
 
for ( i = 0, length = ( sbuf.Length - 1 ); ( length >= 0 ) && ( sbuf[length] == '0' ); length--, i++ )
;
 
if ( ( length >= 0 ) && ( sbuf[length] == '.' ) )
{
i++;
}
 
if ( i > 0 )
{
sbuf = new StringBuilder( sbuf.ToString().Substring( 0, ( sbuf.Length - i ) - ( 0 ) ) );
}
}
if ( ( exp != 0 ) || flag_exp )
{
sbuf.Append( charSet[0] );
if ( exp < 0 )
{
sbuf.Append( '-' );
exp = -exp;
}
else
{
sbuf.Append( '+' );
}
if ( exp >= 100 )
{
sbuf.Append( ( exp / 100 ) );
exp %= 100;
}
sbuf.Append( exp / 10 );
sbuf.Append( exp % 10 );
}
}
 
// The converted number is in sbuf. Output it.
// Note that the number is in the usual order, not reversed as with
// integer conversions.
 
length = sbuf.Length;
 
// Special case: Add leading zeros if the PAD_W_ZERO flag is
// set and we are not left justified
 
if ( ( ( PAD_W_ZERO & flags ) != 0 ) && ( ( LEFT_JUSTIFY & flags ) == 0 ) )
{
int nPad = width - length;
i = prefixSize;
while ( ( nPad-- ) > 0 )
{
sbuf.Insert( prefixSize, '0' );
}
length = width;
}
 
// Count the number of spaces remaining and creat a StringBuffer
// (tmpBuf) with the correct number of spaces.
 
int nspace = width - length;
StringBuilder tmpBuf = new StringBuilder( 0 ).Append( "" );
if ( nspace > 0 )
{
tmpBuf = new StringBuilder( nspace );
for ( i = 0; i < nspace; i++ )
{
tmpBuf.Append( " " );
}
}
 
if ( ( LEFT_JUSTIFY & flags ) != 0 )
{
// left justified
 
return sbuf.ToString() + tmpBuf.ToString();
}
else
{
// right justified
 
return tmpBuf.ToString() + sbuf.ToString();
}
}
 
/// <summary> This procedure is invoked in "phase 6" od the Format cmdProc. It
/// converts the strValue to a string with a specified format determined
/// by the other input variables.
/// </summary>
/// <param name="strValue"> - Is the String w/o formatting.
/// </param>
/// <param name="width"> - The minimum width of the string.
/// </param>
/// <param name="precision">- The minimum width if the integer. If the string
/// len is less than precision, leading 0 are
/// appended.
/// </param>
/// <param name="flags"> - Specifies various formatting to the string
/// representation (-, +, space, 0, #)
/// </param>
/// <returns> String representation of the integer.
/// </returns>
 
private static string cvtStrToStr( string strValue, int width, int precision, int flags )
{
string left = "";
string right = "";
 
if ( precision < 0 )
{
precision = 0;
}
 
if ( ( precision != 0 ) && ( precision < strValue.Length ) )
{
strValue = strValue.Substring( 0, ( precision ) - ( 0 ) );
}
 
if ( width > strValue.Length )
{
StringBuilder sbuf = new StringBuilder();
int index = ( width - strValue.Length );
for ( int i = 0; i < index; i++ )
{
if ( ( flags & PAD_W_ZERO ) != 0 )
{
sbuf.Append( '0' );
}
else
{
sbuf.Append( ' ' );
}
}
if ( ( LEFT_JUSTIFY & flags ) != 0 )
{
right = sbuf.ToString();
}
else
{
left = sbuf.ToString();
}
}
 
return ( left + strValue + right );
}
 
 
/// <summary> Search through the array while the current char is a digit. When end
/// of array occurs or the char is not a digit, stop the loop, convert the
/// sub-array into a long. At this point return a StrtoulResult object
/// that contains the new long value and the current pointer to the array.
///
/// </summary>
/// <param name="arr">- the array that contains a string representation of an int.
/// </param>
/// <param name="endIndex">- the arr index where the numeric value begins.
/// </param>
/// <returns> StrtoResult containing the value and new index/
/// </returns>
 
private StrtoulResult strtoul( char[] arr, int endIndex )
{
int orgIndex;
 
orgIndex = endIndex;
for ( ; endIndex < arr.Length; endIndex++ )
{
if ( !System.Char.IsDigit( arr[endIndex] ) )
{
break;
}
}
return ( new StrtoulResult( System.Int64.Parse( new string( arr, orgIndex, endIndex - orgIndex ) ), endIndex, 0 ) );
}
 
 
/*
*
* Error routines:
*
*/
 
 
/// <summary> Called whenever the fmtIndex in the cmdProc is changed. It verifies
/// the the array index is still within the bounds of the array. If no
/// throw error.
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method .
/// </param>
/// <param name="arr"> - The array to be checked.
/// </param>
/// <param name="index"> - The new value for the array index.
/// </param>
 
private static void checkOverFlow( Interp interp, char[] arr, int index )
{
if ( ( index >= arr.Length ) || ( index < 0 ) )
{
throw new TclException( interp, "\"%n$\" argument index out of range" );
}
}
 
 
/// <summary> Called whenever Sequential format specifiers are interlaced with
/// XPG format specifiers in one call to cmdProc.
///
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method .
/// </param>
 
private static void errorMixedXPG( Interp interp )
{
throw new TclException( interp, "cannot mix \"%\" and \"%n$\" conversion specifiers" );
}
 
 
/// <summary> Called whenever the argIndex access outside the argv array. If the
/// type is an XPG then the error message is different.
///
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method .
/// </param>
/// <param name="gotXpg"> - Boolean the determines if the current format is of a
/// XPG type or Sequential
/// </param>
 
private static void errorBadIndex( Interp interp, bool gotXpg )
{
if ( gotXpg )
{
throw new TclException( interp, "\"%n$\" argument index out of range" );
}
else
{
throw new TclException( interp, "not enough arguments for all format specifiers" );
}
}
 
 
/// <summary> Called whenever the current char in the format array is erroneous
///
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method .
/// </param>
/// <param name="fieldSpecifier"> - The erroneous character
/// </param>
 
private static void errorBadField( Interp interp, char fieldSpecifier )
{
throw new TclException( interp, "bad field specifier \"" + fieldSpecifier + "\"" );
}
 
 
/// <summary> Called whenever the a '%' is found but then the format string ends.
///
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method .
/// </param>
 
private static void errorEndMiddle( Interp interp )
{
throw new TclException( interp, "format string ended in middle of field specifier" );
}
}
}
/trunk/TCL/src/commands/GetsCmd.cs
@@ -0,0 +1,94 @@
/*
* GetsCmd.java --
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: GetsCmd.java,v 1.6 2003/03/08 03:42:44 mdejong Exp $
*
*/
using System.Text;
using System.IO;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "gets" command in Tcl.</summary>
 
class GetsCmd : Command
{
 
/// <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;
}
}
}
/trunk/TCL/src/commands/GlobCmd.cs
@@ -0,0 +1,832 @@
/*
* GlobCmd.java
*
* This file contains the Jacl implementation of the built-in Tcl "glob"
* command.
*
* Copyright (c) 1997-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: GlobCmd.java,v 1.5 1999/08/28 03:55:18 mo Exp $
*
*/
using System.IO;
using System.Text;
 
namespace tcl.lang
{
 
/*
* This class implements the built-in "glob" command in Tcl.
*/
 
class GlobCmd : Command
{
 
/*
* Special characters that are used for string matching.
*/
 
private static readonly char[] specCharArr = new char[] { '*', '[', ']', '?', '\\' };
 
/*
* Options to the glob command.
*/
 
private static readonly string[] validOptions = new string[] { "-nocomplain", "--" };
private const int OPT_NOCOMPLAIN = 0;
private const int OPT_LAST = 1;
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
bool noComplain = false; // If false, error msg will be returned
int index; // index of the char just after the end
// of the user name
int firstArg = 1; // index of the first non-switch arg
int i; // generic index
string arg; // generic arg string
string head = ""; // abs path of user name if provided
string tail = ""; // the remaining file path and pattern
TclObject resultList; // list of files that match the pattern
 
for ( bool last = false; ( firstArg < argv.Length ) && ( !last ); firstArg++ )
{
 
 
if ( !argv[firstArg].ToString().StartsWith( "-" ) )
{
break;
}
int opt = TclIndex.get( interp, argv[firstArg], validOptions, "switch", 1 );
switch ( opt )
{
 
case OPT_NOCOMPLAIN:
noComplain = true;
break;
 
case OPT_LAST:
last = true;
break;
 
default:
throw new TclException( interp, "GlobCmd.cmdProc: bad option " + opt + " index to validOptions" );
 
}
}
 
if ( firstArg >= argv.Length )
{
throw new TclNumArgsException( interp, 1, argv, "?switches? name ?name ...?" );
}
 
resultList = TclList.newInstance();
resultList.preserve();
 
for ( i = firstArg; i < argv.Length; i++ )
{
 
arg = argv[i].ToString();
 
string separators; // The system-specific file separators
switch ( JACL.PLATFORM )
{
 
case JACL.PLATFORM_WINDOWS:
separators = "/\\:";
break;
 
case JACL.PLATFORM_MAC:
if ( arg.IndexOf( (System.Char)':' ) == -1 )
{
separators = "/";
}
else
{
separators = ":";
}
break;
 
default:
separators = "/";
break;
 
}
 
// Perform tilde substitution, if needed.
 
index = 0;
if ( arg.StartsWith( "~" ) )
{
// Find the first path separator after the tilde.
 
for ( ; index < arg.Length; index++ )
{
char c = arg[index];
if ( c == '\\' )
{
if ( separators.IndexOf( (System.Char)arg[index + 1] ) != -1 )
{
break;
}
}
else if ( separators.IndexOf( (System.Char)c ) != -1 )
{
break;
}
}
 
// Determine the home directory for the specified user. Note
// that we don't allow special characters in the user name.
 
if ( strpbrk( arg.Substring( 1, ( index ) - ( 1 ) ).ToCharArray(), specCharArr ) < 0 )
{
try
{
head = FileUtil.doTildeSubst( interp, arg.Substring( 1, ( index ) - ( 1 ) ) );
}
catch ( TclException e )
{
if ( noComplain )
{
head = null;
}
else
{
throw new TclException( interp, e.Message );
}
}
}
else
{
if ( !noComplain )
{
throw new TclException( interp, "globbing characters not supported in user names" );
}
head = null;
}
 
if ( (System.Object)head == null )
{
if ( noComplain )
{
interp.setResult( "" );
return TCL.CompletionCode.RETURN;
}
else
{
return TCL.CompletionCode.RETURN;
}
}
if ( index != arg.Length )
{
index++;
}
}
 
tail = arg.Substring( index );
 
try
{
doGlob( interp, separators, new StringBuilder( head ), tail, resultList );
}
catch ( TclException e )
{
if ( noComplain )
{
continue;
}
else
{
throw new TclException( interp, e.Message );
}
}
}
 
// If the list is empty and the nocomplain switch was not set then
// generate and throw an exception. Always release the TclList upon
// completion.
 
try
{
if ( ( TclList.getLength( interp, resultList ) == 0 ) && !noComplain )
{
string sep = "";
StringBuilder ret = new StringBuilder();
 
ret.Append( "no files matched glob pattern" );
ret.Append( ( argv.Length == 2 ) ? " \"" : "s \"" );
 
for ( i = firstArg; i < argv.Length; i++ )
{
 
ret.Append( sep + argv[i].ToString() );
if ( i == firstArg )
{
sep = " ";
}
}
ret.Append( "\"" );
throw new TclException( interp, ret.ToString() );
}
else if ( TclList.getLength( interp, resultList ) > 0 )
{
interp.setResult( resultList );
}
}
finally
{
resultList.release();
}
return TCL.CompletionCode.RETURN;
}
private static int SkipToChar( string str, int sIndex, char match )
// Ccharacter to find.
{
int level, length, i;
bool quoted = false;
char c;
 
level = 0;
 
for ( i = sIndex, length = str.Length; i < length; i++ )
{
if ( quoted )
{
quoted = false;
continue;
}
c = str[i];
if ( ( level == 0 ) && ( c == match ) )
{
return i;
}
if ( c == '{' )
{
level++;
}
else if ( c == '}' )
{
level--;
}
else if ( c == '\\' )
{
quoted = true;
}
}
return -1;
}
private static void doGlob( Interp interp, string separators, StringBuilder headBuf, string tail, TclObject resultList )
{
int count = 0; // Counts the number of leading file
// spearators for the tail.
int pIndex; // Current index into tail
int tailIndex; // First char after initial file
// separators of the tail
int tailLen = tail.Length; // Cache the length of the tail
int headLen = headBuf.Length; // Cache the length of the head
int baseLen; // Len of the substring from tailIndex
// to the current specChar []*?{}\\
int openBraceIndex; // Index of the current open brace
int closeBraceIndex; // Index of the current closed brace
int firstSpecCharIndex; // Index of the FSC, if any
char lastChar = (char)( 0 ); // Used to see if last char is a file
// separator.
char ch; // Generic storage variable
bool quoted; // True if a char is '\\'
 
if ( headLen > 0 )
{
lastChar = headBuf[headLen - 1];
}
 
// Consume any leading directory separators, leaving tailIndex
// just past the last initial separator.
 
string name = tail;
for ( tailIndex = 0; tailIndex < tailLen; tailIndex++ )
{
char c = tail[tailIndex];
if ( ( c == '\\' ) && ( ( tailIndex + 1 ) < tailLen ) && ( separators.IndexOf( (System.Char)tail[tailIndex + 1] ) != -1 ) )
{
tailIndex++;
}
else if ( separators.IndexOf( (System.Char)c ) == -1 )
{
break;
}
count++;
}
 
// Deal with path separators. On the Mac, we have to watch out
// for multiple separators, since they are special in Mac-style
// paths.
 
switch ( JACL.PLATFORM )
{
 
case JACL.PLATFORM_MAC:
 
if ( separators[0] == '/' )
{
if ( ( ( headLen == 0 ) && ( count == 0 ) ) || ( ( headLen > 0 ) && ( lastChar != ':' ) ) )
{
headBuf.Append( ":" );
}
}
else
{
if ( count == 0 )
{
if ( ( headLen > 0 ) && ( lastChar != ':' ) )
{
headBuf.Append( ":" );
}
}
else
{
if ( lastChar == ':' )
{
count--;
}
while ( count-- > 0 )
{
headBuf.Append( ":" );
}
}
}
break;
 
 
case JACL.PLATFORM_WINDOWS:
if ( name.StartsWith( ":" ) )
{
headBuf.Append( ":" );
if ( count > 1 )
{
headBuf.Append( "/" );
}
}
else if ( ( tailIndex < tailLen ) && ( ( ( headLen > 0 ) && ( separators.IndexOf( (System.Char)lastChar ) == -1 ) ) || ( ( headLen == 0 ) && ( count > 0 ) ) ) )
{
headBuf.Append( "/" );
if ( ( headLen == 0 ) && ( count > 1 ) )
{
headBuf.Append( "/" );
}
}
break;
 
default:
 
if ( ( tailIndex < tailLen ) && ( ( ( headLen > 0 ) && ( separators.IndexOf( (System.Char)lastChar ) == -1 ) ) || ( ( headLen == 0 ) && ( count > 0 ) ) ) )
{
headBuf.Append( "/" );
}
break;
 
}
 
// Look for the first matching pair of braces or the first
// directory separator that is not inside a pair of braces.
 
openBraceIndex = closeBraceIndex = -1;
quoted = false;
 
for ( pIndex = tailIndex; pIndex != tailLen; pIndex++ )
{
ch = tail[pIndex];
if ( quoted )
{
quoted = false;
}
else if ( ch == '\\' )
{
quoted = true;
if ( ( ( pIndex + 1 ) < tailLen ) && ( separators.IndexOf( (System.Char)tail[pIndex + 1] ) != -1 ) )
{
// Quoted directory separator.
 
break;
}
}
else if ( separators.IndexOf( (System.Char)ch ) != -1 )
{
// Unquoted directory separator.
 
break;
}
else if ( ch == '{' )
{
openBraceIndex = pIndex;
pIndex++;
if ( ( closeBraceIndex = SkipToChar( tail, pIndex, '}' ) ) != -1 )
{
break;
}
throw new TclException( interp, "unmatched open-brace in file name" );
}
else if ( ch == '}' )
{
throw new TclException( interp, "unmatched close-brace in file name" );
}
}
 
// Substitute the alternate patterns from the braces and recurse.
 
if ( openBraceIndex != -1 )
{
int nextIndex;
StringBuilder baseBuf = new StringBuilder();
 
// For each element within in the outermost pair of braces,
// append the element and the remainder to the fixed portion
// before the first brace and recursively call doGlob.
 
baseBuf.Append( tail.Substring( tailIndex, ( openBraceIndex ) - ( tailIndex ) ) );
baseLen = baseBuf.Length;
headLen = headBuf.Length;
 
for ( pIndex = openBraceIndex; pIndex < closeBraceIndex; )
{
pIndex++;
nextIndex = SkipToChar( tail, pIndex, ',' );
if ( nextIndex == -1 || nextIndex > closeBraceIndex )
{
nextIndex = closeBraceIndex;
}
 
headBuf.Length = headLen;
baseBuf.Length = baseLen;
 
baseBuf.Append( tail.Substring( pIndex, ( nextIndex ) - ( pIndex ) ) );
baseBuf.Append( tail.Substring( closeBraceIndex + 1 ) );
 
pIndex = nextIndex;
doGlob( interp, separators, headBuf, baseBuf.ToString(), resultList );
}
return;
}
 
// At this point, there are no more brace substitutions to perform on
// this path component. The variable p is pointing at a quoted or
// unquoted directory separator or the end of the string. So we need
// to check for special globbing characters in the current pattern.
// We avoid modifying tail if p is pointing at the end of the string.
 
if ( pIndex < tailLen )
{
firstSpecCharIndex = strpbrk( tail.Substring( 0, ( pIndex ) - ( 0 ) ).ToCharArray(), specCharArr );
}
else
{
firstSpecCharIndex = strpbrk( tail.Substring( tailIndex ).ToCharArray(), specCharArr );
}
 
if ( firstSpecCharIndex != -1 )
{
// Look for matching files in the current directory. matchFiles
// may recursively call TclDoGlob. For each file that matches,
// it will add the match onto the interp.result, or call TclDoGlob
// if there are more characters to be processed.
 
matchFiles( interp, separators, headBuf.ToString(), tail.Substring( tailIndex ), ( pIndex - tailIndex ), resultList );
return;
}
headBuf.Append( tail.Substring( tailIndex, ( pIndex ) - ( tailIndex ) ) );
if ( pIndex < tailLen )
{
doGlob( interp, separators, headBuf, tail.Substring( pIndex ), resultList );
return;
}
 
// There are no more wildcards in the pattern and no more unprocessed
// characters in the tail, so now we can construct the path and verify
// the existence of the file.
 
string head;
switch ( JACL.PLATFORM )
{
 
case JACL.PLATFORM_MAC:
if ( headBuf.ToString().IndexOf( (System.Char)':' ) == -1 )
{
headBuf.Append( ":" );
}
head = headBuf.ToString();
break;
 
case JACL.PLATFORM_WINDOWS:
if ( headBuf.Length == 0 )
{
if ( ( ( name.Length > 1 ) && ( name[0] == '\\' ) && ( ( name[1] == '/' ) || ( name[1] == '\\' ) ) ) || ( ( name.Length > 0 ) && ( name[0] == '/' ) ) )
{
headBuf.Append( "\\" );
}
else
{
headBuf.Append( "." );
}
}
head = headBuf.ToString().Replace( '\\', '/' );
break;
 
default:
if ( headBuf.Length == 0 )
{
if ( name.StartsWith( "\\/" ) || name.StartsWith( "/" ) )
{
headBuf.Append( "/" );
}
else
{
headBuf.Append( "." );
}
}
head = headBuf.ToString();
break;
 
}
addFileToResult( interp, head, separators, resultList );
}
private static void matchFiles( Interp interp, string separators, string dirName, string pattern, int pIndex, TclObject resultList )
{
bool matchHidden; // True if were matching hidden file
int patternEnd = pIndex; // Stores end index of the pattern
int dirLen = dirName.Length; // Caches the len of the dirName
int patLen = pattern.Length; // Caches the len of the pattern
string[] dirListing; // Listing of files in dirBuf
FileInfo dirObj; // File object of dirBuf
StringBuilder dirBuf = new StringBuilder();
// Converts the dirName to string
// buffer or initializes it with '.'
 
switch ( JACL.PLATFORM )
{
 
case JACL.PLATFORM_WINDOWS:
 
if ( dirLen == 0 )
{
dirBuf.Append( "./" );
}
else
{
dirBuf.Append( dirName );
char c = dirBuf[dirLen - 1];
if ( ( ( c == ':' ) && ( dirLen == 2 ) ) || ( separators.IndexOf( (System.Char)c ) == -1 ) )
{
dirBuf.Append( "/" );
}
}
 
// All comparisons should be case insensitive on Windows.
 
pattern = pattern.ToLower();
break;
 
case JACL.PLATFORM_MAC:
// Fall through to unix case--mac is not yet implemented.
default:
 
if ( dirLen == 0 )
{
dirBuf.Append( "." );
}
else
{
dirBuf.Append( dirName );
}
break;
}
 
dirObj = createAbsoluteFileObj( interp, dirBuf.ToString() );
if ( !Directory.Exists( dirObj.FullName ) )
{
return;
}
 
// Check to see if the pattern needs to compare with hidden files.
// Get a list of the directory's contents.
 
if ( pattern.StartsWith( "." ) || pattern.StartsWith( "\\." ) )
{
matchHidden = true;
// TODO tcl await only file names
dirListing = addHiddenToDirList( dirObj );
}
else
{
matchHidden = false;
DirectoryInfo dirInfo = new DirectoryInfo( dirObj.FullName );
FileSystemInfo[] fileInfos = dirInfo.GetFileSystemInfos();
// TCL await only file names
// dirListing = Directory.GetFileSystemEntries(dirObj.FullName);
dirListing = new string[fileInfos.Length];
for ( int x = 0; x < fileInfos.Length; x++ )
{
dirListing[x] = fileInfos[x].Name;
}
}
 
// Iterate over the directory's contents.
 
if ( dirListing.Length == 0 )
{
// Strip off a trailing '/' if necessary, before reporting
// the error.
 
if ( dirName.EndsWith( "/" ) )
{
dirName = dirName.Substring( 0, ( ( dirLen - 1 ) ) - ( 0 ) );
}
}
 
// Clean up the end of the pattern and the tail pointer. Leave
// the tail pointing to the first character after the path
// separator following the pattern, or NULL. Also, ensure that
// the pattern is null-terminated.
 
if ( ( pIndex < patLen ) && ( pattern[pIndex] == '\\' ) )
{
pIndex++;
}
if ( pIndex < ( patLen - 1 ) )
{
pIndex++;
}
 
for ( int i = 0; i < dirListing.Length; i++ )
{
// Don't match names starting with "." unless the "." is
// present in the pattern.
 
if ( !matchHidden && ( dirListing[i].StartsWith( "." ) ) )
{
continue;
}
 
// Now check to see if the file matches. If there are more
// characters to be processed, then ensure matching files are
// directories before calling TclDoGlob. Otherwise, just add
// the file to the resultList.
 
string tmp = dirListing[i];
if ( JACL.PLATFORM == JACL.PLATFORM_WINDOWS )
{
tmp = tmp.ToLower();
}
if ( Util.stringMatch( tmp, pattern.Substring( 0, ( patternEnd ) - ( 0 ) ) ) )
{
 
dirBuf.Length = dirLen;
dirBuf.Append( dirListing[i] );
if ( pIndex == pattern.Length )
{
addFileToResult( interp, dirBuf.ToString(), separators, resultList );
}
else
{
dirObj = createAbsoluteFileObj( interp, dirBuf.ToString() );
if ( Directory.Exists( dirObj.FullName ) )
{
dirBuf.Append( "/" );
doGlob( interp, separators, dirBuf, pattern.Substring( patternEnd + 1 ), resultList );
}
}
}
}
}
private static int strpbrk( char[] src, char[] matches )
// The chars to search for in src.
{
for ( int i = 0; i < src.Length; i++ )
{
for ( int j = 0; j < matches.Length; j++ )
{
if ( src[i] == matches[j] )
{
return ( i );
}
}
}
return -1;
}
private static string[] addHiddenToDirList( FileInfo dirObj )
// File object to list contents of
{
string[] dirListing; // Listing of files in dirObj
string[] fullListing; // dirListing + .. and .
int i, arrayLen;
 
 
dirListing = Directory.GetFileSystemEntries( dirObj.FullName );
arrayLen = ( (System.Array)dirListing ).Length;
 
 
try
{
 
fullListing = (string[])System.Array.CreateInstance( System.Type.GetType( "java.lang.String" ), arrayLen + 2 );
}
catch ( System.Exception e )
{
return dirListing;
}
for ( i = 0; i < arrayLen; i++ )
{
fullListing[i] = dirListing[i];
}
fullListing[arrayLen] = ".";
fullListing[arrayLen + 1] = "..";
 
return fullListing;
}
private static void addFileToResult( Interp interp, string fileName, string separators, TclObject resultList )
{
string prettyFileName = fileName;
int prettyLen = fileName.Length;
 
// Java IO reuqires Windows volumes [A-Za-z]: to be followed by '\\'.
 
if ( ( JACL.PLATFORM == JACL.PLATFORM_WINDOWS ) && ( prettyLen >= 2 ) && ( fileName[1] == ':' ) )
{
if ( prettyLen == 2 )
{
fileName = fileName + '\\';
}
else if ( fileName[2] != '\\' )
{
fileName = fileName.Substring( 0, ( 2 ) - ( 0 ) ) + '\\' + fileName.Substring( 2 );
}
}
 
TclObject[] arrayObj = TclList.getElements( interp, FileUtil.splitAndTranslate( interp, fileName ) );
fileName = FileUtil.joinPath( interp, arrayObj, 0, arrayObj.Length );
 
FileInfo f;
if ( FileUtil.getPathType( fileName ) == FileUtil.PATH_ABSOLUTE )
{
f = FileUtil.getNewFileObj( interp, fileName );
}
else
{
f = new FileInfo( interp.getWorkingDir().FullName + "\\" + fileName );
}
 
// If the last character is a spearator, make sure the file is an
// existing directory, otherwise check that the file exists.
 
if ( ( prettyLen > 0 ) && ( separators.IndexOf( (System.Char)prettyFileName[prettyLen - 1] ) != -1 ) )
{
if ( Directory.Exists( f.FullName ) )
{
TclList.append( interp, resultList, TclString.newInstance( prettyFileName ) );
}
}
else
{
bool tmpBool;
if ( File.Exists( f.FullName ) )
tmpBool = true;
else
tmpBool = Directory.Exists( f.FullName );
if ( tmpBool )
{
TclList.append( interp, resultList, TclString.newInstance( prettyFileName ) );
}
}
}
private static FileInfo createAbsoluteFileObj( Interp interp, string fileName )
{
if ( fileName.Equals( "" ) )
{
return ( interp.getWorkingDir() );
}
 
if ( ( JACL.PLATFORM == JACL.PLATFORM_WINDOWS ) && ( fileName.Length >= 2 ) && ( fileName[1] == ':' ) )
{
string tmp = null;
if ( fileName.Length == 2 )
{
tmp = fileName.Substring( 0, ( 2 ) - ( 0 ) ) + '\\';
}
else if ( fileName[2] != '\\' )
{
tmp = fileName.Substring( 0, ( 2 ) - ( 0 ) ) + '\\' + fileName.Substring( 2 );
}
if ( (System.Object)tmp != null )
{
return FileUtil.getNewFileObj( interp, tmp );
}
}
 
return FileUtil.getNewFileObj( interp, fileName );
}
} // end GlobCmd class
}
/trunk/TCL/src/commands/GlobalCmd.cs
@@ -0,0 +1,73 @@
/*
* GlobalCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: GlobalCmd.java,v 1.2 1999/08/03 02:55:41 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "global" command in Tcl.</summary>
 
class GlobalCmd : Command
{
/// <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;
}
}
}
/trunk/TCL/src/commands/IfCmd.cs
@@ -0,0 +1,153 @@
/*
* PutsCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: IfCmd.java,v 1.2 2003/02/07 03:41:49 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "if" command in Tcl.</summary>
class IfCmd : Command
{
 
/// <summary> See Tcl user documentation for details.</summary>
/// <exception cref=""> TclException If incorrect number of arguments.
/// </exception>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
int i;
bool value;
 
i = 1;
while ( true )
{
/*
* At this point in the loop, argv and argc refer to an
* expression to test, either for the main expression or
* an expression following an "elseif". The arguments
* after the expression must be "then" (optional) and a
* script to execute if the expression is true.
*/
 
if ( i >= argv.Length )
{
 
throw new TclException( interp, "wrong # args: no expression after \"" + argv[i - 1] + "\" argument" );
}
try
{
 
value = interp.expr.evalBoolean( interp, argv[i].ToString() );
}
catch ( TclException e )
{
switch ( e.getCompletionCode() )
{
 
case TCL.CompletionCode.ERROR:
interp.addErrorInfo( "\n (\"if\" test expression)" );
break;
}
throw;
}
 
i++;
 
if ( ( i < argv.Length ) && ( argv[i].ToString().Equals( "then" ) ) )
{
i++;
}
if ( i >= argv.Length )
{
 
throw new TclException( interp, "wrong # args: no script following \"" + argv[i - 1] + "\" argument" );
}
if ( value )
{
try
{
interp.eval( argv[i], 0 );
}
catch ( TclException e )
{
switch ( e.getCompletionCode() )
{
 
case TCL.CompletionCode.ERROR:
interp.addErrorInfo( "\n (\"if\" then script line " + interp.errorLine + ")" );
break;
}
throw;
}
return TCL.CompletionCode.RETURN;
}
 
/*
* The expression evaluated to false. Skip the command, then
* see if there is an "else" or "elseif" clause.
*/
 
i++;
if ( i >= argv.Length )
{
interp.resetResult();
return TCL.CompletionCode.RETURN;
}
 
if ( argv[i].ToString().Equals( "elseif" ) )
{
i++;
continue;
}
break;
}
 
/*
* Couldn't find a "then" or "elseif" clause to execute.
* Check now for an "else" clause. We know that there's at
* least one more argument when we get here.
*/
 
 
if ( argv[i].ToString().Equals( "else" ) )
{
i++;
if ( i >= argv.Length )
{
throw new TclException( interp, "wrong # args: no script following \"else\" argument" );
}
else if ( i != ( argv.Length - 1 ) )
{
throw new TclException( interp, "wrong # args: extra words after \"else\" clause in " + "\"if\" command" );
}
}
try
{
interp.eval( argv[i], 0 );
}
catch ( TclException e )
{
switch ( e.getCompletionCode() )
{
 
case TCL.CompletionCode.ERROR:
interp.addErrorInfo( "\n (\"if\" else script line " + interp.errorLine + ")" );
break;
}
throw;
}
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/IncrCmd.cs
@@ -0,0 +1,77 @@
/*
* IncrCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: IncrCmd.java,v 1.2 1999/08/03 02:56:23 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "incr" command in Tcl.</summary>
class IncrCmd : Command
{
/// <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;
}
}
}
/trunk/TCL/src/commands/InfoCmd.cs
@@ -0,0 +1,1309 @@
/*
* InfoCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: InfoCmd.java,v 1.8 2001/11/16 23:57:13 mdejong Exp $
*
*/
using System;
using System.Collections;
 
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "info" command in Tcl.</summary>
 
class InfoCmd : Command
{
private static readonly string[] validCmds = new string[] { "args", "body", "cmdcount", "commands", "complete", "default", "exists", "globals", "hostname", "level", "library", "loaded", "locals", "nameofexecutable", "patchlevel", "procs", "script", "sharedlibextension", "tclversion", "vars" };
 
internal const int OPT_ARGS = 0;
internal const int OPT_BODY = 1;
internal const int OPT_CMDCOUNT = 2;
internal const int OPT_COMMANDS = 3;
internal const int OPT_COMPLETE = 4;
internal const int OPT_DEFAULT = 5;
internal const int OPT_EXISTS = 6;
internal const int OPT_GLOBALS = 7;
internal const int OPT_HOSTNAME = 8;
internal const int OPT_LEVEL = 9;
internal const int OPT_LIBRARY = 10;
internal const int OPT_LOADED = 11;
internal const int OPT_LOCALS = 12;
internal const int OPT_NAMEOFEXECUTABLE = 13;
internal const int OPT_PATCHLEVEL = 14;
internal const int OPT_PROCS = 15;
internal const int OPT_SCRIPT = 16;
internal const int OPT_SHAREDLIBEXTENSION = 17;
internal const int OPT_TCLVERSION = 18;
internal const int OPT_VARS = 19;
 
/// <summary> Tcl_InfoObjCmd -> InfoCmd.cmdProc
///
/// This procedure is invoked to process the "info" 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 wrong # of args or invalid argument(s).
/// </exception>
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
int index;
 
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, objv, "option ?arg arg ...?" );
}
index = TclIndex.get( interp, objv[1], validCmds, "option", 0 );
 
switch ( index )
{
 
case OPT_ARGS:
InfoArgsCmd( interp, objv );
break;
 
case OPT_BODY:
InfoBodyCmd( interp, objv );
break;
 
case OPT_CMDCOUNT:
InfoCmdCountCmd( interp, objv );
break;
 
case OPT_COMMANDS:
InfoCommandsCmd( interp, objv );
break;
 
case OPT_COMPLETE:
InfoCompleteCmd( interp, objv );
break;
 
case OPT_DEFAULT:
InfoDefaultCmd( interp, objv );
break;
 
case OPT_EXISTS:
InfoExistsCmd( interp, objv );
break;
 
case OPT_GLOBALS:
InfoGlobalsCmd( interp, objv );
break;
 
case OPT_HOSTNAME:
InfoHostnameCmd( interp, objv );
break;
 
case OPT_LEVEL:
InfoLevelCmd( interp, objv );
break;
 
case OPT_LIBRARY:
InfoLibraryCmd( interp, objv );
break;
 
case OPT_LOADED:
InfoLoadedCmd( interp, objv );
break;
 
case OPT_LOCALS:
InfoLocalsCmd( interp, objv );
break;
 
case OPT_NAMEOFEXECUTABLE:
InfoNameOfExecutableCmd( interp, objv );
break;
 
case OPT_PATCHLEVEL:
InfoPatchLevelCmd( interp, objv );
break;
 
case OPT_PROCS:
InfoProcsCmd( interp, objv );
break;
 
case OPT_SCRIPT:
InfoScriptCmd( interp, objv );
break;
 
case OPT_SHAREDLIBEXTENSION:
InfoSharedlibCmd( interp, objv );
break;
 
case OPT_TCLVERSION:
InfoTclVersionCmd( interp, objv );
break;
 
case OPT_VARS:
InfoVarsCmd( interp, objv );
break;
}
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;
}
 
/*
*----------------------------------------------------------------------
*
* InfoBodyCmd --
*
* Called to implement the "info body" command that returns the body
* for a procedure. Handles the following syntax:
*
* info body procName
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoBodyCmd( Interp interp, TclObject[] objv )
{
string name;
Procedure proc;
//TclObject body, result;
 
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" );
}
 
 
interp.setResult( proc.body.ToString() );
return;
}
 
/*
*----------------------------------------------------------------------
*
* InfoCmdCountCmd --
*
* Called to implement the "info cmdcount" command that returns the
* number of commands that have been executed. Handles the following
* syntax:
*
* info cmdcount
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoCmdCountCmd( Interp interp, TclObject[] objv )
{
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, objv, null );
}
interp.setResult( interp.cmdCount );
return;
}
 
/*
*----------------------------------------------------------------------
*
* InfoCommandsCmd --
*
* Called to implement the "info commands" command that returns the
* list of commands in the interpreter that match an optional pattern.
* The pattern, if any, consists of an optional sequence of namespace
* names separated by "::" qualifiers, which is followed by a
* glob-style pattern that restricts which commands are returned.
* Handles the following syntax:
*
* info commands ?pattern?
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoCommandsCmd( Interp interp, TclObject[] objv )
{
string cmdName, pattern, simplePattern;
IDictionaryEnumerator search;
NamespaceCmd.Namespace ns;
NamespaceCmd.Namespace globalNs = NamespaceCmd.getGlobalNamespace( interp );
NamespaceCmd.Namespace currNs = NamespaceCmd.getCurrentNamespace( interp );
TclObject list, elemObj;
bool specificNsInPattern = false; // Init. to avoid compiler warning.
WrappedCommand cmd;
 
// Get the pattern and find the "effective namespace" in which to
// list commands.
 
if ( objv.Length == 2 )
{
simplePattern = null;
ns = currNs;
specificNsInPattern = false;
}
else if ( objv.Length == 3 )
{
// From the pattern, get the effective namespace and the simple
// pattern (no namespace qualifiers or ::'s) at the end. If an
// error was found while parsing the pattern, return it. Otherwise,
// if the namespace wasn't found, just leave ns NULL: we will
// return an empty list since no commands there can be found.
 
 
pattern = objv[2].ToString();
 
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
NamespaceCmd.Namespace[] nsArr = new NamespaceCmd.Namespace[1];
NamespaceCmd.Namespace[] dummy1Arr = new NamespaceCmd.Namespace[1];
NamespaceCmd.Namespace[] dummy2Arr = new NamespaceCmd.Namespace[1];
string[] simplePatternArr = new string[1];
 
NamespaceCmd.getNamespaceForQualName( interp, pattern, null, 0, nsArr, dummy1Arr, dummy2Arr, simplePatternArr );
 
// Get the values out of the arrays!
ns = nsArr[0];
simplePattern = simplePatternArr[0];
 
if ( ns != null )
{
// we successfully found the pattern's ns
specificNsInPattern = ( simplePattern.CompareTo( pattern ) != 0 );
}
}
else
{
throw new TclNumArgsException( interp, 2, objv, "?pattern?" );
}
 
// Scan through the effective namespace's command table and create a
// list with all commands that match the pattern. If a specific
// namespace was requested in the pattern, qualify the command names
// with the namespace name.
 
list = TclList.newInstance();
 
if ( ns != null )
{
search = ns.cmdTable.GetEnumerator();
while ( search.MoveNext() )
{
cmdName = ( (string)search.Key );
if ( ( (System.Object)simplePattern == null ) || Util.stringMatch( cmdName, simplePattern ) )
{
if ( specificNsInPattern )
{
cmd = (WrappedCommand)search.Value;
elemObj = TclString.newInstance( interp.getCommandFullName( cmd ) );
}
else
{
elemObj = TclString.newInstance( cmdName );
}
TclList.append( interp, list, elemObj );
}
}
 
// If the effective namespace isn't the global :: namespace, and a
// specific namespace wasn't requested in the pattern, then add in
// all global :: commands that match the simple pattern. Of course,
// we add in only those commands that aren't hidden by a command in
// the effective namespace.
 
if ( ( ns != globalNs ) && !specificNsInPattern )
{
search = globalNs.cmdTable.GetEnumerator();
while ( search.MoveNext() )
{
cmdName = ( (string)search.Key );
if ( ( (System.Object)simplePattern == null ) || Util.stringMatch( cmdName, simplePattern ) )
{
if ( ns.cmdTable[cmdName] == null )
{
TclList.append( interp, list, TclString.newInstance( cmdName ) );
}
}
}
}
}
 
interp.setResult( list );
return;
}
 
/*
*----------------------------------------------------------------------
*
* InfoCompleteCmd --
*
* Called to implement the "info complete" command that determines
* whether a string is a complete Tcl command. Handles the following
* syntax:
*
* info complete command
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoCompleteCmd( Interp interp, TclObject[] objv )
{
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "command" );
}
 
 
interp.setResult( tcl.lang.Interp.commandComplete( objv[2].ToString() ) );
return;
}
 
/*
*----------------------------------------------------------------------
*
* InfoDefaultCmd --
*
* Called to implement the "info default" command that returns the
* default value for a procedure argument. Handles the following
* syntax:
*
* info default procName arg varName
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoDefaultCmd( Interp interp, TclObject[] objv )
{
string procName, argName, varName;
Procedure proc;
//TclObject valueObj;
 
if ( objv.Length != 5 )
{
throw new TclNumArgsException( interp, 2, objv, "procname arg varname" );
}
 
 
procName = objv[2].ToString();
 
argName = objv[3].ToString();
proc = Procedure.findProc( interp, procName );
if ( proc == null )
{
throw new TclException( interp, "\"" + procName + "\" isn't a procedure" );
}
 
for ( int i = 0; i < proc.argList.Length; i++ )
{
 
if ( argName.Equals( proc.argList[i][0].ToString() ) )
{
 
varName = objv[4].ToString();
try
{
if ( proc.argList[i][1] != null )
{
interp.setVar( varName, proc.argList[i][1], 0 );
interp.setResult( 1 );
}
else
{
interp.setVar( varName, "", 0 );
interp.setResult( 0 );
}
}
catch ( TclException excp )
{
throw new TclException( interp, "couldn't store default value in variable \"" + varName + "\"" );
}
return;
}
}
throw new TclException( interp, "procedure \"" + procName + "\" doesn't have an argument \"" + argName + "\"" );
}
 
/*
*----------------------------------------------------------------------
*
* InfoExistsCmd --
*
* Called to implement the "info exists" command that determines
* whether a variable exists. Handles the following syntax:
*
* info exists varName
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoExistsCmd( Interp interp, TclObject[] objv )
{
string varName;
Var var = null;
 
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "varName" );
}
 
 
varName = objv[2].ToString();
Var[] result = Var.lookupVar( interp, varName, null, 0, "access", false, false );
if ( result != null )
{
var = result[0];
}
 
if ( ( var != null ) && !var.isVarUndefined() )
{
interp.setResult( true );
}
else
{
interp.setResult( false );
}
 
return;
}
 
/*
*----------------------------------------------------------------------
*
* InfoGlobalsCmd --
*
* Called to implement the "info globals" command that returns the list
* of global variables matching an optional pattern. Handles the
* following syntax:
*
* info globals ?pattern?*
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoGlobalsCmd( Interp interp, TclObject[] objv )
{
string varName, pattern;
NamespaceCmd.Namespace globalNs = NamespaceCmd.getGlobalNamespace( interp );
IDictionaryEnumerator search;
Var var;
TclObject list;
 
if ( objv.Length == 2 )
{
pattern = null;
}
else if ( objv.Length == 3 )
{
 
pattern = objv[2].ToString();
}
else
{
throw new TclNumArgsException( interp, 2, objv, "?pattern?" );
}
 
// Scan through the global :: namespace's variable table and create a
// list of all global variables that match the pattern.
 
list = TclList.newInstance();
 
for ( search = globalNs.varTable.GetEnumerator(); search.MoveNext(); )
{
varName = ( (string)search.Key );
var = (Var)search.Value;
if ( var.isVarUndefined() )
{
continue;
}
if ( ( (System.Object)pattern == null ) || Util.stringMatch( varName, pattern ) )
{
TclList.append( interp, list, TclString.newInstance( varName ) );
}
}
 
interp.setResult( list );
return;
}
 
/*
*----------------------------------------------------------------------
*
* InfoHostnameCmd --
*
* Called to implement the "info hostname" command that returns the
* host name. Handles the following syntax:
*
* info hostname
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoHostnameCmd( Interp interp, TclObject[] objv )
{
string name;
 
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, objv, null );
}
 
// FIXME : how can we find the hostname
 
name = null;
 
if ( (System.Object)name != null )
{
interp.setResult( name );
return;
}
else
{
interp.setResult( "unable to determine name of host" );
return;
}
}
 
/*
*----------------------------------------------------------------------
*
* InfoLevelCmd --
*
* Called to implement the "info level" command that returns
* information about the call stack. Handles the following syntax:
*
* info level ?number?
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoLevelCmd( Interp interp, TclObject[] objv )
{
int level;
CallFrame frame;
TclObject list;
 
if ( objv.Length == 2 )
{
// just "info level"
if ( interp.varFrame == null )
{
interp.setResult( 0 );
}
else
{
interp.setResult( interp.varFrame.level );
}
return;
}
else if ( objv.Length == 3 )
{
level = TclInteger.get( interp, objv[2] );
 
if ( level <= 0 )
{
if ( interp.varFrame == null )
{
 
throw new TclException( interp, "bad level \"" + objv[2].ToString() + "\"" );
}
 
level += interp.varFrame.level;
}
 
for ( frame = interp.varFrame; frame != null; frame = frame.callerVar )
{
if ( frame.level == level )
{
break;
}
}
if ( ( frame == null ) || frame.objv == null )
{
 
throw new TclException( interp, "bad level \"" + objv[2].ToString() + "\"" );
}
 
list = TclList.newInstance();
for ( int i = 0; i < frame.objv.Length; i++ )
{
TclList.append( interp, list, TclString.newInstance( frame.objv[i] ) );
}
interp.setResult( list );
return;
}
 
throw new TclNumArgsException( interp, 2, objv, "?number?" );
}
 
/*
*----------------------------------------------------------------------
*
* InfoLibraryCmd --
*
* Called to implement the "info library" command that returns the
* library directory for the Tcl installation. Handles the following
* syntax:
*
* info library
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoLibraryCmd( Interp interp, TclObject[] objv )
{
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, objv, null );
}
try
{
interp.setResult( interp.getVar( "tcl_library", TCL.VarFlag.GLOBAL_ONLY ) );
return;
}
catch ( TclException e )
{
// If the variable has not been defined
throw new TclException( interp, "no library has been specified for Tcl" );
}
}
 
/*
*----------------------------------------------------------------------
*
* InfoLoadedCmd --
*
* Called to implement the "info loaded" command that returns the
* packages that have been loaded into an interpreter. Handles the
* following syntax:
*
* info loaded ?interp?
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoLoadedCmd( Interp interp, TclObject[] objv )
{
if ( objv.Length != 2 && objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "?interp?" );
}
// FIXME : what should "info loaded" return?
throw new TclException( interp, "info loaded not implemented" );
}
 
/*
*----------------------------------------------------------------------
*
* InfoLocalsCmd --
*
* Called to implement the "info locals" command to return a list of
* local variables that match an optional pattern. Handles the
* following syntax:
*
* info locals ?pattern?
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoLocalsCmd( Interp interp, TclObject[] objv )
{
string pattern;
TclObject list;
 
if ( objv.Length == 2 )
{
pattern = null;
}
else if ( objv.Length == 3 )
{
 
pattern = objv[2].ToString();
}
else
{
throw new TclNumArgsException( interp, 2, objv, "?pattern?" );
}
 
if ( interp.varFrame == null || !interp.varFrame.isProcCallFrame )
{
return;
}
 
// Return a list containing names of first the compiled locals (i.e. the
// ones stored in the call frame), then the variables in the local hash
// table (if one exists).
 
list = TclList.newInstance();
AppendLocals( interp, list, pattern, false );
interp.setResult( list );
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 ) );
}
}
}
}
}
 
/*
*----------------------------------------------------------------------
*
* InfoNameOfExecutableCmd --
*
* Called to implement the "info nameofexecutable" command that returns
* the name of the binary file running this application. Handles the
* following syntax:
*
* info nameofexecutable
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoNameOfExecutableCmd( Interp interp, TclObject[] objv )
{
 
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, objv, null );
}
 
// We depend on a user defined property named "JAVA" since
// the JDK provides no means to learn the name of the executable
// that launched the application.
 
string nameOfExecutable = "nacl";
 
if ( (System.Object)nameOfExecutable != null )
{
TclObject result = TclList.newInstance();
TclList.append( interp, result, TclString.newInstance( nameOfExecutable ) );
TclList.append( interp, result, TclString.newInstance( "tcl.lang.Shell" ) );
interp.setResult( result );
}
 
return;
}
 
/*
*----------------------------------------------------------------------
*
* InfoPatchLevelCmd --
*
* Called to implement the "info patchlevel" command that returns the
* default value for an argument to a procedure. Handles the following
* syntax:
*
* info patchlevel
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoPatchLevelCmd( Interp interp, TclObject[] objv )
{
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, objv, null );
}
 
interp.setResult( interp.getVar( "tcl_patchLevel", TCL.VarFlag.GLOBAL_ONLY ) );
return;
}
 
/*
*----------------------------------------------------------------------
*
* InfoProcsCmd --
*
* Called to implement the "info procs" command that returns the
* procedures in the current namespace that match an optional pattern.
* Handles the following syntax:
*
* info procs ?pattern?
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoProcsCmd( Interp interp, TclObject[] objv )
{
string cmdName, pattern;
NamespaceCmd.Namespace currNs = NamespaceCmd.getCurrentNamespace( interp );
IDictionaryEnumerator search;
WrappedCommand cmd, realCmd;
TclObject list;
 
if ( objv.Length == 2 )
{
pattern = null;
}
else if ( objv.Length == 3 )
{
 
pattern = objv[2].ToString();
}
else
{
throw new TclNumArgsException( interp, 2, objv, "?pattern?" );
}
 
// Scan through the current namespace's command table and return a list
// of all procs that match the pattern.
 
list = TclList.newInstance();
for ( search = currNs.cmdTable.GetEnumerator(); search.MoveNext(); )
{
cmdName = ( (string)search.Key );
cmd = (WrappedCommand)search.Value;
 
// If the command isn't itself a proc, it still might be an
// imported command that points to a "real" proc in a different
// namespace.
 
realCmd = NamespaceCmd.getOriginalCommand( cmd );
 
if ( Procedure.isProc( cmd ) || ( ( realCmd != null ) && Procedure.isProc( realCmd ) ) )
{
if ( ( (System.Object)pattern == null ) || Util.stringMatch( cmdName, pattern ) )
{
TclList.append( interp, list, TclString.newInstance( cmdName ) );
}
}
}
 
interp.setResult( list );
return;
}
 
/*
*----------------------------------------------------------------------
*
* InfoScriptCmd --
*
* Called to implement the "info script" command that returns the
* script file that is currently being evaluated. Handles the
* following syntax:
*
* info script
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoScriptCmd( Interp interp, TclObject[] objv )
{
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, objv, null );
}
 
interp.setResult( interp.scriptFile );
return;
}
 
/*
*----------------------------------------------------------------------
*
* InfoSharedlibCmd --
*
* Called to implement the "info sharedlibextension" command that
* returns the file extension used for shared libraries. Handles the
* following syntax:
*
* info sharedlibextension
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoSharedlibCmd( Interp interp, TclObject[] objv )
{
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, objv, null );
}
interp.setResult( ".jar" );
return;
}
 
/*
*----------------------------------------------------------------------
*
* InfoTclVersionCmd --
*
* Called to implement the "info tclversion" command that returns the
* version number for this Tcl library. Handles the following syntax:
*
* info tclversion
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoTclVersionCmd( Interp interp, TclObject[] objv )
{
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, objv, null );
}
 
interp.setResult( interp.getVar( "tcl_version", TCL.VarFlag.GLOBAL_ONLY ) );
return;
}
 
/*
*----------------------------------------------------------------------
*
* InfoVarsCmd --
*
* Called to implement the "info vars" command that returns the
* list of variables in the interpreter that match an optional pattern.
* The pattern, if any, consists of an optional sequence of namespace
* names separated by "::" qualifiers, which is followed by a
* glob-style pattern that restricts which variables are returned.
* Handles the following syntax:
*
* info vars ?pattern?
*
* Results:
* Returns if successful, raises TclException otherwise.
*
* Side effects:
* Returns a result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void InfoVarsCmd( Interp interp, TclObject[] objv )
{
string varName, pattern, simplePattern;
IDictionaryEnumerator search;
Var var;
NamespaceCmd.Namespace ns;
NamespaceCmd.Namespace globalNs = NamespaceCmd.getGlobalNamespace( interp );
NamespaceCmd.Namespace currNs = NamespaceCmd.getCurrentNamespace( interp );
TclObject list, elemObj;
bool specificNsInPattern = false; // Init. to avoid compiler warning.
 
// Get the pattern and find the "effective namespace" in which to
// list variables. We only use this effective namespace if there's
// no active Tcl procedure frame.
 
if ( objv.Length == 2 )
{
simplePattern = null;
ns = currNs;
specificNsInPattern = false;
}
else if ( objv.Length == 3 )
{
// From the pattern, get the effective namespace and the simple
// pattern (no namespace qualifiers or ::'s) at the end. If an
// error was found while parsing the pattern, return it. Otherwise,
// if the namespace wasn't found, just leave ns = null: we will
// return an empty list since no variables there can be found.
 
 
pattern = objv[2].ToString();
 
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
NamespaceCmd.Namespace[] nsArr = new NamespaceCmd.Namespace[1];
NamespaceCmd.Namespace[] dummy1Arr = new NamespaceCmd.Namespace[1];
NamespaceCmd.Namespace[] dummy2Arr = new NamespaceCmd.Namespace[1];
string[] simplePatternArr = new string[1];
 
NamespaceCmd.getNamespaceForQualName( interp, pattern, null, 0, nsArr, dummy1Arr, dummy2Arr, simplePatternArr );
 
// Get the values out of the arrays!
ns = nsArr[0];
simplePattern = simplePatternArr[0];
 
if ( ns != null )
{
// we successfully found the pattern's ns
specificNsInPattern = ( simplePattern.CompareTo( pattern ) != 0 );
}
}
else
{
throw new TclNumArgsException( interp, 2, objv, "?pattern?" );
}
 
// If the namespace specified in the pattern wasn't found, just return.
 
if ( ns == null )
{
return;
}
 
list = TclList.newInstance();
 
if ( ( interp.varFrame == null ) || !interp.varFrame.isProcCallFrame || specificNsInPattern )
{
// There is no frame pointer, the frame pointer was pushed only
// to activate a namespace, or we are in a procedure call frame
// but a specific namespace was specified. Create a list containing
// only the variables in the effective namespace's variable table.
 
search = ns.varTable.GetEnumerator();
while ( search.MoveNext() )
{
varName = ( (string)search.Key );
var = (Var)search.Value;
if ( !var.isVarUndefined() || ( ( var.flags & VarFlags.NAMESPACE_VAR ) != 0 ) )
{
if ( ( (System.Object)simplePattern == null ) || Util.stringMatch( varName, simplePattern ) )
{
if ( specificNsInPattern )
{
elemObj = TclString.newInstance( Var.getVariableFullName( interp, var ) );
}
else
{
elemObj = TclString.newInstance( varName );
}
TclList.append( interp, list, elemObj );
}
}
}
 
// If the effective namespace isn't the global :: namespace, and a
// specific namespace wasn't requested in the pattern (i.e., the
// pattern only specifies variable names), then add in all global ::
// variables that match the simple pattern. Of course, add in only
// those variables that aren't hidden by a variable in the effective
// namespace.
 
if ( ( ns != globalNs ) && !specificNsInPattern )
{
search = globalNs.varTable.GetEnumerator();
while ( search.MoveNext() )
{
varName = ( (string)search.Key );
var = (Var)search.Value;
if ( !var.isVarUndefined() || ( ( var.flags & VarFlags.NAMESPACE_VAR ) != 0 ) )
{
if ( ( (System.Object)simplePattern == null ) || Util.stringMatch( varName, simplePattern ) )
{
 
// Skip vars defined in current namespace
if ( ns.varTable[varName] == null )
{
TclList.append( interp, list, TclString.newInstance( varName ) );
}
}
}
}
}
}
else
{
AppendLocals( interp, list, simplePattern, true );
}
 
interp.setResult( list );
return;
}
}
}
/trunk/TCL/src/commands/InterpAliasCmd.cs
@@ -0,0 +1,245 @@
/*
* InterpAliasCmd.java --
*
* Implements the built-in "interp" Tcl command.
*
* Copyright (c) 2000 Christian Krone.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: InterpAliasCmd.java,v 1.1 2000/08/20 06:08:42 mo Exp $
*
*/
using System;
using System.Collections;
 
namespace tcl.lang
{
 
/// <summary> This class implements the alias commands, which are created
/// in response to the built-in "interp alias" command in Tcl.
///
/// </summary>
 
class InterpAliasCmd : CommandWithDispose
{
 
// Name of alias command in slave interp.
 
internal TclObject name;
 
// Interp in which target command will be invoked.
 
private Interp targetInterp;
 
// Tcl list making up the prefix of the target command to be invoked in
// the target interpreter. Additional arguments specified when calling
// the alias in the slave interp will be appended to the prefix before
// the command is invoked.
 
private TclObject prefix;
 
// Source command in slave interpreter, bound to command that invokes
// the target command in the target interpreter.
 
private WrappedCommand slaveCmd;
 
// Entry for the alias hash table in slave.
// This is used by alias deletion to remove the alias from the slave
// interpreter alias table.
 
private string aliasEntry;
 
// Interp in which the command is defined.
// This is the interpreter with the aliasTable in Slave.
 
private Interp slaveInterp;
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;
}
public void disposeCmd()
{
if ( (System.Object)aliasEntry != null )
{
SupportClass.HashtableRemove( slaveInterp.aliasTable, aliasEntry );
}
 
if ( slaveCmd != null )
{
SupportClass.HashtableRemove( targetInterp.targetTable, slaveCmd );
}
 
name.release();
prefix.release();
}
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 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 );
}
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 );
}
}
internal static void list( Interp interp, Interp slaveInterp )
{
TclObject result = TclList.newInstance();
interp.setResult( result );
 
IEnumerator aliases = slaveInterp.aliasTable.Values.GetEnumerator();
while ( aliases.MoveNext() )
{
InterpAliasCmd alias = (InterpAliasCmd)aliases.Current;
TclList.append( interp, result, alias.name );
}
}
internal WrappedCommand getTargetCmd( Interp interp )
{
TclObject[] objv = TclList.getElements( interp, prefix );
 
string targetName = objv[0].ToString();
return NamespaceCmd.findCommand( targetInterp, targetName, null, 0 );
}
internal static Interp getTargetInterp( Interp slaveInterp, string aliasName )
{
if ( !slaveInterp.aliasTable.ContainsKey( aliasName ) )
{
return null;
}
 
InterpAliasCmd alias = (InterpAliasCmd)slaveInterp.aliasTable[aliasName];
 
return alias.targetInterp;
}
} // end InterpAliasCmd
}
/trunk/TCL/src/commands/InterpCmd.cs
@@ -0,0 +1,435 @@
/*
* InterpCmd.java --
*
* Implements the built-in "interp" Tcl command.
*
* Copyright (c) 2000 Christian Krone.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: InterpCmd.java,v 1.1 2000/08/20 06:08:43 mo Exp $
*
*/
using System;
using System.Collections;
 
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "interp" command in Tcl.</summary>
 
class InterpCmd : Command
{
 
private static readonly string[] options = new string[] { "alias", "aliases", "create", "delete", "eval", "exists", "expose", "hide", "hidden", "issafe", "invokehidden", "marktrusted", "slaves", "share", "target", "transfer" };
private const int OPT_ALIAS = 0;
private const int OPT_ALIASES = 1;
private const int OPT_CREATE = 2;
private const int OPT_DELETE = 3;
private const int OPT_EVAL = 4;
private const int OPT_EXISTS = 5;
private const int OPT_EXPOSE = 6;
private const int OPT_HIDE = 7;
private const int OPT_HIDDEN = 8;
private const int OPT_ISSAFE = 9;
private const int OPT_INVOKEHIDDEN = 10;
private const int OPT_MARKTRUSTED = 11;
private const int OPT_SLAVES = 12;
private const int OPT_SHARE = 13;
private const int OPT_TARGET = 14;
private const int OPT_TRANSFER = 15;
 
private static readonly string[] createOptions = new string[] { "-safe", "--" };
private const int OPT_CREATE_SAFE = 0;
private const int OPT_CREATE_LAST = 1;
 
private static readonly string[] hiddenOptions = new string[] { "-global", "--" };
private const int OPT_HIDDEN_GLOBAL = 0;
private const int OPT_HIDDEN_LAST = 1;
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, objv, "cmd ?arg ...?" );
}
int cmd = TclIndex.get( interp, objv[1], options, "option", 0 );
 
switch ( cmd )
{
 
case OPT_ALIAS:
{
if ( objv.Length >= 4 )
{
Interp slaveInterp = getInterp( interp, objv[2] );
 
if ( objv.Length == 4 )
{
InterpAliasCmd.describe( interp, slaveInterp, objv[3] );
return TCL.CompletionCode.RETURN;
}
 
if ( ( objv.Length == 5 ) && ( "".Equals( objv[4].ToString() ) ) )
{
InterpAliasCmd.delete( interp, slaveInterp, objv[3] );
return TCL.CompletionCode.RETURN;
}
if ( objv.Length > 5 )
{
Interp masterInterp = getInterp( interp, objv[4] );
 
if ( "".Equals( objv[5].ToString() ) )
{
if ( objv.Length == 6 )
{
InterpAliasCmd.delete( interp, slaveInterp, objv[3] );
return TCL.CompletionCode.RETURN;
}
}
else
{
InterpAliasCmd.create( interp, slaveInterp, masterInterp, objv[3], objv[5], 6, objv );
return TCL.CompletionCode.RETURN;
}
}
}
throw new TclNumArgsException( interp, 2, objv, "slavePath slaveCmd ?masterPath masterCmd? ?args ..?" );
}
 
case OPT_ALIASES:
{
Interp slaveInterp = getInterp( interp, objv );
InterpAliasCmd.list( interp, slaveInterp );
break;
}
 
case OPT_CREATE:
{
 
// Weird historical rules: "-safe" is accepted at the end, too.
 
bool safe = interp.isSafe;
 
TclObject slaveNameObj = null;
bool last = false;
for ( int i = 2; i < objv.Length; i++ )
{
 
if ( ( !last ) && ( objv[i].ToString()[0] == '-' ) )
{
int index = TclIndex.get( interp, objv[i], createOptions, "option", 0 );
if ( index == OPT_CREATE_SAFE )
{
safe = true;
continue;
}
i++;
last = true;
}
if ( slaveNameObj != null )
{
throw new TclNumArgsException( interp, 2, objv, "?-safe? ?--? ?path?" );
}
slaveNameObj = objv[i];
}
if ( slaveNameObj == null )
{
 
// Create an anonymous interpreter -- we choose its name and
// the name of the command. We check that the command name
// that we use for the interpreter does not collide with an
// existing command in the master interpreter.
 
int i = 0;
while ( interp.getCommand( "interp" + i ) != null )
{
i++;
}
slaveNameObj = TclString.newInstance( "interp" + i );
}
InterpSlaveCmd.create( interp, slaveNameObj, safe );
interp.setResult( slaveNameObj );
break;
}
 
case OPT_DELETE:
{
for ( int i = 2; i < objv.Length; i++ )
{
Interp slaveInterp = getInterp( interp, objv[i] );
 
if ( slaveInterp == interp )
{
throw new TclException( interp, "cannot delete the current interpreter" );
}
InterpSlaveCmd slave = slaveInterp.slave;
slave.masterInterp.deleteCommandFromToken( slave.interpCmd );
}
break;
}
 
case OPT_EVAL:
{
if ( objv.Length < 4 )
{
throw new TclNumArgsException( interp, 2, objv, "path arg ?arg ...?" );
}
Interp slaveInterp = getInterp( interp, objv[2] );
InterpSlaveCmd.eval( interp, slaveInterp, 3, objv );
break;
}
 
case OPT_EXISTS:
{
bool exists = true;
 
try
{
getInterp( interp, objv );
}
catch ( TclException e )
{
if ( objv.Length > 3 )
{
throw;
}
exists = false;
}
interp.setResult( exists );
break;
}
 
case OPT_EXPOSE:
{
if ( objv.Length < 4 || objv.Length > 5 )
{
throw new TclNumArgsException( interp, 2, objv, "path hiddenCmdName ?cmdName?" );
}
Interp slaveInterp = getInterp( interp, objv[2] );
InterpSlaveCmd.expose( interp, slaveInterp, 3, objv );
break;
}
 
case OPT_HIDE:
{
if ( objv.Length < 4 || objv.Length > 5 )
{
throw new TclNumArgsException( interp, 2, objv, "path cmdName ?hiddenCmdName?" );
}
Interp slaveInterp = getInterp( interp, objv[2] );
InterpSlaveCmd.hide( interp, slaveInterp, 3, objv );
break;
}
 
case OPT_HIDDEN:
{
Interp slaveInterp = getInterp( interp, objv );
InterpSlaveCmd.hidden( interp, slaveInterp );
break;
}
 
case OPT_ISSAFE:
{
Interp slaveInterp = getInterp( interp, objv );
interp.setResult( slaveInterp.isSafe );
break;
}
 
case OPT_INVOKEHIDDEN:
{
bool global = false;
int i;
for ( i = 3; i < objv.Length; i++ )
{
 
if ( objv[i].ToString()[0] != '-' )
{
break;
}
int index = TclIndex.get( interp, objv[i], hiddenOptions, "option", 0 );
if ( index == OPT_HIDDEN_GLOBAL )
{
global = true;
}
else
{
i++;
break;
}
}
if ( objv.Length - i < 1 )
{
throw new TclNumArgsException( interp, 2, objv, "path ?-global? ?--? cmd ?arg ..?" );
}
Interp slaveInterp = getInterp( interp, objv[2] );
InterpSlaveCmd.invokeHidden( interp, slaveInterp, global, i, objv );
break;
}
 
case OPT_MARKTRUSTED:
{
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "path" );
}
Interp slaveInterp = getInterp( interp, objv[2] );
InterpSlaveCmd.markTrusted( interp, slaveInterp );
break;
}
 
case OPT_SLAVES:
{
Interp slaveInterp = getInterp( interp, objv );
 
TclObject result = TclList.newInstance();
interp.setResult( result );
 
IEnumerator keys = slaveInterp.slaveTable.Keys.GetEnumerator();
while ( keys.MoveNext() )
{
string inString = (string)keys.Current;
TclList.append( interp, result, TclString.newInstance( inString ) );
}
 
break;
}
 
case OPT_SHARE:
{
if ( objv.Length != 5 )
{
throw new TclNumArgsException( interp, 2, objv, "srcPath channelId destPath" );
}
Interp masterInterp = getInterp( interp, objv[2] );
 
 
Channel chan = TclIO.getChannel( masterInterp, objv[3].ToString() );
if ( chan == null )
{
 
throw new TclException( interp, "can not find channel named \"" + objv[3].ToString() + "\"" );
}
 
Interp slaveInterp = getInterp( interp, objv[4] );
TclIO.registerChannel( slaveInterp, chan );
break;
}
 
case OPT_TARGET:
{
if ( objv.Length != 4 )
{
throw new TclNumArgsException( interp, 2, objv, "path alias" );
}
 
Interp slaveInterp = getInterp( interp, objv[2] );
 
string aliasName = objv[3].ToString();
Interp targetInterp = InterpAliasCmd.getTargetInterp( slaveInterp, aliasName );
if ( targetInterp == null )
{
 
throw new TclException( interp, "alias \"" + aliasName + "\" in path \"" + objv[2].ToString() + "\" not found" );
}
if ( !getInterpPath( interp, targetInterp ) )
{
 
throw new TclException( interp, "target interpreter for alias \"" + aliasName + "\" in path \"" + objv[2].ToString() + "\" is not my descendant" );
}
break;
}
 
case OPT_TRANSFER:
{
if ( objv.Length != 5 )
{
throw new TclNumArgsException( interp, 2, objv, "srcPath channelId destPath" );
}
Interp masterInterp = getInterp( interp, objv[2] );
 
 
Channel chan = TclIO.getChannel( masterInterp, objv[3].ToString() );
if ( chan == null )
{
 
throw new TclException( interp, "can not find channel named \"" + objv[3].ToString() + "\"" );
}
 
Interp slaveInterp = getInterp( interp, objv[4] );
TclIO.registerChannel( slaveInterp, chan );
TclIO.unregisterChannel( masterInterp, chan );
break;
}
}
return TCL.CompletionCode.RETURN;
}
private static Interp getInterp( Interp interp, TclObject[] objv )
{
if ( objv.Length == 2 )
{
return interp;
}
else if ( objv.Length == 3 )
{
return getInterp( interp, objv[2] );
}
else
{
throw new TclNumArgsException( interp, 2, objv, "?path?" );
}
}
private static bool getInterpPath( Interp askingInterp, Interp targetInterp )
{
if ( targetInterp == askingInterp )
{
return true;
}
if ( targetInterp == null || targetInterp.slave == null )
{
return false;
}
 
if ( !getInterpPath( askingInterp, targetInterp.slave.masterInterp ) )
{
return false;
}
askingInterp.appendElement( targetInterp.slave.path );
return true;
}
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;
}
} // end InterpCmd
}
/trunk/TCL/src/commands/InterpSlaveCmd.cs
@@ -0,0 +1,574 @@
/*
* InterpSlaveCmd.java --
*
* Implements the built-in "interp" Tcl command.
*
* Copyright (c) 2000 Christian Krone.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: InterpSlaveCmd.java,v 1.1 2000/08/20 06:08:43 mo Exp $
*
*/
using System;
using System.Collections;
 
namespace tcl.lang
{
 
/// <summary> This class implements the slave interpreter commands, which are created
/// in response to the built-in "interp create" command in Tcl.
///
/// It is also used by the "interp" command to record and find information
/// about slave interpreters. Maps from a command name in the master to
/// information about a slave interpreter, e.g. what aliases are defined
/// in it.
/// </summary>
 
class InterpSlaveCmd : CommandWithDispose, AssocData
{
 
private static readonly string[] options = new string[] { "alias", "aliases", "eval", "expose", "hide", "hidden", "issafe", "invokehidden", "marktrusted" };
private const int OPT_ALIAS = 0;
private const int OPT_ALIASES = 1;
private const int OPT_EVAL = 2;
private const int OPT_EXPOSE = 3;
private const int OPT_HIDE = 4;
private const int OPT_HIDDEN = 5;
private const int OPT_ISSAFE = 6;
private const int OPT_INVOKEHIDDEN = 7;
private const int OPT_MARKTRUSTED = 8;
 
private static readonly string[] hiddenOptions = new string[] { "-global", "--" };
private const int OPT_HIDDEN_GLOBAL = 0;
private const int OPT_HIDDEN_LAST = 1;
 
// Master interpreter for this slave.
 
internal Interp masterInterp;
 
// Hash entry in masters slave table for this slave interpreter.
// Used to find this record, and used when deleting the slave interpreter
// to delete it from the master's table.
 
internal string path;
 
// The slave interpreter.
 
internal Interp slaveInterp;
 
// Interpreter object command.
 
internal WrappedCommand interpCmd;
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, objv, "cmd ?arg ...?" );
}
int cmd = TclIndex.get( interp, objv[1], options, "option", 0 );
 
switch ( cmd )
{
 
case OPT_ALIAS:
if ( objv.Length == 3 )
{
InterpAliasCmd.describe( interp, slaveInterp, objv[2] );
return TCL.CompletionCode.RETURN;
}
 
if ( "".Equals( objv[3].ToString() ) )
{
if ( objv.Length == 4 )
{
InterpAliasCmd.delete( interp, slaveInterp, objv[2] );
return TCL.CompletionCode.RETURN;
}
}
else
{
InterpAliasCmd.create( interp, slaveInterp, interp, objv[2], objv[3], 4, objv );
return TCL.CompletionCode.RETURN;
}
throw new TclNumArgsException( interp, 2, objv, "aliasName ?targetName? ?args..?" );
 
case OPT_ALIASES:
InterpAliasCmd.list( interp, slaveInterp );
break;
 
case OPT_EVAL:
if ( objv.Length < 3 )
{
throw new TclNumArgsException( interp, 2, objv, "arg ?arg ...?" );
}
eval( interp, slaveInterp, 2, objv );
break;
 
case OPT_EXPOSE:
if ( objv.Length < 3 || objv.Length > 4 )
{
throw new TclNumArgsException( interp, 2, objv, "hiddenCmdName ?cmdName?" );
}
expose( interp, slaveInterp, 2, objv );
break;
 
case OPT_HIDE:
if ( objv.Length < 3 || objv.Length > 4 )
{
throw new TclNumArgsException( interp, 2, objv, "cmdName ?hiddenCmdName?" );
}
hide( interp, slaveInterp, 2, objv );
break;
 
case OPT_HIDDEN:
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, objv, null );
}
InterpSlaveCmd.hidden( interp, slaveInterp );
break;
 
case OPT_ISSAFE:
interp.setResult( slaveInterp.isSafe );
break;
 
case OPT_INVOKEHIDDEN:
bool global = false;
int i;
for ( i = 2; i < objv.Length; i++ )
{
 
if ( objv[i].ToString()[0] != '-' )
{
break;
}
int index = TclIndex.get( interp, objv[i], hiddenOptions, "option", 0 );
if ( index == OPT_HIDDEN_GLOBAL )
{
global = true;
}
else
{
i++;
break;
}
}
if ( objv.Length - i < 1 )
{
throw new TclNumArgsException( interp, 2, objv, "?-global? ?--? cmd ?arg ..?" );
}
InterpSlaveCmd.invokeHidden( interp, slaveInterp, global, i, objv );
break;
 
case OPT_MARKTRUSTED:
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, objv, null );
}
markTrusted( interp, slaveInterp );
break;
}
return TCL.CompletionCode.RETURN;
}
/// <summary>----------------------------------------------------------------------
///
/// disposeCmd --
///
/// Invoked when an object command for a slave interpreter is deleted;
/// cleans up all state associated with the slave interpreter and destroys
/// the slave interpreter.
///
/// Results:
/// None.
///
/// Side effects:
/// Cleans up all state associated with the slave interpreter and
/// destroys the slave interpreter.
///
/// ----------------------------------------------------------------------
/// </summary>
 
public void disposeCmd()
{
// Unlink the slave from its master interpreter.
 
SupportClass.HashtableRemove( masterInterp.slaveTable, path );
 
// Set to null so that when the InterpInfo is cleaned up in the slave
// it does not try to delete the command causing all sorts of grief.
// See SlaveRecordDeleteProc().
 
interpCmd = null;
 
if ( slaveInterp != null )
{
slaveInterp.dispose();
}
}
public void disposeAssocData( Interp interp )
// Current interpreter.
{
// There shouldn't be any commands left.
 
if ( !( interp.slaveTable.Count == 0 ) )
{
System.Console.Error.WriteLine( "InterpInfoDeleteProc: still exist commands" );
}
interp.slaveTable = null;
 
// Tell any interps that have aliases to this interp that they should
// delete those aliases. If the other interp was already dead, it
// would have removed the target record already.
 
// TODO ATK
foreach ( WrappedCommand slaveCmd in new ArrayList( interp.targetTable.Keys ) )
{
Interp slaveInterp = (Interp)interp.targetTable[slaveCmd];
slaveInterp.deleteCommandFromToken( slaveCmd );
}
interp.targetTable = null;
 
if ( interp.interpChanTable != null )
{
foreach ( Channel channel in new ArrayList( interp.interpChanTable.Values ) )
{
TclIO.unregisterChannel( interp, channel );
}
}
 
if ( interp.slave.interpCmd != null )
{
// Tcl_DeleteInterp() was called on this interpreter, rather
// "interp delete" or the equivalent deletion of the command in the
// master. First ensure that the cleanup callback doesn't try to
// delete the interp again.
 
interp.slave.slaveInterp = null;
interp.slave.masterInterp.deleteCommandFromToken( interp.slave.interpCmd );
}
 
// There shouldn't be any aliases left.
 
if ( !( interp.aliasTable.Count == 0 ) )
{
System.Console.Error.WriteLine( "InterpInfoDeleteProc: still exist aliases" );
}
interp.aliasTable = null;
}
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;
}
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 );
}
internal static void expose( Interp interp, Interp slaveInterp, int objIx, TclObject[] objv )
{
if ( interp.isSafe )
{
throw new TclException( interp, "permission denied: " + "safe interpreter cannot expose commands" );
}
 
int nameIdx = objv.Length - objIx == 1 ? objIx : objIx + 1;
 
try
{
 
slaveInterp.exposeCommand( objv[objIx].ToString(), objv[nameIdx].ToString() );
}
catch ( TclException e )
{
interp.transferResult( slaveInterp, e.getCompletionCode() );
throw;
}
}
internal static void hide( Interp interp, Interp slaveInterp, int objIx, TclObject[] objv )
{
if ( interp.isSafe )
{
throw new TclException( interp, "permission denied: " + "safe interpreter cannot hide commands" );
}
 
int nameIdx = objv.Length - objIx == 1 ? objIx : objIx + 1;
 
try
{
 
slaveInterp.hideCommand( objv[objIx].ToString(), objv[nameIdx].ToString() );
}
catch ( TclException e )
{
interp.transferResult( slaveInterp, e.getCompletionCode() );
throw;
}
}
internal static void hidden( Interp interp, Interp slaveInterp )
{
if ( slaveInterp.hiddenCmdTable == null )
{
return;
}
 
TclObject result = TclList.newInstance();
interp.setResult( result );
 
IEnumerator hiddenCmds = slaveInterp.hiddenCmdTable.Keys.GetEnumerator();
while ( hiddenCmds.MoveNext() )
{
string cmdName = (string)hiddenCmds.Current;
TclList.append( interp, result, TclString.newInstance( cmdName ) );
}
}
internal static void invokeHidden( Interp interp, Interp slaveInterp, bool global, int objIx, TclObject[] objv )
{
TCL.CompletionCode result;
 
if ( interp.isSafe )
{
throw new TclException( interp, "not allowed to " + "invoke hidden commands from safe interpreter" );
}
 
slaveInterp.preserve();
slaveInterp.allowExceptions();
 
TclObject[] localObjv = new TclObject[objv.Length - objIx];
for ( int i = 0; i < objv.Length - objIx; i++ )
{
localObjv[i] = objv[i + objIx];
}
 
try
{
if ( global )
{
slaveInterp.invokeGlobal( localObjv, Interp.INVOKE_HIDDEN );
}
else
{
slaveInterp.invoke( localObjv, Interp.INVOKE_HIDDEN );
}
result = slaveInterp.returnCode;
}
catch ( TclException e )
{
result = e.getCompletionCode();
}
 
slaveInterp.release();
interp.transferResult( slaveInterp, result );
}
internal static void markTrusted( Interp interp, Interp slaveInterp )
{
if ( interp.isSafe )
{
throw new TclException( interp, "permission denied: " + "safe interpreter cannot mark trusted" );
}
slaveInterp.isSafe = false;
}
private static void makeSafe( Interp interp )
{
Channel chan; // Channel to remove from safe interpreter.
 
interp.hideUnsafeCommands();
 
interp.isSafe = true;
 
// Unsetting variables : (which should not have been set
// in the first place, but...)
 
// No env array in a safe slave.
 
try
{
interp.unsetVar( "env", TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
}
 
// Remove unsafe parts of tcl_platform
 
try
{
interp.unsetVar( "tcl_platform", "os", TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
}
try
{
interp.unsetVar( "tcl_platform", "osVersion", TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
}
try
{
interp.unsetVar( "tcl_platform", "machine", TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
}
try
{
interp.unsetVar( "tcl_platform", "user", TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
}
 
// Unset path informations variables
// (the only one remaining is [info nameofexecutable])
 
try
{
interp.unsetVar( "tclDefaultLibrary", TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
}
try
{
interp.unsetVar( "tcl_library", TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
}
try
{
interp.unsetVar( "tcl_pkgPath", TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
}
 
// Remove the standard channels from the interpreter; safe interpreters
// do not ordinarily have access to stdin, stdout and stderr.
//
// NOTE: These channels are not added to the interpreter by the
// Tcl_CreateInterp call, but may be added later, by another I/O
// operation. We want to ensure that the interpreter does not have
// these channels even if it is being made safe after being used for
// some time..
 
chan = TclIO.getStdChannel( StdChannel.STDIN );
if ( chan != null )
{
TclIO.unregisterChannel( interp, chan );
}
chan = TclIO.getStdChannel( StdChannel.STDOUT );
if ( chan != null )
{
TclIO.unregisterChannel( interp, chan );
}
chan = TclIO.getStdChannel( StdChannel.STDERR );
if ( chan != null )
{
TclIO.unregisterChannel( interp, chan );
}
}
} // end InterpSlaveCmd
}
/trunk/TCL/src/commands/JoinCmd.cs
@@ -0,0 +1,71 @@
/*
* JoinCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: JoinCmd.java,v 1.1.1.1 1998/10/14 21:09:18 cvsadmin Exp $
*
*/
using System.Text;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "join" command in Tcl.</summary>
class JoinCmd : Command
{
 
/// <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;
}
}
}
/trunk/TCL/src/commands/LappendCmd.cs
@@ -0,0 +1,159 @@
/*
* LappendCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 1999 Mo DeJong.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: LappendCmd.java,v 1.3 2003/01/09 02:15:39 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "lappend" command in Tcl.</summary>
class LappendCmd : Command
{
/// <summary>
/// Tcl_LappendObjCmd -> LappendCmd.cmdProc
///
/// This procedure is invoked to process the "lappend" Tcl command.
/// See the user documentation for details on what it does.
/// </summary>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
TclObject varValue, newValue = null;
int i;//int numElems, i, j;
bool createdNewObj, createVar;
 
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, objv, "varName ?value value ...?" );
}
if ( objv.Length == 2 )
{
try
{
newValue = interp.getVar( objv[1], 0 );
}
catch ( TclException e )
{
// The variable doesn't exist yet. Just create it with an empty
// initial value.
varValue = TclList.newInstance();
 
try
{
newValue = interp.setVar( objv[1], varValue, 0 );
}
finally
{
if ( newValue == null )
varValue.release(); // free unneeded object
}
 
interp.resetResult();
return TCL.CompletionCode.RETURN;
}
}
else
{
// We have arguments to append. We used to call Tcl_SetVar2 to
// append each argument one at a time to ensure that traces were run
// for each append step. We now append the arguments all at once
// because it's faster. Note that a read trace and a write trace for
// the variable will now each only be called once. Also, if the
// variable's old value is unshared we modify it directly, otherwise
// we create a new copy to modify: this is "copy on write".
 
createdNewObj = false;
createVar = true;
 
try
{
varValue = interp.getVar( objv[1], 0 );
}
catch ( TclException e )
{
// We couldn't read the old value: either the var doesn't yet
// exist or it's an array element. If it's new, we will try to
// create it with Tcl_ObjSetVar2 below.
 
// FIXME : not sure we even need this parse for anything!
// If we do not need to parse could we at least speed it up a bit
 
string varName;
int nameBytes;
 
 
varName = objv[1].ToString();
nameBytes = varName.Length; // Number of Unicode chars in string
 
for ( i = 0; i < nameBytes; i++ )
{
if ( varName[i] == '(' )
{
i = nameBytes - 1;
if ( varName[i] == ')' )
{
// last char is ')' => array ref
createVar = false;
}
break;
}
}
varValue = TclList.newInstance();
createdNewObj = true;
}
 
// We only take this branch when the catch branch was not run
if ( createdNewObj == false && varValue.Shared )
{
varValue = varValue.duplicate();
createdNewObj = true;
}
 
// Insert the new elements at the end of the list.
 
for ( i = 2; i < objv.Length; i++ )
TclList.append( interp, varValue, objv[i] );
 
// No need to call varValue.invalidateStringRep() since it
// is called during the TclList.append operation.
 
// Now store the list object back into the variable. If there is an
// error setting the new value, decrement its ref count if it
// was new and we didn't create the variable.
 
try
{
 
newValue = interp.setVar( objv[1].ToString(), varValue, 0 );
}
catch ( TclException e )
{
if ( createdNewObj && !createVar )
{
varValue.release(); // free unneeded obj
}
throw;
}
}
 
// Set the interpreter's object result to refer to the variable's value
// object.
 
interp.setResult( newValue );
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/LindexCmd.cs
@@ -0,0 +1,51 @@
/*
* LindexCmd.java - -
*
* Implements the built-in "lindex" Tcl command.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: LindexCmd.java,v 1.2 2000/03/17 23:31:30 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements the built-in "lindex" command in Tcl.
*/
 
class LindexCmd : Command
{
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
if ( argv.Length < 3 )
{
throw new TclNumArgsException( interp, 1, argv, "list index" );
}
 
int size = TclList.getLength( interp, argv[1] );
int index = Util.getIntForIndex( interp, argv[2], size - 1 );
TclObject element = TclList.index( interp, argv[1], index );
 
if ( element != null )
{
interp.setResult( element );
}
else
{
interp.resetResult();
}
return TCL.CompletionCode.RETURN;
}
} // end
}
/trunk/TCL/src/commands/LinsertCmd.cs
@@ -0,0 +1,65 @@
/*
* LinsertCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: LinsertCmd.java,v 1.3 2003/01/09 02:15:39 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "linsert" command in Tcl.</summary>
 
class LinsertCmd : Command
{
/// <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 < 4 )
{
throw new TclNumArgsException( interp, 1, argv, "list index element ?element ...?" );
}
 
int size = TclList.getLength( interp, argv[1] );
int index = Util.getIntForIndex( interp, argv[2], size );
TclObject list = argv[1];
bool isDuplicate = false;
 
// If the list object is unshared we can modify it directly. Otherwise
// we create a copy to modify: this is "copy on write".
 
if ( list.Shared )
{
list = list.duplicate();
isDuplicate = true;
}
 
try
{
TclList.insert( interp, list, index, argv, 3, argv.Length - 1 );
interp.setResult( list );
}
catch ( TclException e )
{
if ( isDuplicate )
{
list.release();
}
throw;
}
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/ListCmd.cs
@@ -0,0 +1,45 @@
/*
* ListCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ListCmd.java,v 1.1.1.1 1998/10/14 21:09:19 cvsadmin Exp $
*
*/
using System;
using System.Text;
 
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "list" command in Tcl.</summary>
class ListCmd : Command
{
 
/// <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;
}
}
}
/trunk/TCL/src/commands/LlengthCmd.cs
@@ -0,0 +1,38 @@
/*
* LlengthCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: LlengthCmd.java,v 1.1.1.1 1998/10/14 21:09:21 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "llength" command in Tcl.</summary>
 
class LlengthCmd : Command
{
/// <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;
}
}
}
/trunk/TCL/src/commands/LrangeCmd.cs
@@ -0,0 +1,98 @@
/*
* LrangeCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: LrangeCmd.java,v 1.2 2000/03/17 23:31:30 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "lrange" command in Tcl.</summary>
 
class LrangeCmd : Command
{
/// <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 != 4 )
{
throw new TclNumArgsException( interp, 1, argv, "list first last" );
}
 
int size = TclList.getLength( interp, argv[1] );
int first;
int last;
 
first = Util.getIntForIndex( interp, argv[2], size - 1 );
last = Util.getIntForIndex( interp, argv[3], size - 1 );
 
if ( last < 0 )
{
interp.resetResult();
return TCL.CompletionCode.RETURN;
}
if ( first >= size )
{
interp.resetResult();
return TCL.CompletionCode.RETURN;
}
if ( first <= 0 && last >= size )
{
interp.setResult( argv[1] );
return TCL.CompletionCode.RETURN;
}
 
if ( first < 0 )
{
first = 0;
}
if ( first >= size )
{
first = size - 1;
}
if ( last < 0 )
{
last = 0;
}
if ( last >= size )
{
last = size - 1;
}
if ( first > last )
{
interp.resetResult();
return TCL.CompletionCode.RETURN;
}
 
TclObject list = TclList.newInstance();
 
list.preserve();
try
{
for ( int i = first; i <= last; i++ )
{
TclList.append( interp, list, TclList.index( interp, argv[1], i ) );
}
interp.setResult( list );
}
finally
{
list.release();
}
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/LreplaceCmd.cs
@@ -0,0 +1,95 @@
/*
* LreplaceCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: LreplaceCmd.java,v 1.5 2003/01/09 02:15:39 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "lreplace" command in Tcl.</summary>
 
class LreplaceCmd : Command
{
/// <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 < 4 )
{
throw new TclNumArgsException( interp, 1, argv, "list first last ?element element ...?" );
}
int size = TclList.getLength( interp, argv[1] );
int first = Util.getIntForIndex( interp, argv[2], size - 1 );
int last = Util.getIntForIndex( interp, argv[3], size - 1 );
int numToDelete;
 
if ( first < 0 )
{
first = 0;
}
 
// Complain if the user asked for a start element that is greater
// than the list length. This won't ever trigger for the "end*"
// case as that will be properly constrained by getIntForIndex
// because we use size-1 (to allow for replacing the last elem).
 
if ( ( first >= size ) && ( size > 0 ) )
{
 
throw new TclException( interp, "list doesn't contain element " + argv[2] );
}
if ( last >= size )
{
last = size - 1;
}
if ( first <= last )
{
numToDelete = ( last - first + 1 );
}
else
{
numToDelete = 0;
}
 
TclObject list = argv[1];
bool isDuplicate = false;
 
// If the list object is unshared we can modify it directly. Otherwise
// we create a copy to modify: this is "copy on write".
 
if ( list.Shared )
{
list = list.duplicate();
isDuplicate = true;
}
 
try
{
TclList.replace( interp, list, first, numToDelete, argv, 4, argv.Length - 1 );
interp.setResult( list );
}
catch ( TclException e )
{
if ( isDuplicate )
{
list.release();
}
throw;
}
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/LsearchCmd.cs
@@ -0,0 +1,510 @@
/*
* LsearchCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 2000 Christian Krone.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: LsearchCmd.java,v 1.2 2000/08/21 04:12:51 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements the built-in "lsearch" command in Tcl.
*/
 
class LsearchCmd : Command
{
 
private static readonly string[] options = new string[] { "-ascii", "-decreasing", "-dictionary", "-exact", "-increasing", "-integer", "-glob", "-real", "-regexp", "-sorted" };
internal const int LSEARCH_ASCII = 0;
internal const int LSEARCH_DECREASING = 1;
internal const int LSEARCH_DICTIONARY = 2;
internal const int LSEARCH_EXACT = 3;
internal const int LSEARCH_INCREASING = 4;
internal const int LSEARCH_INTEGER = 5;
internal const int LSEARCH_GLOB = 6;
internal const int LSEARCH_REAL = 7;
internal const int LSEARCH_REGEXP = 8;
internal const int LSEARCH_SORTED = 9;
 
internal const int ASCII = 0;
internal const int DICTIONARY = 1;
internal const int INTEGER = 2;
internal const int REAL = 3;
 
internal const int EXACT = 0;
internal const int GLOB = 1;
internal const int REGEXP = 2;
internal const int SORTED = 3;
 
/*
*-----------------------------------------------------------------------------
*
* cmdProc --
*
* This procedure is invoked to process the "lsearch" Tcl command.
* See the user documentation for details on what it does.
*
* Results:
* None.
*
* Side effects:
* See the user documentation.
*
*-----------------------------------------------------------------------------
*/
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
int mode = GLOB;
int dataType = ASCII;
bool isIncreasing = true;
TclObject pattern;
TclObject list;
 
if ( objv.Length < 3 )
{
throw new TclNumArgsException( interp, 1, objv, "?options? list pattern" );
}
 
for ( int i = 1; i < objv.Length - 2; i++ )
{
switch ( TclIndex.get( interp, objv[i], options, "option", 0 ) )
{
 
case LSEARCH_ASCII:
dataType = ASCII;
break;
 
case LSEARCH_DECREASING:
isIncreasing = false;
break;
 
case LSEARCH_DICTIONARY:
dataType = DICTIONARY;
break;
 
case LSEARCH_EXACT:
mode = EXACT;
break;
 
case LSEARCH_INCREASING:
isIncreasing = true;
break;
 
case LSEARCH_INTEGER:
dataType = INTEGER;
break;
 
case LSEARCH_GLOB:
mode = GLOB;
break;
 
case LSEARCH_REAL:
dataType = REAL;
break;
 
case LSEARCH_REGEXP:
mode = REGEXP;
break;
 
case LSEARCH_SORTED:
mode = SORTED;
break;
}
}
 
// Make sure the list argument is a list object and get its length and
// a pointer to its array of element pointers.
 
TclObject[] listv = TclList.getElements( interp, objv[objv.Length - 2] );
 
TclObject patObj = objv[objv.Length - 1];
string patternBytes = null;
int patInt = 0;
double patDouble = 0.0;
int length = 0;
if ( mode == EXACT || mode == SORTED )
{
switch ( dataType )
{
 
case ASCII:
case DICTIONARY:
 
patternBytes = patObj.ToString();
length = patternBytes.Length;
break;
 
case INTEGER:
patInt = TclInteger.get( interp, patObj );
break;
 
case REAL:
patDouble = TclDouble.get( interp, patObj );
break;
}
}
else
{
 
patternBytes = patObj.ToString();
length = patternBytes.Length;
}
 
// Set default index value to -1, indicating failure; if we find the
// item in the course of our search, index will be set to the correct
// value.
 
int index = -1;
if ( mode == SORTED )
{
// If the data is sorted, we can do a more intelligent search.
int match = 0;
int lower = -1;
int upper = listv.Length;
while ( lower + 1 != upper )
{
int i = ( lower + upper ) / 2;
switch ( dataType )
{
 
case ASCII:
{
 
string bytes = listv[i].ToString();
match = patternBytes.CompareTo( bytes );
break;
}
 
case DICTIONARY:
{
 
string bytes = listv[i].ToString();
match = DictionaryCompare( patternBytes, bytes );
break;
}
 
case INTEGER:
{
int objInt = TclInteger.get( interp, listv[i] );
if ( patInt == objInt )
{
match = 0;
}
else if ( patInt < objInt )
{
match = -1;
}
else
{
match = 1;
}
break;
}
 
case REAL:
{
double objDouble = TclDouble.get( interp, listv[i] );
if ( patDouble == objDouble )
{
match = 0;
}
else if ( patDouble < objDouble )
{
match = -1;
}
else
{
match = 1;
}
break;
}
}
if ( match == 0 )
{
 
// Normally, binary search is written to stop when it
// finds a match. If there are duplicates of an element in
// the list, our first match might not be the first occurance.
// Consider: 0 0 0 1 1 1 2 2 2
// To maintain consistancy with standard lsearch semantics,
// we must find the leftmost occurance of the pattern in the
// list. Thus we don't just stop searching here. This
// variation means that a search always makes log n
// comparisons (normal binary search might "get lucky" with
// an early comparison).
 
index = i;
upper = i;
}
else if ( match > 0 )
{
if ( isIncreasing )
{
lower = i;
}
else
{
upper = i;
}
}
else
{
if ( isIncreasing )
{
upper = i;
}
else
{
lower = i;
}
}
}
}
else
{
for ( int i = 0; i < listv.Length; i++ )
{
bool match = false;
switch ( mode )
{
 
case SORTED:
case EXACT:
{
switch ( dataType )
{
 
case ASCII:
{
 
string bytes = listv[i].ToString();
int elemLen = bytes.Length;
if ( length == elemLen )
{
match = bytes.Equals( patternBytes );
}
break;
}
 
case DICTIONARY:
{
 
string bytes = listv[i].ToString();
match = ( DictionaryCompare( bytes, patternBytes ) == 0 );
break;
}
 
case INTEGER:
{
int objInt = TclInteger.get( interp, listv[i] );
match = ( objInt == patInt );
break;
}
 
case REAL:
{
double objDouble = TclDouble.get( interp, listv[i] );
match = ( objDouble == patDouble );
break;
}
}
break;
}
 
case GLOB:
{
 
match = Util.stringMatch( listv[i].ToString(), patternBytes );
break;
}
 
case REGEXP:
{
 
match = Util.regExpMatch( interp, listv[i].ToString(), patObj );
break;
}
}
if ( match )
{
index = i;
break;
}
}
}
interp.setResult( index );
return TCL.CompletionCode.RETURN;
}
 
/*
*----------------------------------------------------------------------
*
* DictionaryCompare -> dictionaryCompare
*
* This function compares two strings as if they were being used in
* an index or card catalog. The case of alphabetic characters is
* ignored, except to break ties. Thus "B" comes before "b" but
* after "a". Also, integers embedded in the strings compare in
* numerical order. In other words, "x10y" comes after "x9y", not
* before it as it would when using strcmp().
*
* Results:
* A negative result means that the first element comes before the
* second, and a positive result means that the second element
* should come first. A result of zero means the two elements
* are equal and it doesn't matter which comes first.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
 
private static int DictionaryCompare( string left, string right )
// The strings to compare
{
char[] leftArr = left.ToCharArray();
char[] rightArr = right.ToCharArray();
char leftChar, rightChar, leftLower, rightLower;
int lInd = 0;
int rInd = 0;
int diff;
int secondaryDiff = 0;
 
while ( true )
{
if ( ( rInd < rightArr.Length ) && ( System.Char.IsDigit( rightArr[rInd] ) ) && ( lInd < leftArr.Length ) && ( System.Char.IsDigit( leftArr[lInd] ) ) )
{
// There are decimal numbers embedded in the two
// strings. Compare them as numbers, rather than
// strings. If one number has more leading zeros than
// the other, the number with more leading zeros sorts
// later, but only as a secondary choice.
 
int zeros = 0;
while ( ( rightArr[rInd] == '0' ) && ( rInd + 1 < rightArr.Length ) && ( System.Char.IsDigit( rightArr[rInd + 1] ) ) )
{
rInd++;
zeros--;
}
while ( ( leftArr[lInd] == '0' ) && ( lInd + 1 < leftArr.Length ) && ( System.Char.IsDigit( leftArr[lInd + 1] ) ) )
{
lInd++;
zeros++;
}
if ( secondaryDiff == 0 )
{
secondaryDiff = zeros;
}
 
// The code below compares the numbers in the two
// strings without ever converting them to integers. It
// does this by first comparing the lengths of the
// numbers and then comparing the digit values.
 
diff = 0;
while ( true )
{
if ( ( diff == 0 ) && ( lInd < leftArr.Length ) && ( rInd < rightArr.Length ) )
{
diff = leftArr[lInd] - rightArr[rInd];
}
rInd++;
lInd++;
if ( rInd >= rightArr.Length || !System.Char.IsDigit( rightArr[rInd] ) )
{
if ( lInd < leftArr.Length && System.Char.IsDigit( leftArr[lInd] ) )
{
return 1;
}
else
{
// The two numbers have the same length. See
// if their values are different.
 
if ( diff != 0 )
{
return diff;
}
break;
}
}
else if ( lInd >= leftArr.Length || !System.Char.IsDigit( leftArr[lInd] ) )
{
return -1;
}
}
continue;
}
 
// Convert character to Unicode for comparison purposes. If either
// string is at the terminating null, do a byte-wise comparison and
// bail out immediately.
 
if ( ( lInd < leftArr.Length ) && ( rInd < rightArr.Length ) )
{
 
// Convert both chars to lower for the comparison, because
// dictionary sorts are case insensitve. Covert to lower, not
// upper, so chars between Z and a will sort before A (where most
// other interesting punctuations occur)
 
leftChar = leftArr[lInd++];
rightChar = rightArr[rInd++];
leftLower = System.Char.ToLower( leftChar );
rightLower = System.Char.ToLower( rightChar );
}
else if ( lInd < leftArr.Length )
{
diff = -rightArr[rInd];
break;
}
else if ( rInd < rightArr.Length )
{
diff = leftArr[lInd];
break;
}
else
{
diff = 0;
break;
}
 
diff = leftLower - rightLower;
if ( diff != 0 )
{
return diff;
}
else if ( secondaryDiff == 0 )
{
if ( System.Char.IsUpper( leftChar ) && System.Char.IsLower( rightChar ) )
{
secondaryDiff = -1;
}
else if ( System.Char.IsUpper( rightChar ) && System.Char.IsLower( leftChar ) )
{
secondaryDiff = 1;
}
}
}
if ( diff == 0 )
{
diff = secondaryDiff;
}
return diff;
}
} // end LsearchCmd
}
/trunk/TCL/src/commands/LsetCmd.cs
@@ -0,0 +1,66 @@
/*
* LsetCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: LsetCmd.java,v 1.3 2003/01/09 02:15:39 mdejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "Lset" command in Tcl.</summary>
 
class LsetCmd : Command
{
/// <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 != 4 )
{
throw new TclNumArgsException( interp, 1, argv, "lset list index element" );
}
 
int size = TclList.getLength( interp, argv[1] );
int index = Util.getIntForIndex( interp, argv[2], size );
TclObject list = argv[1];
bool isDuplicate = false;
 
// If the list object is unshared we can modify it directly. Otherwise
// we create a copy to modify: this is "copy on write".
 
if ( list.Shared )
{
list = list.duplicate();
isDuplicate = true;
}
 
try
{ TclObject[] replace = new TclObject[1];
replace[0]=argv[3];
TclList.replace(interp,list,index,1,replace,0,0 );
interp.setResult( list );
}
catch ( TclException e )
{
if ( isDuplicate )
{
list.release();
}
throw;
}
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/LsortCmd.cs
@@ -0,0 +1,160 @@
/*
* LsortCmd.java
*
* The file implements the Tcl "lsort" command.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: LsortCmd.java,v 1.3 2003/01/09 02:15:39 mdejong Exp $
*/
using System;
namespace tcl.lang
{
 
/*
* This LsortCmd class implements the Command interface for specifying a new
* Tcl command. The Lsort command implements the built-in Tcl command "lsort"
* which is used to sort Tcl lists. See user documentation for more details.
*/
 
class LsortCmd : Command
{
 
/*
* List of switches that are legal in the lsort command.
*/
 
private static readonly string[] validOpts = new string[] { "-ascii", "-command", "-decreasing", "-dictionary", "-increasing", "-index", "-integer", "-real", "-unique" };
 
/*
*----------------------------------------------------------------------
*
* cmdProc --
*
* This procedure is invoked as part of the Command interface to
* process the "lsort" Tcl command. See the user documentation for
* details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
if ( argv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, argv, "?options? list" );
}
 
string command = null;
int sortMode = QSort.ASCII;
int sortIndex = -1;
bool sortIncreasing = true;
bool unique = false;
 
for ( int i = 1; i < argv.Length - 1; i++ )
{
int index = TclIndex.get( interp, argv[i], validOpts, "option", 0 );
 
switch ( index )
{
 
case 0:
sortMode = QSort.ASCII;
break;
 
 
case 1:
if ( i == argv.Length - 2 )
{
throw new TclException( interp, "\"-command\" option must be" + " followed by comparison command" );
}
sortMode = QSort.COMMAND;
 
command = argv[i + 1].ToString();
i++;
break;
 
 
case 2:
sortIncreasing = false;
break;
 
 
case 3:
sortMode = QSort.DICTIONARY;
break;
 
 
case 4:
sortIncreasing = true;
break;
 
 
case 5:
if ( i == argv.Length - 2 )
{
throw new TclException( interp, "\"-index\" option must be followed by list index" );
}
sortIndex = Util.getIntForIndex( interp, argv[i + 1], -2 );
 
command = argv[i + 1].ToString();
i++;
break;
 
 
case 6:
sortMode = QSort.INTEGER;
break;
 
 
case 7:
sortMode = QSort.REAL;
break;
 
case 8: /* -unique */
unique = true;
break;
}
}
 
TclObject list = argv[argv.Length - 1];
bool isDuplicate = false;
 
// If the list object is unshared we can modify it directly. Otherwise
// we create a copy to modify: this is "copy on write".
 
if ( list.Shared )
{
list = list.duplicate();
isDuplicate = true;
}
 
try
{
TclList.sort( interp, list, sortMode, sortIndex, sortIncreasing, command, unique );
interp.setResult( list );
}
catch ( TclException e )
{
if ( isDuplicate )
{
list.release();
}
throw;
}
return TCL.CompletionCode.RETURN;
}
} // LsortCmd
}
/trunk/TCL/src/commands/NamespaceCmd.cs
@@ -0,0 +1,3674 @@
#undef DEBUG
/*
* NamespaceCmd.java
*
* Copyright (c) 1993-1997 Lucent Technologies.
* Copyright (c) 1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 1999 Moses DeJong
*
* Originally implemented by
* Michael J. McLennan
* Bell Labs Innovations for Lucent Technologies
* mmclennan@lucent.com
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: NamespaceCmd.java,v 1.12 2001/05/05 22:38:13 mdejong Exp $
*/
using System;
using System.Collections;
using System.Text;
 
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "namespace" command in Tcl.
/// See the user documentation for details on what it does.
/// </summary>
 
 
public class NamespaceCmd : InternalRep, Command
{
 
// Flag passed to getNamespaceForQualName to indicate that it should
// search for a namespace rather than a command or variable inside a
// namespace. Note that this flag's value must not conflict with the values
// of TCL.VarFlag.GLOBAL_ONLY, TCL.VarFlag.NAMESPACE_ONLY, or TCL.VarFlag.CREATE_NS_IF_UNKNOWN.
 
 
// Initial size of stack allocated space for tail list - used when resetting
// shadowed command references in the functin: TclResetShadowedCmdRefs.
 
//private static final int NUM_TRAIL_ELEMS = 5;
 
// Count of the number of namespaces created. This value is used as a
// unique id for each namespace.
 
private static long numNsCreated = 0;
private static Object nsMutex;
 
//
// Flags used to represent the status of a namespace:
//
// NS_DYING - 1 means deleteNamespace has been called to delete the
// namespace but there are still active call frames on the Tcl
// stack that refer to the namespace. When the last call frame
// referring to it has been popped, it's variables and command
// will be destroyed and it will be marked "dead" (NS_DEAD).
// The namespace can no longer be looked up by name.
// NS_DEAD - 1 means deleteNamespace has been called to delete the
// namespace and no call frames still refer to it. Its
// variables and command have already been destroyed. This bit
// allows the namespace resolution code to recognize that the
// namespace is "deleted". When the last namespaceName object
// in any byte code code unit that refers to the namespace has
// been freed (i.e., when the namespace's refCount is 0), the
// namespace's storage will be freed.
 
internal const int NS_DYING = 0x01;
internal const int NS_DEAD = 0x02;
 
 
// Flag passed to getNamespaceForQualName to have it create all namespace
// components of a namespace-qualified name that cannot be found. The new
// namespaces are created within their specified parent. Note that this
// flag's value must not conflict with the values of the flags
// TCL.VarFlag.GLOBAL_ONLY, TCL.VarFlag.NAMESPACE_ONLY, and TCL.VarFlag.FIND_ONLY_NS
 
// internal const int TCL.VarFlag.CREATE_NS_IF_UNKNOWN = 0x800;
 
 
// This value corresponds to the Tcl_Obj.otherValuePtr pointer used
// in the C version of Tcl 8.1. Use it to keep track of a ResolvedNsName.
 
private ResolvedNsName otherValue = null;
 
 
/*
*----------------------------------------------------------------------
*
* Tcl_GetCurrentNamespace -> getCurrentNamespace
*
* Returns a reference to an interpreter's currently active namespace.
*
* Results:
* Returns a reference to the interpreter's current namespace.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
 
internal static Namespace getCurrentNamespace( Interp interp )
{
if ( interp.varFrame != null )
{
return interp.varFrame.ns;
}
else
{
return interp.globalNs;
}
}
 
/*
*----------------------------------------------------------------------
*
* Tcl_GetGlobalNamespace -> getGlobalNamespace
*
* Returns a reference to an interpreter's global :: namespace.
*
* Results:
* Returns a reference to the specified interpreter's global namespace.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
 
internal static Namespace getGlobalNamespace( Interp interp )
{
return interp.globalNs;
}
 
 
/*
*----------------------------------------------------------------------
*
* Tcl_PushCallFrame -> pushCallFrame
*
* Pushes a new call frame onto the interpreter's Tcl call stack.
* Called when executing a Tcl procedure or a "namespace eval" or
* "namespace inscope" command.
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Modifies the interpreter's Tcl call stack.
*
*----------------------------------------------------------------------
*/
 
internal static void pushCallFrame( Interp interp, CallFrame frame, Namespace namespace_Renamed, bool isProcCallFrame )
// If true, the frame represents a
// called Tcl procedure and may have local
// vars. Vars will ordinarily be looked up
// in the frame. If new variables are
// created, they will be created in the
// frame. If false, the frame is for a
// "namespace eval" or "namespace inscope"
// command and var references are treated
// as references to namespace variables.
{
Namespace ns;
 
if ( namespace_Renamed == null )
{
ns = getCurrentNamespace( interp );
}
else
{
ns = namespace_Renamed;
if ( ( ns.flags & NS_DEAD ) != 0 )
{
throw new TclRuntimeError( "Trying to push call frame for dead namespace" );
}
}
 
ns.activationCount++;
frame.ns = ns;
frame.isProcCallFrame = isProcCallFrame;
frame.objv = null;
 
frame.caller = interp.frame;
frame.callerVar = interp.varFrame;
 
if ( interp.varFrame != null )
{
frame.level = ( interp.varFrame.level + 1 );
}
else
{
frame.level = 1;
}
 
// FIXME : does Jacl need a procPtr in the CallFrame class?
//frame.procPtr = null; // no called procedure
 
frame.varTable = null; // and no local variables
 
// Compiled locals are not part of Jacl's CallFrame
 
// Push the new call frame onto the interpreter's stack of procedure
// call frames making it the current frame.
 
interp.frame = frame;
interp.varFrame = frame;
}
 
 
 
/*
*----------------------------------------------------------------------
*
* Tcl_PopCallFrame -> popCallFrame
*
* Removes a call frame from the Tcl call stack for the interpreter.
* Called to remove a frame previously pushed by Tcl_PushCallFrame.
*
* Results:
* None.
*
* Side effects:
* Modifies the call stack of the interpreter. Resets various fields of
* the popped call frame. If a namespace has been deleted and
* has no more activations on the call stack, the namespace is
* destroyed.
*
*----------------------------------------------------------------------
*/
 
internal static void popCallFrame( Interp interp )
{
CallFrame frame = interp.frame;
int saveErrFlag;
Namespace ns;
 
// It's important to remove the call frame from the interpreter's stack
// of call frames before deleting local variables, so that traces
// invoked by the variable deletion don't see the partially-deleted
// frame.
 
interp.frame = frame.caller;
interp.varFrame = frame.callerVar;
 
// Delete the local variables. As a hack, we save then restore the
// ERR_IN_PROGRESS flag in the interpreter. The problem is that there
// could be unset traces on the variables, which cause scripts to be
// evaluated. This will clear the ERR_IN_PROGRESS flag, losing stack
// trace information if the procedure was exiting with an error. The
// code below preserves the flag. Unfortunately, that isn't really
// enough: we really should preserve the errorInfo variable too
// (otherwise a nested error in the trace script will trash errorInfo).
// What's really needed is a general-purpose mechanism for saving and
// restoring interpreter state.
 
saveErrFlag = ( interp.flags & Parser.ERR_IN_PROGRESS );
 
if ( frame.varTable != null )
{
Var.deleteVars( interp, frame.varTable );
frame.varTable = null;
}
 
interp.flags |= saveErrFlag;
 
// Decrement the namespace's count of active call frames. If the
// namespace is "dying" and there are no more active call frames,
// call Tcl_DeleteNamespace to destroy it.
 
ns = frame.ns;
ns.activationCount--;
if ( ( ( ns.flags & NS_DYING ) != 0 ) && ( ns.activationCount == 0 ) )
{
deleteNamespace( ns );
}
frame.ns = null;
}
 
/*
*----------------------------------------------------------------------
*
* Tcl_CreateNamespace --
*
* Creates a new namespace with the given name. If there is no
* active namespace (i.e., the interpreter is being initialized),
* the global :: namespace is created and returned.
*
* Results:
* Returns a reference to the new namespace if successful. If the
* namespace already exists or if another error occurs, this routine
* returns null, along with an error message in the interpreter's
* result object.
*
* Side effects:
* If the name contains "::" qualifiers and a parent namespace does
* not already exist, it is automatically created.
*
*----------------------------------------------------------------------
*/
 
internal static Namespace createNamespace( Interp interp, string name, DeleteProc deleteProc )
{
Namespace ns, ancestor;
Namespace parent;
Namespace globalNs = getGlobalNamespace( interp );
string simpleName;
StringBuilder buffer1, buffer2;
 
// If there is no active namespace, the interpreter is being
// initialized.
 
if ( ( globalNs == null ) && ( interp.varFrame == null ) )
{
// Treat this namespace as the global namespace, and avoid
// looking for a parent.
 
parent = null;
simpleName = "";
}
else if ( name.Length == 0 )
{
/*
TclObject tobj = interp.getResult();
// FIXME : is there a test case to check this error result?
TclString.append(tobj,
"can't create namespace \"\": only global namespace can have empty name");
*/
 
// FIXME : is there a test case to check this error result?
interp.setResult( "can't create namespace \"\": only global namespace can have empty name" );
return null;
}
else
{
// Find the parent for the new namespace.
 
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
Namespace[] parentArr = new Namespace[1];
Namespace[] dummyArr = new Namespace[1];
string[] simpleArr = new string[1];
 
getNamespaceForQualName( interp, name, null, ( TCL.VarFlag.CREATE_NS_IF_UNKNOWN | TCL.VarFlag.LEAVE_ERR_MSG ), parentArr, dummyArr, dummyArr, simpleArr );
 
// Get the values out of the arrays!
parent = parentArr[0];
simpleName = simpleArr[0];
 
 
// If the unqualified name at the end is empty, there were trailing
// "::"s after the namespace's name which we ignore. The new
// namespace was already (recursively) created and is referenced
// by parent.
 
if ( simpleName.Length == 0 )
{
return parent;
}
 
// Check for a bad namespace name and make sure that the name
// does not already exist in the parent namespace.
 
if ( parent.childTable[simpleName] != null )
{
/*
TclObject tobj = interp.getResult();
// FIXME : is there a test case to check this error result?
TclString.append(tobj,
"can't create namespace \"" + name + "\": already exists");
*/
 
// FIXME : is there a test case to check this error result?
interp.setResult( "can't create namespace \"" + name + "\": already exists" );
return null;
}
}
 
// Create the new namespace and root it in its parent. Increment the
// count of namespaces created.
 
ns = new Namespace();
ns.name = simpleName;
ns.fullName = null; // set below
//ns.clientData = clientData;
ns.deleteProc = deleteProc;
ns.parent = parent;
ns.childTable = new Hashtable();
lock ( nsMutex )
{
numNsCreated++;
ns.nsId = numNsCreated;
}
ns.interp = interp;
ns.flags = 0;
ns.activationCount = 0;
// FIXME : there was a problem with the refcount because
// when the namespace was deleted the refocount was 0.
// We avoid this by just using a refcount of 1 for now.
// We can do ignore the refCount because GC will reclaim mem.
//ns.refCount = 0;
ns.refCount = 1;
ns.cmdTable = new Hashtable();
ns.varTable = new Hashtable();
ns.exportArray = null;
ns.numExportPatterns = 0;
ns.maxExportPatterns = 0;
 
// Jacl does not use these tcl compiler specific members
//ns.cmdRefEpoch = 0;
//ns.resolverEpoch = 0;
 
ns.resolver = null;
 
if ( parent != null )
{
SupportClass.PutElement( parent.childTable, simpleName, ns );
}
 
// Build the fully qualified name for this namespace.
 
buffer1 = new StringBuilder();
buffer2 = new StringBuilder();
for ( ancestor = ns; ancestor != null; ancestor = ancestor.parent )
{
if ( ancestor != globalNs )
{
buffer1.Append( "::" );
buffer1.Append( ancestor.name );
}
buffer1.Append( buffer2 );
 
buffer2.Length = 0;
buffer2.Append( buffer1 );
buffer1.Length = 0;
}
 
name = buffer2.ToString();
ns.fullName = name;
 
// Return a reference to the new namespace.
 
return ns;
}
 
/*
*----------------------------------------------------------------------
*
* Tcl_DeleteNamespace -> deleteNamespace
*
* Deletes a namespace and all of the commands, variables, and other
* namespaces within it.
*
* Results:
* None.
*
* Side effects:
* When a namespace is deleted, it is automatically removed as a
* child of its parent namespace. Also, all its commands, variables
* and child namespaces are deleted.
*
*----------------------------------------------------------------------
*/
 
internal static void deleteNamespace( Namespace namespace_Renamed )
{
Namespace ns = namespace_Renamed;
Interp interp = ns.interp;
Namespace globalNs = getGlobalNamespace( interp );
 
// If the namespace is on the call frame stack, it is marked as "dying"
// (NS_DYING is OR'd into its flags): the namespace can't be looked up
// by name but its commands and variables are still usable by those
// active call frames. When all active call frames referring to the
// namespace have been popped from the Tcl stack, popCallFrame will
// call this procedure again to delete everything in the namespace.
// If no nsName objects refer to the namespace (i.e., if its refCount
// is zero), its commands and variables are deleted and the storage for
// its namespace structure is freed. Otherwise, if its refCount is
// nonzero, the namespace's commands and variables are deleted but the
// structure isn't freed. Instead, NS_DEAD is OR'd into the structure's
// flags to allow the namespace resolution code to recognize that the
// namespace is "deleted".
 
if ( ns.activationCount > 0 )
{
ns.flags |= NS_DYING;
if ( ns.parent != null )
{
ns.parent.childTable.Remove( ns.name );
}
ns.parent = null;
}
else
{
// Delete the namespace and everything in it. If this is the global
// namespace, then clear it but don't free its storage unless the
// interpreter is being torn down.
 
teardownNamespace( ns );
 
if ( ( ns != globalNs ) || ( ( interp.flags & Parser.DELETED ) != 0 ) )
{
// If this is the global namespace, then it may have residual
// "errorInfo" and "errorCode" variables for errors that
// occurred while it was being torn down. Try to clear the
// variable list one last time.
 
Var.deleteVars( ns.interp, ns.varTable );
 
ns.childTable.Clear();
ns.cmdTable.Clear();
 
// If the reference count is 0, then discard the namespace.
// Otherwise, mark it as "dead" so that it can't be used.
 
if ( ns.refCount == 0 )
{
free( ns );
}
else
{
ns.flags |= NS_DEAD;
}
}
}
}
 
 
/*
*----------------------------------------------------------------------
*
* TclTeardownNamespace -> teardownNamespace
*
* Used internally to dismantle and unlink a namespace when it is
* deleted. Divorces the namespace from its parent, and deletes all
* commands, variables, and child namespaces.
*
* This is kept separate from Tcl_DeleteNamespace so that the global
* namespace can be handled specially. Global variables like
* "errorInfo" and "errorCode" need to remain intact while other
* namespaces and commands are torn down, in case any errors occur.
*
* Results:
* None.
*
* Side effects:
* Removes this namespace from its parent's child namespace hashtable.
* Deletes all commands, variables and namespaces in this namespace.
* If this is the global namespace, the "errorInfo" and "errorCode"
* variables are left alone and deleted later.
*
*----------------------------------------------------------------------
*/
 
internal static void teardownNamespace( Namespace ns )
{
Interp interp = ns.interp;
IEnumerator search;
Namespace globalNs = getGlobalNamespace( interp );
int i;
 
// Start by destroying the namespace's variable table,
// since variables might trigger traces.
 
if ( ns == globalNs )
{
// This is the global namespace, so be careful to preserve the
// "errorInfo" and "errorCode" variables. These might be needed
// later on if errors occur while deleting commands. We are careful
// to destroy and recreate the "errorInfo" and "errorCode"
// variables, in case they had any traces on them.
 
string errorInfoStr, errorCodeStr;
 
try
{
 
errorInfoStr = interp.getVar( "errorInfo", TCL.VarFlag.GLOBAL_ONLY ).ToString();
}
catch ( TclException e )
{
errorInfoStr = null;
}
 
try
{
 
errorCodeStr = interp.getVar( "errorCode", TCL.VarFlag.GLOBAL_ONLY ).ToString();
}
catch ( TclException e )
{
errorCodeStr = null;
}
 
Var.deleteVars( interp, ns.varTable );
 
if ( (System.Object)errorInfoStr != null )
{
try
{
interp.setVar( "errorInfo", errorInfoStr, TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
// ignore an exception while setting this var
}
}
if ( (System.Object)errorCodeStr != null )
{
try
{
interp.setVar( "errorCode", errorCodeStr, TCL.VarFlag.GLOBAL_ONLY );
}
catch ( TclException e )
{
// ignore an exception while setting this var
}
}
}
else
{
// Variable table should be cleared.
Var.deleteVars( interp, ns.varTable );
}
 
// Remove the namespace from its parent's child hashtable.
 
if ( ns.parent != null )
{
ns.parent.childTable.Remove( ns.name );
}
ns.parent = null;
 
// Delete all the child namespaces.
//
// BE CAREFUL: When each child is deleted, it will divorce
// itself from its parent. You can't traverse a hash table
// properly if its elements are being deleted. We use only
// the Tcl_FirstHashEntry function to be safe.
 
foreach ( Namespace childNs in new ArrayList( ns.childTable.Values ) )
{
deleteNamespace( childNs );
}
 
// Delete all commands in this namespace. Be careful when traversing the
// hash table: when each command is deleted, it removes itself from the
// command table.
 
// FIXME : double check that using an enumeration for a hashtable
// that changes is ok in Java! Also call deleteCommand... correctly!
foreach ( WrappedCommand cmd in new ArrayList( ns.cmdTable.Values ) )
{
interp.deleteCommandFromToken( cmd );
}
 
ns.cmdTable.Clear();
 
// Free the namespace's export pattern array.
 
if ( ns.exportArray != null )
{
ns.exportArray = null;
ns.numExportPatterns = 0;
ns.maxExportPatterns = 0;
}
 
// Callback invoked when namespace is deleted
 
if ( ns.deleteProc != null )
{
ns.deleteProc.delete();
}
ns.deleteProc = null;
 
// Reset the namespace's id field to ensure that this namespace won't
// be interpreted as valid by, e.g., the cache validation code for
// cached command references in Tcl_GetCommandFromObj.
 
ns.nsId = 0;
}
 
 
/*
*----------------------------------------------------------------------
*
* NamespaceFree -> free
*
* Called after a namespace has been deleted, when its
* reference count reaches 0. Frees the data structure
* representing the namespace.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
 
internal static void free( Namespace ns )
{
// Most of the namespace's contents are freed when the namespace is
// deleted by Tcl_DeleteNamespace. All that remains is to free its names
// (for error messages), and the structure itself.
 
ns.name = null;
ns.fullName = null;
}
 
/*
*----------------------------------------------------------------------
*
* Tcl_Export -> exportList
*
* Makes all the commands matching a pattern available to later be
* imported from the namespace specified by namespace (or the
* current namespace if namespace is null). The specified pattern is
* appended onto the namespace's export pattern list, which is
* optionally cleared beforehand.
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Appends the export pattern onto the namespace's export list.
* Optionally reset the namespace's export pattern list.
*
*----------------------------------------------------------------------
*/
 
internal static void exportList( Interp interp, Namespace namespace_Renamed, string pattern, bool resetListFirst )
{
int INIT_EXPORT_PATTERNS = 5;
Namespace ns, exportNs;
Namespace currNs = getCurrentNamespace( interp );
string simplePattern, patternCpy;
int neededElems, len, i;
 
// If the specified namespace is null, use the current namespace.
 
if ( namespace_Renamed == null )
{
ns = currNs;
}
else
{
ns = namespace_Renamed;
}
 
// If resetListFirst is true (nonzero), clear the namespace's export
// pattern list.
 
if ( resetListFirst )
{
if ( ns.exportArray != null )
{
for ( i = 0; i < ns.numExportPatterns; i++ )
{
ns.exportArray[i] = null;
}
ns.exportArray = null;
ns.numExportPatterns = 0;
ns.maxExportPatterns = 0;
}
}
 
// Check that the pattern doesn't have namespace qualifiers.
 
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
Namespace[] exportNsArr = new Namespace[1];
Namespace[] dummyArr = new Namespace[1];
string[] simplePatternArr = new string[1];
 
getNamespaceForQualName( interp, pattern, ns, TCL.VarFlag.LEAVE_ERR_MSG, exportNsArr, dummyArr, dummyArr, simplePatternArr );
 
// get the values out of the arrays
 
exportNs = exportNsArr[0];
simplePattern = simplePatternArr[0];
 
if ( ( exportNs != ns ) || ( pattern.CompareTo( simplePattern ) != 0 ) )
{
throw new TclException( interp, "invalid export pattern \"" + pattern + "\": pattern can't specify a namespace" );
}
 
// Make sure there is room in the namespace's pattern array for the
// new pattern.
 
neededElems = ns.numExportPatterns + 1;
if ( ns.exportArray == null )
{
ns.exportArray = new string[INIT_EXPORT_PATTERNS];
ns.numExportPatterns = 0;
ns.maxExportPatterns = INIT_EXPORT_PATTERNS;
}
else if ( neededElems > ns.maxExportPatterns )
{
int numNewElems = 2 * ns.maxExportPatterns;
string[] newArray = new string[numNewElems];
Array.Copy( (System.Array)ns.exportArray, 0, (System.Array)newArray, 0, ns.numExportPatterns );
ns.exportArray = newArray;
ns.maxExportPatterns = numNewElems;
}
 
// Add the pattern to the namespace's array of export patterns.
 
ns.exportArray[ns.numExportPatterns] = pattern;
ns.numExportPatterns++;
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* Tcl_AppendExportList -> appendExportList
*
* Appends onto the argument object the list of export patterns for the
* specified namespace.
*
* Results:
* The method will return when successful; in this case the object
* referenced by obj has each export pattern appended to it. If an
* error occurs, an exception and the interpreter's result
* holds an error message.
*
* Side effects:
* If necessary, the object referenced by obj is converted into
* a list object.
*
*----------------------------------------------------------------------
*/
 
internal static void appendExportList( Interp interp, Namespace namespace_Renamed, TclObject obj )
{
Namespace ns;
int i;
 
// If the specified namespace is null, use the current namespace.
 
if ( namespace_Renamed == null )
{
ns = getCurrentNamespace( interp );
}
else
{
ns = namespace_Renamed;
}
 
// Append the export pattern list onto objPtr.
 
for ( i = 0; i < ns.numExportPatterns; i++ )
{
TclList.append( interp, obj, TclString.newInstance( ns.exportArray[i] ) );
}
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* Tcl_Import -> importList
*
* Imports all of the commands matching a pattern into the namespace
* specified by namespace (or the current namespace if namespace
* is null). This is done by creating a new command (the "imported
* command") that points to the real command in its original namespace.
*
* If matching commands are on the autoload path but haven't been
* loaded yet, this command forces them to be loaded, then creates
* the links to them.
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Creates new commands in the importing namespace. These indirect
* calls back to the real command and are deleted if the real commands
* are deleted.
*
*----------------------------------------------------------------------
*/
 
internal static void importList( Interp interp, Namespace namespace_Renamed, string pattern, bool allowOverwrite )
{
Namespace ns, importNs;
Namespace currNs = getCurrentNamespace( interp );
string simplePattern, cmdName;
IEnumerator search;
WrappedCommand cmd, realCmd;
ImportRef ref_Renamed;
WrappedCommand autoCmd, importedCmd;
ImportedCmdData data;
bool wasExported;
int i, result;
 
// If the specified namespace is null, use the current namespace.
 
if ( namespace_Renamed == null )
{
ns = currNs;
}
else
{
ns = namespace_Renamed;
}
 
// First, invoke the "auto_import" command with the pattern
// being imported. This command is part of the Tcl library.
// It looks for imported commands in autoloaded libraries and
// loads them in. That way, they will be found when we try
// to create links below.
 
autoCmd = findCommand( interp, "auto_import", null, TCL.VarFlag.GLOBAL_ONLY );
 
if ( autoCmd != null )
{
TclObject[] objv = new TclObject[2];
 
objv[0] = TclString.newInstance( "auto_import" );
objv[0].preserve();
objv[1] = TclString.newInstance( pattern );
objv[1].preserve();
 
cmd = autoCmd;
try
{
// Invoke the command with the arguments
cmd.cmd.cmdProc( interp, objv );
}
finally
{
objv[0].release();
objv[1].release();
}
 
interp.resetResult();
}
 
// From the pattern, find the namespace from which we are importing
// and get the simple pattern (no namespace qualifiers or ::'s) at
// the end.
 
if ( pattern.Length == 0 )
{
throw new TclException( interp, "empty import pattern" );
}
 
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
Namespace[] importNsArr = new Namespace[1];
Namespace[] dummyArr = new Namespace[1];
string[] simplePatternArr = new string[1];
 
getNamespaceForQualName( interp, pattern, ns, TCL.VarFlag.LEAVE_ERR_MSG, importNsArr, dummyArr, dummyArr, simplePatternArr );
 
importNs = importNsArr[0];
simplePattern = simplePatternArr[0];
 
if ( importNs == null )
{
throw new TclException( interp, "unknown namespace in import pattern \"" + pattern + "\"" );
}
if ( importNs == ns )
{
if ( (System.Object)pattern == (System.Object)simplePattern )
{
throw new TclException( interp, "no namespace specified in import pattern \"" + pattern + "\"" );
}
else
{
throw new TclException( interp, "import pattern \"" + pattern + "\" tries to import from namespace \"" + importNs.name + "\" into itself" );
}
}
 
// Scan through the command table in the source namespace and look for
// exported commands that match the string pattern. Create an "imported
// command" in the current namespace for each imported command; these
// commands redirect their invocations to the "real" command.
 
 
for ( search = importNs.cmdTable.Keys.GetEnumerator(); search.MoveNext(); )
{
 
cmdName = ( (string)search.Current );
if ( Util.stringMatch( cmdName, simplePattern ) )
{
// The command cmdName in the source namespace matches the
// pattern. Check whether it was exported. If it wasn't,
// we ignore it.
 
wasExported = false;
for ( i = 0; i < importNs.numExportPatterns; i++ )
{
if ( Util.stringMatch( cmdName, importNs.exportArray[i] ) )
{
wasExported = true;
break;
}
}
if ( !wasExported )
{
continue;
}
 
// Unless there is a name clash, create an imported command
// in the current namespace that refers to cmdPtr.
 
if ( ( ns.cmdTable[cmdName] == null ) || allowOverwrite )
{
// Create the imported command and its client data.
// To create the new command in the current namespace,
// generate a fully qualified name for it.
 
StringBuilder ds;
 
ds = new StringBuilder();
ds.Append( ns.fullName );
if ( ns != interp.globalNs )
{
ds.Append( "::" );
}
ds.Append( cmdName );
 
// Check whether creating the new imported command in the
// current namespace would create a cycle of imported->real
// command references that also would destroy an existing
// "real" command already in the current namespace.
 
cmd = (WrappedCommand)importNs.cmdTable[cmdName];
 
if ( cmd.cmd is ImportedCmdData )
{
// This is actually an imported command, find
// the real command it references
realCmd = getOriginalCommand( cmd );
if ( ( realCmd != null ) && ( realCmd.ns == currNs ) && ( currNs.cmdTable[cmdName] != null ) )
{
throw new TclException( interp, "import pattern \"" + pattern + "\" would create a loop containing command \"" + ds.ToString() + "\"" );
}
}
 
data = new ImportedCmdData();
 
// Create the imported command inside the interp
interp.createCommand( ds.ToString(), data );
 
// Lookup in the namespace for the new WrappedCommand
importedCmd = findCommand( interp, ds.ToString(), ns, ( TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.LEAVE_ERR_MSG ) );
 
data.realCmd = cmd;
data.self = importedCmd;
 
// Create an ImportRef structure describing this new import
// command and add it to the import ref list in the "real"
// command.
 
ref_Renamed = new ImportRef();
ref_Renamed.importedCmd = importedCmd;
ref_Renamed.next = cmd.importRef;
cmd.importRef = ref_Renamed;
}
else
{
throw new TclException( interp, "can't import command \"" + cmdName + "\": already exists" );
}
}
}
return;
}
 
/*
*----------------------------------------------------------------------
*
* Tcl_ForgetImport -> forgetImport
*
* Deletes previously imported commands. Given a pattern that may
* include the name of an exporting namespace, this procedure first
* finds all matching exported commands. It then looks in the namespace
* specified by namespace for any corresponding previously imported
* commands, which it deletes. If namespace is null, commands are
* deleted from the current namespace.
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* May delete commands.
*
*----------------------------------------------------------------------
*/
 
internal static void forgetImport( Interp interp, Namespace namespace_Renamed, string pattern )
{
Namespace ns, importNs, actualCtx;
string simplePattern, cmdName;
IEnumerator search;
WrappedCommand cmd;
 
// If the specified namespace is null, use the current namespace.
 
if ( namespace_Renamed == null )
{
ns = getCurrentNamespace( interp );
}
else
{
ns = namespace_Renamed;
}
 
// From the pattern, find the namespace from which we are importing
// and get the simple pattern (no namespace qualifiers or ::'s) at
// the end.
 
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
Namespace[] importNsArr = new Namespace[1];
Namespace[] dummyArr = new Namespace[1];
Namespace[] actualCtxArr = new Namespace[1];
string[] simplePatternArr = new string[1];
 
getNamespaceForQualName( interp, pattern, ns, TCL.VarFlag.LEAVE_ERR_MSG, importNsArr, dummyArr, actualCtxArr, simplePatternArr );
 
// get the values out of the arrays
importNs = importNsArr[0];
actualCtx = actualCtxArr[0];
simplePattern = simplePatternArr[0];
 
// FIXME : the above call passes TCL.VarFlag.LEAVE_ERR_MSG, but
// it seems like this will be a problem when exception is raised!
if ( importNs == null )
{
throw new TclException( interp, "unknown namespace in namespace forget pattern \"" + pattern + "\"" );
}
 
// Scan through the command table in the source namespace and look for
// exported commands that match the string pattern. If the current
// namespace has an imported command that refers to one of those real
// commands, delete it.
 
 
for ( search = importNs.cmdTable.Keys.GetEnumerator(); search.MoveNext(); )
{
 
cmdName = ( (string)search.Current );
if ( Util.stringMatch( cmdName, simplePattern ) )
{
cmd = (WrappedCommand)ns.cmdTable[cmdName];
if ( cmd != null )
{
// cmd of same name in current namespace
if ( cmd.cmd is ImportedCmdData )
{
interp.deleteCommandFromToken( cmd );
}
}
}
}
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* TclGetOriginalCommand -> getOriginalCommand
*
* An imported command is created in a namespace when a "real" command
* is imported from another namespace. If the specified command is an
* imported command, this procedure returns the original command it
* refers to.
*
* Results:
* If the command was imported into a sequence of namespaces a, b,...,n
* where each successive namespace just imports the command from the
* previous namespace, this procedure returns the Tcl_Command token in
* the first namespace, a. Otherwise, if the specified command is not
* an imported command, the procedure returns null.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
 
internal static WrappedCommand getOriginalCommand( WrappedCommand command )
{
WrappedCommand cmd = command;
ImportedCmdData data;
 
if ( !( cmd.cmd is ImportedCmdData ) )
{
return null;
}
 
while ( cmd.cmd is ImportedCmdData )
{
data = (ImportedCmdData)cmd.cmd;
cmd = data.realCmd;
}
return cmd;
}
 
 
/*
*----------------------------------------------------------------------
*
* InvokeImportedCmd -> invokeImportedCmd
*
* Invoked by Tcl whenever the user calls an imported command that
* was created by Tcl_Import. Finds the "real" command (in another
* namespace), and passes control to it.
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Returns a result in the interpreter's result object. If anything
* goes wrong, the result object is set to an error message.
*
*----------------------------------------------------------------------
*/
 
internal static void invokeImportedCmd( Interp interp, ImportedCmdData data, TclObject[] objv )
{
WrappedCommand realCmd = data.realCmd;
realCmd.cmd.cmdProc( interp, objv );
}
 
 
/*
*----------------------------------------------------------------------
*
* DeleteImportedCmd -> deleteImportedCmd
*
* Invoked by Tcl whenever an imported command is deleted. The "real"
* command keeps a list of all the imported commands that refer to it,
* so those imported commands can be deleted when the real command is
* deleted. This procedure removes the imported command reference from
* the real command's list, and frees up the memory associated with
* the imported command.
*
* Results:
* None.
*
* Side effects:
* Removes the imported command from the real command's import list.
*
*----------------------------------------------------------------------
*/
 
internal static void deleteImportedCmd( ImportedCmdData data )
// The data object for this imported command
{
WrappedCommand realCmd = data.realCmd;
WrappedCommand self = data.self;
ImportRef ref_Renamed, prev;
 
prev = null;
for ( ref_Renamed = realCmd.importRef; ref_Renamed != null; ref_Renamed = ref_Renamed.next )
{
if ( ref_Renamed.importedCmd == self )
{
// Remove ref from real command's list of imported commands
// that refer to it.
 
if ( prev == null )
{
// ref is first in list
realCmd.importRef = ref_Renamed.next;
}
else
{
prev.next = ref_Renamed.next;
}
ref_Renamed = null;
data = null;
return;
}
prev = ref_Renamed;
}
 
throw new TclRuntimeError( "DeleteImportedCmd: did not find cmd in real cmd's list of import references" );
}
 
/*
*----------------------------------------------------------------------
*
* TclGetNamespaceForQualName -> getNamespaceForQualName
*
* Given a qualified name specifying a command, variable, or namespace,
* and a namespace in which to resolve the name, this procedure returns
* a pointer to the namespace that contains the item. A qualified name
* consists of the "simple" name of an item qualified by the names of
* an arbitrary number of containing namespace separated by "::"s. If
* the qualified name starts with "::", it is interpreted absolutely
* from the global namespace. Otherwise, it is interpreted relative to
* the namespace specified by cxtNsPtr if it is non-null. If cxtNsPtr
* is null, the name is interpreted relative to the current namespace.
*
* A relative name like "foo::bar::x" can be found starting in either
* the current namespace or in the global namespace. So each search
* usually follows two tracks, and two possible namespaces are
* returned. If the procedure sets either nsPtrPtr[0] or altNsPtrPtr[0] to
* null, then that path failed.
*
* If "flags" contains TCL.VarFlag.GLOBAL_ONLY, the relative qualified name is
* sought only in the global :: namespace. The alternate search
* (also) starting from the global namespace is ignored and
* altNsPtrPtr[0] is set null.
*
* If "flags" contains TCL.VarFlag.NAMESPACE_ONLY, the relative qualified
* name is sought only in the namespace specified by cxtNsPtr. The
* alternate search starting from the global namespace is ignored and
* altNsPtrPtr[0] is set null. If both TCL.VarFlag.GLOBAL_ONLY and
* TCL.VarFlag.NAMESPACE_ONLY are specified, TCL.VarFlag.GLOBAL_ONLY is ignored and
* the search starts from the namespace specified by cxtNsPtr.
*
* If "flags" contains TCL.VarFlag.CREATE_NS_IF_UNKNOWN, all namespace
* components of the qualified name that cannot be found are
* automatically created within their specified parent. This makes sure
* that functions like Tcl_CreateCommand always succeed. There is no
* alternate search path, so altNsPtrPtr[0] is set null.
*
* If "flags" contains TCL.VarFlag.FIND_ONLY_NS, the qualified name is treated as a
* reference to a namespace, and the entire qualified name is
* followed. If the name is relative, the namespace is looked up only
* in the current namespace. A pointer to the namespace is stored in
* nsPtrPtr[0] and null is stored in simpleNamePtr[0]. Otherwise, if
* TCL.VarFlag.FIND_ONLY_NS is not specified, only the leading components are
* treated as namespace names, and a pointer to the simple name of the
* final component is stored in simpleNamePtr[0].
*
* Results:
* It sets nsPtrPtr[0] and altNsPtrPtr[0] to point to the two possible
* namespaces which represent the last (containing) namespace in the
* qualified name. If the procedure sets either nsPtrPtr[0] or altNsPtrPtr[0]
* to null, then the search along that path failed. The procedure also
* stores a pointer to the simple name of the final component in
* simpleNamePtr[0]. If the qualified name is "::" or was treated as a
* namespace reference (TCL.VarFlag.FIND_ONLY_NS), the procedure stores a pointer
* to the namespace in nsPtrPtr[0], null in altNsPtrPtr[0], and sets
* simpleNamePtr[0] to an empty string.
*
* If there is an error, this procedure returns TCL_ERROR. If "flags"
* contains TCL_LEAVE_ERR_MSG, an error message is returned in the
* interpreter's result object. Otherwise, the interpreter's result
* object is left unchanged.
*
* actualCxtPtrPtr[0] is set to the actual context namespace. It is
* set to the input context namespace pointer in cxtNsPtr. If cxtNsPtr
* is null, it is set to the current namespace context.
*
* Side effects:
* If "flags" contains TCL.VarFlag.CREATE_NS_IF_UNKNOWN, new namespaces may be
* created.
*
*----------------------------------------------------------------------
*/
 
internal static void getNamespaceForQualName( Interp interp, string qualName, Namespace cxtNsPtr, TCL.VarFlag flags, Namespace[] nsPtrPtr, Namespace[] altNsPtrPtr, Namespace[] actualCxtPtrPtr, string[] simpleNamePtr )
{
 
 
// FIXME : remove extra method call checks when we are sure this works!
 
if ( true )
{
// check invariants
if ( ( nsPtrPtr == null ) || ( nsPtrPtr.Length != 1 ) )
{
 
throw new System.SystemException( "nsPtrPtr " + nsPtrPtr );
}
if ( ( altNsPtrPtr == null ) || ( altNsPtrPtr.Length != 1 ) )
{
 
throw new System.SystemException( "altNsPtrPtr " + altNsPtrPtr );
}
if ( ( actualCxtPtrPtr == null ) || ( actualCxtPtrPtr.Length != 1 ) )
{
 
throw new System.SystemException( "actualCxtPtrPtr " + actualCxtPtrPtr );
}
if ( ( simpleNamePtr == null ) || ( simpleNamePtr.Length != 1 ) )
{
 
throw new System.SystemException( "simpleNamePtr " + simpleNamePtr );
}
}
 
 
 
 
Namespace ns = cxtNsPtr;
Namespace altNs;
Namespace globalNs = getGlobalNamespace( interp );
Namespace entryNs;
string start, end;
string nsName;
int len;
int start_ind, end_ind, name_len;
 
// Determine the context namespace ns in which to start the primary
// search. If TCL.VarFlag.NAMESPACE_ONLY or TCL.VarFlag.FIND_ONLY_NS was specified, search
// from the current namespace. If the qualName name starts with a "::"
// or TCL.VarFlag.GLOBAL_ONLY was specified, search from the global
// namespace. Otherwise, use the given namespace given in cxtNsPtr, or
// if that is null, use the current namespace context. Note that we
// always treat two or more adjacent ":"s as a namespace separator.
 
if ( ( flags & ( TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.FIND_ONLY_NS ) ) != 0 )
{
ns = getCurrentNamespace( interp );
}
else if ( ( flags & TCL.VarFlag.GLOBAL_ONLY ) != 0 )
{
ns = globalNs;
}
else if ( ns == null )
{
if ( interp.varFrame != null )
{
ns = interp.varFrame.ns;
}
else
{
ns = interp.globalNs;
}
}
 
 
 
start_ind = 0;
name_len = qualName.Length;
 
if ( ( name_len >= 2 ) && ( qualName[0] == ':' ) && ( qualName[1] == ':' ) )
{
start_ind = 2; // skip over the initial ::
 
while ( ( start_ind < name_len ) && ( qualName[start_ind] == ':' ) )
{
start_ind++; // skip over a subsequent :
}
 
ns = globalNs;
if ( start_ind >= name_len )
{
// qualName is just two or more ":"s
nsPtrPtr[0] = globalNs;
altNsPtrPtr[0] = null;
actualCxtPtrPtr[0] = globalNs;
simpleNamePtr[0] = ""; // points to empty string
return;
}
}
actualCxtPtrPtr[0] = ns;
 
 
// Start an alternate search path starting with the global namespace.
// However, if the starting context is the global namespace, or if the
// flag is set to search only the namespace cxtNs, ignore the
// alternate search path.
 
 
altNs = globalNs;
if ( ( ns == globalNs ) || ( ( flags & ( TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.FIND_ONLY_NS ) ) != 0 ) )
{
altNs = null;
}
 
 
// Loop to resolve each namespace qualifier in qualName.
 
end_ind = start_ind;
 
while ( start_ind < name_len )
{
// Find the next namespace qualifier (i.e., a name ending in "::")
// or the end of the qualified name (i.e., a name ending in "\0").
// Set len to the number of characters, starting from start,
// in the name; set end to point after the "::"s or at the "\0".
 
len = 0;
for ( end_ind = start_ind; end_ind < name_len; end_ind++ )
{
if ( ( ( name_len - end_ind ) > 1 ) && ( qualName[end_ind] == ':' ) && ( qualName[end_ind + 1] == ':' ) )
{
end_ind += 2; // skip over the initial ::
while ( ( end_ind < name_len ) && ( qualName[end_ind] == ':' ) )
{
end_ind++; // skip over a subsequent :
}
break;
}
len++;
}
 
 
if ( ( end_ind == name_len ) && !( ( end_ind - start_ind >= 2 ) && ( ( qualName[end_ind - 1] == ':' ) && ( qualName[end_ind - 2] == ':' ) ) ) )
{
 
// qualName ended with a simple name at start. If TCL.VarFlag.FIND_ONLY_NS
// was specified, look this up as a namespace. Otherwise,
// start is the name of a cmd or var and we are done.
 
if ( ( flags & TCL.VarFlag.FIND_ONLY_NS ) != 0 )
{
// assign the string from start_ind to the end of the name string
nsName = qualName.Substring( start_ind );
}
else
{
nsPtrPtr[0] = ns;
altNsPtrPtr[0] = altNs;
simpleNamePtr[0] = qualName.Substring( start_ind );
return;
}
}
else
{
// start points to the beginning of a namespace qualifier ending
// in "::". Create new string with the namespace qualifier.
 
nsName = qualName.Substring( start_ind, ( start_ind + len ) - ( start_ind ) );
}
 
 
 
// Look up the namespace qualifier nsName in the current namespace
// context. If it isn't found but TCL.VarFlag.CREATE_NS_IF_UNKNOWN is set,
// create that qualifying namespace. This is needed for procedures
// like Tcl_CreateCommand that cannot fail.
 
if ( ns != null )
{
entryNs = (Namespace)ns.childTable[nsName];
if ( entryNs != null )
{
ns = entryNs;
}
else if ( ( flags & TCL.VarFlag.CREATE_NS_IF_UNKNOWN ) != 0 )
{
CallFrame frame = interp.newCallFrame();
 
pushCallFrame( interp, frame, ns, false );
ns = createNamespace( interp, nsName, null );
 
popCallFrame( interp );
if ( ns == null )
{
throw new System.SystemException( "Could not create namespace " + nsName );
}
}
else
{
ns = null; // namespace not found and wasn't created
}
}
 
 
// Look up the namespace qualifier in the alternate search path too.
 
if ( altNs != null )
{
altNs = (Namespace)altNs.childTable[nsName];
}
 
// If both search paths have failed, return null results.
 
if ( ( ns == null ) && ( altNs == null ) )
{
nsPtrPtr[0] = null;
altNsPtrPtr[0] = null;
simpleNamePtr[0] = null;
return;
}
 
start_ind = end_ind;
}
 
 
// We ignore trailing "::"s in a namespace name, but in a command or
// variable name, trailing "::"s refer to the cmd or var named {}.
 
if ( ( ( flags & TCL.VarFlag.FIND_ONLY_NS ) != 0 ) || ( ( end_ind > start_ind ) && ( qualName[end_ind - 1] != ':' ) ) )
{
simpleNamePtr[0] = null; // found namespace name
}
else
{
// FIXME : make sure this does not throw exception when end_ind is at the end of the string
simpleNamePtr[0] = qualName.Substring( end_ind ); // found cmd/var: points to empty string
}
 
 
// As a special case, if we are looking for a namespace and qualName
// is "" and the current active namespace (ns) is not the global
// namespace, return null (no namespace was found). This is because
// namespaces can not have empty names except for the global namespace.
 
if ( ( ( flags & TCL.VarFlag.FIND_ONLY_NS ) != 0 ) && ( name_len == 0 ) && ( ns != globalNs ) )
{
ns = null;
}
 
nsPtrPtr[0] = ns;
altNsPtrPtr[0] = altNs;
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* Tcl_FindNamespace -> findNamespace
*
* Searches for a namespace.
*
* Results:T
* Returns a reference to the namespace if it is found. Otherwise,
* returns null and leaves an error message in the interpreter's
* result object if "flags" contains TCL.VarFlag.LEAVE_ERR_MSG.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
 
internal static Namespace findNamespace( Interp interp, string name, Namespace contextNs, TCL.VarFlag flags )
{
Namespace ns;
 
// 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];
 
// Find the namespace(s) that contain the specified namespace name.
// Add the TCL.VarFlag.FIND_ONLY_NS flag to resolve the name all the way down
// to its last component, a namespace.
 
getNamespaceForQualName( interp, name, contextNs, ( flags | TCL.VarFlag.FIND_ONLY_NS ), nsArr, dummy1Arr, dummy1Arr, dummy2Arr );
 
 
// Get the values out of the arrays!
ns = nsArr[0];
 
if ( ns != null )
{
return ns;
}
else if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
/*
interp.resetResult();
TclString.append(interp.getResult(), "unknown namespace \"" + name + "\"");
*/
 
// FIXME : is there a test case for this error?
interp.setResult( "unknown namespace \"" + name + "\"" );
}
return null;
}
 
 
 
/*
*----------------------------------------------------------------------
*
* Tcl_FindCommand -> findCommand
*
* Searches for a command.
*
* Results:
* Returns a token for the command if it is found. Otherwise, if it
* can't be found or there is an error, returns null and leaves an
* error message in the interpreter's result object if "flags"
* contains TCL.VarFlag.LEAVE_ERR_MSG.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
 
internal static WrappedCommand findCommand( Interp interp, string name, Namespace contextNs, TCL.VarFlag flags )
{
Interp.ResolverScheme res;
Namespace cxtNs;
Namespace[] ns = new Namespace[2];
string simpleName;
int search;
//int result;
WrappedCommand cmd;
 
// If this namespace has a command resolver, then give it first
// crack at the command resolution. If the interpreter has any
// command resolvers, consult them next. The command resolver
// procedures may return a Tcl_Command value, they may signal
// to continue onward, or they may signal an error.
 
if ( ( flags & TCL.VarFlag.GLOBAL_ONLY ) != 0 )
{
cxtNs = getGlobalNamespace( interp );
}
else if ( contextNs != null )
{
cxtNs = contextNs;
}
else
{
cxtNs = getCurrentNamespace( interp );
}
 
if ( cxtNs.resolver != null || interp.resolvers != null )
{
try
{
if ( cxtNs.resolver != null )
{
cmd = cxtNs.resolver.resolveCmd( interp, name, cxtNs, flags );
}
else
{
cmd = null;
}
 
if ( cmd == null && interp.resolvers != null )
{
IEnumerator enum_Renamed = interp.resolvers.GetEnumerator();
while ( cmd == null && enum_Renamed.MoveNext() )
{
res = (Interp.ResolverScheme)enum_Renamed.Current;
cmd = res.resolver.resolveCmd( interp, name, cxtNs, flags );
}
}
 
if ( cmd != null )
{
return cmd;
}
}
catch ( TclException e )
{
return null;
}
}
 
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
Namespace[] ns0Arr = new Namespace[1];
Namespace[] ns1Arr = new Namespace[1];
Namespace[] cxtNsArr = new Namespace[1];
string[] simpleNameArr = new string[1];
 
 
// Find the namespace(s) that contain the command.
 
getNamespaceForQualName( interp, name, contextNs, flags, ns0Arr, ns1Arr, cxtNsArr, simpleNameArr );
 
// Get the values out of the arrays!
ns[0] = ns0Arr[0];
ns[1] = ns1Arr[0];
cxtNs = cxtNsArr[0];
simpleName = simpleNameArr[0];
 
 
 
// Look for the command in the command table of its namespace.
// Be sure to check both possible search paths: from the specified
// namespace context and from the global namespace.
 
cmd = null;
for ( search = 0; ( search < 2 ) && ( cmd == null ); search++ )
{
if ( ( ns[search] != null ) && ( (System.Object)simpleName != null ) )
{
cmd = (WrappedCommand)ns[search].cmdTable[simpleName];
}
}
if ( cmd != null )
{
return cmd;
}
else if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
throw new TclException( interp, "unknown command \"" + name + "\"" );
}
 
return null;
}
 
 
 
/*
*----------------------------------------------------------------------
*
* Tcl_FindNamespaceVar -> findNamespaceVar
*
* Searches for a namespace variable, a variable not local to a
* procedure. The variable can be either a scalar or an array, but
* may not be an element of an array.
*
* Results:
* Returns a token for the variable if it is found. Otherwise, if it
* can't be found or there is an error, returns null and leaves an
* error message in the interpreter's result object if "flags"
* contains TCL.VarFlag.LEAVE_ERR_MSG.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
 
internal static Var findNamespaceVar( Interp interp, string name, Namespace contextNs, TCL.VarFlag flags )
{
Interp.ResolverScheme res;
Namespace cxtNs;
Namespace[] ns = new Namespace[2];
string simpleName;
int search;
//int result;
Var var;
 
// If this namespace has a variable resolver, then give it first
// crack at the variable resolution. It may return a Tcl_Var
// value, it may signal to continue onward, or it may signal
// an error.
 
if ( ( flags & TCL.VarFlag.GLOBAL_ONLY ) != 0 )
{
cxtNs = getGlobalNamespace( interp );
}
else if ( contextNs != null )
{
cxtNs = contextNs;
}
else
{
cxtNs = getCurrentNamespace( interp );
}
 
if ( cxtNs.resolver != null || interp.resolvers != null )
{
try
{
if ( cxtNs.resolver != null )
{
var = cxtNs.resolver.resolveVar( interp, name, cxtNs, flags );
}
else
{
var = null;
}
 
if ( var == null && interp.resolvers != null )
{
IEnumerator enum_Renamed = interp.resolvers.GetEnumerator();
while ( var == null && enum_Renamed.MoveNext() )
{
res = (Interp.ResolverScheme)enum_Renamed.Current;
var = res.resolver.resolveVar( interp, name, cxtNs, flags );
}
}
 
if ( var != null )
{
return var;
}
}
catch ( TclException e )
{
return null;
}
}
 
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
Namespace[] ns0Arr = new Namespace[1];
Namespace[] ns1Arr = new Namespace[1];
Namespace[] cxtNsArr = new Namespace[1];
string[] simpleNameArr = new string[1];
 
 
// Find the namespace(s) that contain the variable.
 
getNamespaceForQualName( interp, name, contextNs, flags, ns0Arr, ns1Arr, cxtNsArr, simpleNameArr );
 
// Get the values out of the arrays!
ns[0] = ns0Arr[0];
ns[1] = ns1Arr[0];
cxtNs = cxtNsArr[0];
simpleName = simpleNameArr[0];
 
 
// Look for the variable in the variable table of its namespace.
// Be sure to check both possible search paths: from the specified
// namespace context and from the global namespace.
 
var = null;
for ( search = 0; ( search < 2 ) && ( var == null ); search++ )
{
if ( ( ns[search] != null ) && ( (System.Object)simpleName != null ) )
{
var = (Var)ns[search].varTable[simpleName];
}
}
if ( var != null )
{
return var;
}
else if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 )
{
/*
interp.resetResult();
TclString.append(interp.getResult(), "unknown variable \"" + name + "\"");
*/
 
// FIXME : is there a test case for this error?
interp.setResult( "unknown variable \"" + name + "\"" );
}
return null;
}
 
/*
*----------------------------------------------------------------------
*
* GetNamespaceFromObj -> getNamespaceFromObj
*
* Returns the namespace specified by the name in a TclObject.
*
* Results:
* This method will return the Namespace object whose name
* is stored in the obj argument. If the namespace can't be found,
* a TclException is raised.
*
* Side effects:
* May update the internal representation for the object, caching the
* namespace reference. The next time this procedure is called, the
* namespace value can be found quickly.
*
* If anything goes wrong, an error message is left in the
* interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
internal static Namespace getNamespaceFromObj( Interp interp, TclObject obj )
{
ResolvedNsName resName;
Namespace ns;
Namespace currNs = getCurrentNamespace( interp );
int result;
 
// Get the internal representation, converting to a namespace type if
// needed. The internal representation is a ResolvedNsName that points
// to the actual namespace.
 
// FIXME : if NamespaceCmd is not the internal rep this needs to be changed!
if ( !( obj.InternalRep is NamespaceCmd ) )
{
setNsNameFromAny( interp, obj );
}
resName = ( (NamespaceCmd)obj.InternalRep ).otherValue;
 
// Check the context namespace of the resolved symbol to make sure that
// it is fresh. If not, then force another conversion to the namespace
// type, to discard the old rep and create a new one. Note that we
// verify that the namespace id of the cached namespace is the same as
// the id when we cached it; this insures that the namespace wasn't
// deleted and a new one created at the same address.
 
ns = null;
if ( ( resName != null ) && ( resName.refNs == currNs ) && ( resName.nsId == resName.ns.nsId ) )
{
ns = resName.ns;
if ( ( ns.flags & NS_DEAD ) != 0 )
{
ns = null;
}
}
if ( ns == null )
{
// try again
setNsNameFromAny( interp, obj );
resName = ( (NamespaceCmd)obj.InternalRep ).otherValue;
if ( resName != null )
{
ns = resName.ns;
if ( ( ns.flags & NS_DEAD ) != 0 )
{
ns = null;
}
}
}
return ns;
}
 
/// <summary>----------------------------------------------------------------------
///
/// Tcl_SetNamespaceResolvers -> setNamespaceResolver
///
/// Sets the command/variable resolution object for a namespace,
/// thereby changing the way that command/variable names are
/// interpreted. This allows extension writers to support different
/// name resolution schemes, such as those for object-oriented
/// packages.
///
/// Command resolution is handled by the following method:
///
/// resolveCmd (Interp interp, String name,
/// NamespaceCmd.Namespace context, int flags)
/// throws TclException;
///
/// Whenever a command is executed or NamespaceCmd.findCommand is invoked
/// within the namespace, this method is called to resolve the
/// command name. If this method is able to resolve the name,
/// it should return the corresponding WrappedCommand. Otherwise,
/// the procedure can return null, and the command will
/// be treated under the usual name resolution rules. Or, it can
/// throw a TclException, and the command will be considered invalid.
///
/// Variable resolution is handled by the following method:
///
/// resolveVar (Interp interp, String name,
/// NamespaceCmd.Namespace context, int flags)
/// throws TclException;
///
/// If this method is able to resolve the name, it should return
/// the variable as var object. The method may also
/// return null, and the variable will be treated under the usual
/// name resolution rules. Or, it can throw a TclException,
/// and the variable will be considered invalid.
///
/// Results:
/// See above.
///
/// Side effects:
/// None.
///
/// ----------------------------------------------------------------------
/// </summary>
 
internal static void setNamespaceResolver( Namespace namespace_Renamed, Resolver resolver )
// command and variable resolution
{
// Plug in the new command resolver.
 
namespace_Renamed.resolver = resolver;
}
 
/// <summary>----------------------------------------------------------------------
///
/// Tcl_GetNamespaceResolvers -> getNamespaceResolver
///
/// Returns the current command/variable resolution object
/// for a namespace. By default, these objects are null.
/// New objects can be installed by calling setNamespaceResolver,
/// to provide new name resolution rules.
///
/// Results:
/// Returns the esolver object assigned to this namespace.
/// Returns null otherwise.
///
/// Side effects:
/// None.
///
/// ----------------------------------------------------------------------
/// </summary>
 
internal static Resolver getNamespaceResolver( Namespace namespace_Renamed )
// Namespace whose resolution rules
// are being queried.
{
return namespace_Renamed.resolver;
}
 
/*
*----------------------------------------------------------------------
*
* Tcl_NamespaceObjCmd -> cmdProc
*
* Invoked to implement the "namespace" command that creates, deletes,
* or manipulates Tcl namespaces. Handles the following syntax:
*
* namespace children ?name? ?pattern?
* namespace code arg
* namespace current
* namespace delete ?name name...?
* namespace eval name arg ?arg...?
* namespace export ?-clear? ?pattern pattern...?
* namespace forget ?pattern pattern...?
* namespace import ?-force? ?pattern pattern...?
* namespace inscope name arg ?arg...?
* namespace origin name
* namespace parent ?name?
* namespace qualifiers string
* namespace tail string
* namespace which ?-command? ?-variable? name
*
* Results:
* Returns if the command is successful. Raises Exception if
* anything goes wrong.
*
* Side effects:
* Based on the subcommand name (e.g., "import"), this procedure
* dispatches to a corresponding member commands in this class.
* This method's side effects depend on whatever that subcommand does.
*----------------------------------------------------------------------
*/
 
private static readonly string[] validCmds = new string[] { "children", "code", "current", "delete", "eval", "export", "forget", "import", "inscope", "origin", "parent", "qualifiers", "tail", "which" };
 
private const int OPT_CHILDREN = 0;
private const int OPT_CODE = 1;
private const int OPT_CURRENT = 2;
private const int OPT_DELETE = 3;
private const int OPT_EVAL = 4;
private const int OPT_EXPORT = 5;
private const int OPT_FORGET = 6;
private const int OPT_IMPORT = 7;
private const int OPT_INSCOPE = 8;
private const int OPT_ORIGIN = 9;
private const int OPT_PARENT = 10;
private const int OPT_QUALIFIERS = 11;
private const int OPT_TAIL = 12;
private const int OPT_WHICH = 13;
 
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
 
int i, opt;
 
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, objv, "subcommand ?arg ...?" );
}
 
opt = TclIndex.get( interp, objv[1], validCmds, "option", 0 );
 
switch ( opt )
{
 
case OPT_CHILDREN:
{
childrenCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_CODE:
{
codeCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_CURRENT:
{
currentCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_DELETE:
{
deleteCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_EVAL:
{
evalCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_EXPORT:
{
exportCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_FORGET:
{
forgetCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_IMPORT:
{
importCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_INSCOPE:
{
inscopeCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_ORIGIN:
{
originCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_PARENT:
{
parentCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_QUALIFIERS:
{
qualifiersCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_TAIL:
{
tailCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
 
case OPT_WHICH:
{
whichCmd( interp, objv );
return TCL.CompletionCode.RETURN;
}
} // end switch(opt)
return TCL.CompletionCode.RETURN;
}
 
 
/*
*----------------------------------------------------------------------
*
* NamespaceChildrenCmd -> childrenCmd
*
* Invoked to implement the "namespace children" command that returns a
* list containing the fully-qualified names of the child namespaces of
* a given namespace. Handles the following syntax:
*
* namespace children ?name? ?pattern?
*
* Results:
* Nothing.
*
* Side effects:
* Returns a result in the interpreter's result object. If anything
* goes wrong, the result is an error message.
*
*----------------------------------------------------------------------
*/
 
private static void childrenCmd( Interp interp, TclObject[] objv )
{
Namespace namespace_Renamed;
Namespace ns;
Namespace globalNs = getGlobalNamespace( interp );
string pattern = null;
StringBuilder buffer;
IEnumerator search;
TclObject list, elem;
 
// Get a pointer to the specified namespace, or the current namespace.
 
if ( objv.Length == 2 )
{
ns = getCurrentNamespace( interp );
}
else if ( ( objv.Length == 3 ) || ( objv.Length == 4 ) )
{
ns = getNamespaceFromObj( interp, objv[2] );
if ( ns == null )
{
 
throw new TclException( interp, "unknown namespace \"" + objv[2].ToString() + "\" in namespace children command" );
}
}
else
{
throw new TclNumArgsException( interp, 2, objv, "?name? ?pattern?" );
}
 
// Get the glob-style pattern, if any, used to narrow the search.
 
buffer = new StringBuilder();
if ( objv.Length == 4 )
{
 
string name = objv[3].ToString();
 
if ( name.StartsWith( "::" ) )
{
pattern = name;
}
else
{
buffer.Append( ns.fullName );
if ( ns != globalNs )
{
buffer.Append( "::" );
}
buffer.Append( name );
pattern = buffer.ToString();
}
}
 
// Create a list containing the full names of all child namespaces
// whose names match the specified pattern, if any.
 
list = TclList.newInstance();
foreach ( Namespace childNs in ns.childTable.Values )
{
if ( ( (System.Object)pattern == null ) || Util.stringMatch( childNs.fullName, pattern ) )
{
elem = TclString.newInstance( childNs.fullName );
TclList.append( interp, list, elem );
}
}
interp.setResult( list );
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* NamespaceCodeCmd -> codeCmd
*
* Invoked to implement the "namespace code" command to capture the
* namespace context of a command. Handles the following syntax:
*
* namespace code arg
*
* Here "arg" can be a list. "namespace code arg" produces a result
* equivalent to that produced by the command
*
* list namespace inscope [namespace current] $arg
*
* However, if "arg" is itself a scoped value starting with
* "namespace inscope", then the result is just "arg".
*
* Results:
* Nothing.
*
* Side effects:
* If anything goes wrong, this procedure returns an error
* message as the result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
 
private static void codeCmd( Interp interp, TclObject[] objv )
{
Namespace currNs;
TclObject list, obj;
string arg, p;
int length;
int p_ind;
 
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "arg" );
}
 
// If "arg" is already a scoped value, then return it directly.
 
 
arg = objv[2].ToString();
length = arg.Length;
 
// FIXME : we need a test for this inscope code if there is not one already!
if ( ( length > 17 ) && ( arg[0] == 'n' ) && arg.StartsWith( "namespace" ) )
{
for ( p_ind = 9; ( p_ind < length ) && ( arg[p_ind] == ' ' ); p_ind++ )
{
// empty body: skip over spaces
}
if ( ( ( length - p_ind ) >= 7 ) && ( arg[p_ind] == 'i' ) && arg.Substring( p_ind ).StartsWith( "inscope" ) )
{
interp.setResult( objv[2] );
return;
}
}
 
// Otherwise, construct a scoped command by building a list with
// "namespace inscope", the full name of the current namespace, and
// the argument "arg". By constructing a list, we ensure that scoped
// commands are interpreted properly when they are executed later,
// by the "namespace inscope" command.
 
list = TclList.newInstance();
TclList.append( interp, list, TclString.newInstance( "namespace" ) );
TclList.append( interp, list, TclString.newInstance( "inscope" ) );
 
currNs = getCurrentNamespace( interp );
if ( currNs == getGlobalNamespace( interp ) )
{
obj = TclString.newInstance( "::" );
}
else
{
obj = TclString.newInstance( currNs.fullName );
}
 
TclList.append( interp, list, obj );
TclList.append( interp, list, objv[2] );
 
interp.setResult( list );
return;
}
 
/*
*----------------------------------------------------------------------
*
* NamespaceCurrentCmd -> currentCmd
*
* Invoked to implement the "namespace current" command which returns
* the fully-qualified name of the current namespace. Handles the
* following syntax:
*
* namespace current
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Returns a result in the interpreter's result object. If anything
* goes wrong, the result is an error message.
*
*----------------------------------------------------------------------
*/
 
private static void currentCmd( Interp interp, TclObject[] objv )
{
 
Namespace currNs;
 
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 2, objv, null );
}
 
// The "real" name of the global namespace ("::") is the null string,
// but we return "::" for it as a convenience to programmers. Note that
// "" and "::" are treated as synonyms by the namespace code so that it
// is still easy to do things like:
//
// namespace [namespace current]::bar { ... }
 
currNs = getCurrentNamespace( interp );
 
if ( currNs == getGlobalNamespace( interp ) )
{
// FIXME : appending to te result really screws everything up!
// need to figure out how to disallow this!
//TclString.append(interp.getResult(), "::");
interp.setResult( "::" );
}
else
{
//TclString.append(interp.getResult(), currNs.fullName);
interp.setResult( currNs.fullName );
}
}
 
/*
*----------------------------------------------------------------------
*
* NamespaceDeleteCmd -> deleteCmd
*
* Invoked to implement the "namespace delete" command to delete
* namespace(s). Handles the following syntax:
*
* namespace delete ?name name...?
*
* Each name identifies a namespace. It may include a sequence of
* namespace qualifiers separated by "::"s. If a namespace is found, it
* is deleted: all variables and procedures contained in that namespace
* are deleted. If that namespace is being used on the call stack, it
* is kept alive (but logically deleted) until it is removed from the
* call stack: that is, it can no longer be referenced by name but any
* currently executing procedure that refers to it is allowed to do so
* until the procedure returns. If the namespace can't be found, this
* procedure returns an error. If no namespaces are specified, this
* command does nothing.
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Deletes the specified namespaces. If anything goes wrong, this
* procedure returns an error message in the interpreter's
* result object.
*
*----------------------------------------------------------------------
*/
 
private static void deleteCmd( Interp interp, TclObject[] objv )
{
Namespace namespace_Renamed;
string name;
int i;
 
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 2, objv, "?name name...?" );
}
 
// Destroying one namespace may cause another to be destroyed. Break
// this into two passes: first check to make sure that all namespaces on
// the command line are valid, and report any errors.
 
for ( i = 2; i < objv.Length; i++ )
{
 
name = objv[i].ToString();
namespace_Renamed = findNamespace( interp, name, null, 0 );
 
if ( namespace_Renamed == null )
{
 
throw new TclException( interp, "unknown namespace \"" + objv[i].ToString() + "\" in namespace delete command" );
}
}
 
// Okay, now delete each namespace.
 
for ( i = 2; i < objv.Length; i++ )
{
 
name = objv[i].ToString();
namespace_Renamed = findNamespace( interp, name, null, 0 );
 
if ( namespace_Renamed != null )
{
deleteNamespace( namespace_Renamed );
}
}
}
 
/*
*----------------------------------------------------------------------
*
* NamespaceEvalCmd -> evalCmd
*
* Invoked to implement the "namespace eval" command. Executes
* commands in a namespace. If the namespace does not already exist,
* it is created. Handles the following syntax:
*
* namespace eval name arg ?arg...?
*
* If more than one arg argument is specified, the command that is
* executed is the result of concatenating the arguments together with
* a space between each argument.
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Returns the result of the command in the interpreter's result
* object. If anything goes wrong, this procedure returns an error
* message as the result.
*
*----------------------------------------------------------------------
*/
 
private static void evalCmd( Interp interp, TclObject[] objv )
{
Namespace namespace_Renamed;
CallFrame frame;
string cmd;
string name;
int length;
 
if ( objv.Length < 4 )
{
throw new TclNumArgsException( interp, 2, objv, "name arg ?arg...?" );
}
 
// Try to resolve the namespace reference, caching the result in the
// namespace object along the way.
 
namespace_Renamed = getNamespaceFromObj( interp, objv[2] );
 
// If the namespace wasn't found, try to create it.
 
if ( namespace_Renamed == null )
{
 
name = objv[2].ToString();
namespace_Renamed = createNamespace( interp, name, null );
if ( namespace_Renamed == null )
{
// FIXME : result hack, we get the interp result and throw it!
 
throw new TclException( interp, interp.getResult().ToString() );
}
}
 
// Make the specified namespace the current namespace and evaluate
// the command(s).
 
frame = interp.newCallFrame();
pushCallFrame( interp, frame, namespace_Renamed, false );
 
try
{
if ( objv.Length == 4 )
{
interp.eval( objv[3], 0 );
}
else
{
cmd = Util.concat( 3, objv.Length, objv );
 
// eval() will delete the object when it decrements its
// refcount after eval'ing it.
 
interp.eval( cmd ); // do not pass TCL_EVAL_DIRECT, for compiler only
}
}
catch ( TclException ex )
{
if ( ex.getCompletionCode() == TCL.CompletionCode.ERROR )
{
interp.addErrorInfo( "\n (in namespace eval \"" + namespace_Renamed.fullName + "\" script line " + interp.errorLine + ")" );
}
throw ex;
}
finally
{
popCallFrame( interp );
}
 
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* NamespaceExportCmd -> exportCmd
*
* Invoked to implement the "namespace export" command that specifies
* which commands are exported from a namespace. The exported commands
* are those that can be imported into another namespace using
* "namespace import". Both commands defined in a namespace and
* commands the namespace has imported can be exported by a
* namespace. This command has the following syntax:
*
* namespace export ?-clear? ?pattern pattern...?
*
* Each pattern may contain "string match"-style pattern matching
* special characters, but the pattern may not include any namespace
* qualifiers: that is, the pattern must specify commands in the
* current (exporting) namespace. The specified patterns are appended
* onto the namespace's list of export patterns.
*
* To reset the namespace's export pattern list, specify the "-clear"
* flag.
*
* If there are no export patterns and the "-clear" flag isn't given,
* this command returns the namespace's current export list.
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Returns a result in the interpreter's result object. If anything
* goes wrong, the result is an error message.
*
*----------------------------------------------------------------------
*/
 
 
private static void exportCmd( Interp interp, TclObject[] objv )
{
Namespace currNs = getCurrentNamespace( interp );
string pattern, inString;
bool resetListFirst = false;
int firstArg, patternCt, i;
 
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 2, objv, "?-clear? ?pattern pattern...?" );
}
 
// Process the optional "-clear" argument.
 
firstArg = 2;
if ( firstArg < objv.Length )
{
 
inString = objv[firstArg].ToString();
if ( inString.Equals( "-clear" ) )
{
resetListFirst = true;
firstArg++;
}
}
 
// If no pattern arguments are given, and "-clear" isn't specified,
// return the namespace's current export pattern list.
 
patternCt = ( objv.Length - firstArg );
if ( patternCt == 0 )
{
if ( firstArg > 2 )
{
return;
}
else
{
// create list with export patterns
TclObject list = TclList.newInstance();
appendExportList( interp, currNs, list );
interp.setResult( list );
return;
}
}
 
// Add each pattern to the namespace's export pattern list.
 
for ( i = firstArg; i < objv.Length; i++ )
{
 
pattern = objv[i].ToString();
exportList( interp, currNs, pattern, ( ( i == firstArg ) ? resetListFirst : false ) );
}
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* NamespaceForgetCmd -> forgetCmd
*
* Invoked to implement the "namespace forget" command to remove
* imported commands from a namespace. Handles the following syntax:
*
* namespace forget ?pattern pattern...?
*
* Each pattern is a name like "foo::*" or "a::b::x*". That is, the
* pattern may include the special pattern matching characters
* recognized by the "string match" command, but only in the command
* name at the end of the qualified name; the special pattern
* characters may not appear in a namespace name. All of the commands
* that match that pattern are checked to see if they have an imported
* command in the current namespace that refers to the matched
* command. If there is an alias, it is removed.
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Imported commands are removed from the current namespace. If
* anything goes wrong, this procedure returns an error message in the
* interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
 
private static void forgetCmd( Interp interp, TclObject[] objv )
{
 
string pattern;
int i;
 
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 2, objv, "?pattern pattern...?" );
}
 
for ( i = 2; i < objv.Length; i++ )
{
 
pattern = objv[i].ToString();
forgetImport( interp, null, pattern );
}
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* NamespaceImportCmd -> importCmd
*
* Invoked to implement the "namespace import" command that imports
* commands into a namespace. Handles the following syntax:
*
* namespace import ?-force? ?pattern pattern...?
*
* Each pattern is a namespace-qualified name like "foo::*",
* "a::b::x*", or "bar::p". That is, the pattern may include the
* special pattern matching characters recognized by the "string match"
* command, but only in the command name at the end of the qualified
* name; the special pattern characters may not appear in a namespace
* name. All of the commands that match the pattern and which are
* exported from their namespace are made accessible from the current
* namespace context. This is done by creating a new "imported command"
* in the current namespace that points to the real command in its
* original namespace; when the imported command is called, it invokes
* the real command.
*
* If an imported command conflicts with an existing command, it is
* treated as an error. But if the "-force" option is included, then
* existing commands are overwritten by the imported commands.
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Adds imported commands to the current namespace. If anything goes
* wrong, this procedure returns an error message in the interpreter's
* result object.
*
*----------------------------------------------------------------------
*/
 
 
private static void importCmd( Interp interp, TclObject[] objv )
{
 
bool allowOverwrite = false;
string inString, pattern;
int i;
int firstArg;
 
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 2, objv, "?-force? ?pattern pattern...?" );
}
 
// Skip over the optional "-force" as the first argument.
 
firstArg = 2;
if ( firstArg < objv.Length )
{
 
inString = objv[firstArg].ToString();
if ( inString.Equals( "-force" ) )
{
allowOverwrite = true;
firstArg++;
}
}
 
// Handle the imports for each of the patterns.
 
for ( i = firstArg; i < objv.Length; i++ )
{
 
pattern = objv[i].ToString();
importList( interp, null, pattern, allowOverwrite );
}
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* NamespaceInscopeCmd -> inscopeCmd
*
* Invoked to implement the "namespace inscope" command that executes a
* script in the context of a particular namespace. This command is not
* expected to be used directly by programmers; calls to it are
* generated implicitly when programs use "namespace code" commands
* to register callback scripts. Handles the following syntax:
*
* namespace inscope name arg ?arg...?
*
* The "namespace inscope" command is much like the "namespace eval"
* command except that it has lappend semantics and the namespace must
* already exist. It treats the first argument as a list, and appends
* any arguments after the first onto the end as proper list elements.
* For example,
*
* namespace inscope ::foo a b c d
*
* is equivalent to
*
* namespace eval ::foo [concat a [list b c d]]
*
* This lappend semantics is important because many callback scripts
* are actually prefixes.
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Returns a result in the Tcl interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void inscopeCmd( Interp interp, TclObject[] objv )
{
Namespace namespace_Renamed;
CallFrame frame;
int i, result;
 
if ( objv.Length < 4 )
{
throw new TclNumArgsException( interp, 2, objv, "name arg ?arg...?" );
}
 
// Resolve the namespace reference.
 
namespace_Renamed = getNamespaceFromObj( interp, objv[2] );
if ( namespace_Renamed == null )
{
 
throw new TclException( interp, "unknown namespace \"" + objv[2].ToString() + "\" in inscope namespace command" );
}
 
// Make the specified namespace the current namespace.
 
frame = interp.newCallFrame();
pushCallFrame( interp, frame, namespace_Renamed, false );
 
 
// Execute the command. If there is just one argument, just treat it as
// a script and evaluate it. Otherwise, create a list from the arguments
// after the first one, then concatenate the first argument and the list
// of extra arguments to form the command to evaluate.
 
try
{
if ( objv.Length == 4 )
{
interp.eval( objv[3], 0 );
}
else
{
TclObject[] concatObjv = new TclObject[2];
TclObject list;
string cmd;
 
list = TclList.newInstance();
for ( i = 4; i < objv.Length; i++ )
{
try
{
TclList.append( interp, list, objv[i] );
}
catch ( TclException ex )
{
list.release(); // free unneeded obj
throw ex;
}
}
 
concatObjv[0] = objv[3];
concatObjv[1] = list;
cmd = Util.concat( 0, 1, concatObjv );
interp.eval( cmd ); // do not pass TCL_EVAL_DIRECT, for compiler only
list.release(); // we're done with the list object
}
}
catch ( TclException ex )
{
if ( ex.getCompletionCode() == TCL.CompletionCode.ERROR )
{
interp.addErrorInfo( "\n (in namespace inscope \"" + namespace_Renamed.fullName + "\" script line " + interp.errorLine + ")" );
}
throw ex;
}
finally
{
popCallFrame( interp );
}
 
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* NamespaceOriginCmd -> originCmd
*
* Invoked to implement the "namespace origin" command to return the
* fully-qualified name of the "real" command to which the specified
* "imported command" refers. Handles the following syntax:
*
* namespace origin name
*
* Results:
* An imported command is created in an namespace when that namespace
* imports a command from another namespace. If a command is imported
* into a sequence of namespaces a, b,...,n where each successive
* namespace just imports the command from the previous namespace, this
* command returns the fully-qualified name of the original command in
* the first namespace, a. If "name" does not refer to an alias, its
* fully-qualified name is returned. The returned name is stored in the
* interpreter's result object. This procedure returns TCL_OK if
* successful, and TCL_ERROR if anything goes wrong.
*
* Side effects:
* If anything goes wrong, this procedure returns an error message in
* the interpreter's result object.
*
*----------------------------------------------------------------------
*/
 
private static void originCmd( Interp interp, TclObject[] objv )
{
WrappedCommand command, origCommand;
 
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "name" );
}
 
// FIXME : is this the right way to search for a command?
 
//command = Tcl_GetCommandFromObj(interp, objv[2]);
 
command = NamespaceCmd.findCommand( interp, objv[2].ToString(), null, 0 );
 
if ( command == null )
{
 
throw new TclException( interp, "invalid command name \"" + objv[2].ToString() + "\"" );
}
 
origCommand = getOriginalCommand( command );
if ( origCommand == null )
{
// The specified command isn't an imported command. Return the
// command's name qualified by the full name of the namespace it
// was defined in.
 
interp.setResult( interp.getCommandFullName( command ) );
}
else
{
interp.setResult( interp.getCommandFullName( origCommand ) );
}
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* NamespaceParentCmd -> parentCmd
*
* Invoked to implement the "namespace parent" command that returns the
* fully-qualified name of the parent namespace for a specified
* namespace. Handles the following syntax:
*
* namespace parent ?name?
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Returns a result in the interpreter's result object. If anything
* goes wrong, the result is an error message.
*
*----------------------------------------------------------------------
*/
 
private static void parentCmd( Interp interp, TclObject[] objv )
{
Namespace ns;
 
if ( objv.Length == 2 )
{
ns = getCurrentNamespace( interp );
}
else if ( objv.Length == 3 )
{
ns = getNamespaceFromObj( interp, objv[2] );
if ( ns == null )
{
 
throw new TclException( interp, "unknown namespace \"" + objv[2].ToString() + "\" in namespace parent command" );
}
}
else
{
throw new TclNumArgsException( interp, 2, objv, "?name?" );
}
 
// Report the parent of the specified namespace.
 
if ( ns.parent != null )
{
interp.setResult( ns.parent.fullName );
}
}
 
 
/*
*----------------------------------------------------------------------
*
* NamespaceQualifiersCmd -> qualifiersCmd
*
* Invoked to implement the "namespace qualifiers" command that returns
* any leading namespace qualifiers in a string. These qualifiers are
* namespace names separated by "::"s. For example, for "::foo::p" this
* command returns "::foo", and for "::" it returns "". This command
* is the complement of the "namespace tail" command. Note that this
* command does not check whether the "namespace" names are, in fact,
* the names of currently defined namespaces. Handles the following
* syntax:
*
* namespace qualifiers string
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Returns a result in the interpreter's result object. If anything
* goes wrong, the result is an error message.
*
*----------------------------------------------------------------------
*/
 
private static void qualifiersCmd( Interp interp, TclObject[] objv )
{
string name;
int p;
 
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "string" );
}
 
// Find the end of the string, then work backward and find
// the start of the last "::" qualifier.
 
 
name = objv[2].ToString();
p = name.Length;
 
while ( --p >= 0 )
{
if ( ( name[p] == ':' ) && ( p > 0 ) && ( name[p - 1] == ':' ) )
{
p -= 2; // back up over the ::
while ( ( p >= 0 ) && ( name[p] == ':' ) )
{
p--; // back up over the preceeding :
}
break;
}
}
 
if ( p >= 0 )
{
interp.setResult( name.Substring( 0, ( p + 1 ) - ( 0 ) ) );
}
// When no result is set the empty string is the result
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* NamespaceTailCmd -> tailCmd
*
* Invoked to implement the "namespace tail" command that returns the
* trailing name at the end of a string with "::" namespace
* qualifiers. These qualifiers are namespace names separated by
* "::"s. For example, for "::foo::p" this command returns "p", and for
* "::" it returns "". This command is the complement of the "namespace
* qualifiers" command. Note that this command does not check whether
* the "namespace" names are, in fact, the names of currently defined
* namespaces. Handles the following syntax:
*
* namespace tail string
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Returns a result in the interpreter's result object. If anything
* goes wrong, the result is an error message.
*
*----------------------------------------------------------------------
*/
 
 
private static void tailCmd( Interp interp, TclObject[] objv )
{
string name;
int p;
 
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "string" );
}
 
// Find the end of the string, then work backward and find the
// last "::" qualifier.
 
 
name = objv[2].ToString();
p = name.Length;
 
while ( --p > 0 )
{
if ( ( name[p] == ':' ) && ( name[p - 1] == ':' ) )
{
p++; // just after the last "::"
break;
}
}
 
if ( p >= 0 )
{
interp.setResult( name.Substring( p ) );
}
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* NamespaceWhichCmd -> whichCmd
*
* Invoked to implement the "namespace which" command that returns the
* fully-qualified name of a command or variable. If the specified
* command or variable does not exist, it returns "". Handles the
* following syntax:
*
* namespace which ?-command? ?-variable? name
*
* Results:
* Returns if successful, raises TclException if something goes wrong.
*
* Side effects:
* Returns a result in the interpreter's result object. If anything
* goes wrong, the result is an error message.
*
*----------------------------------------------------------------------
*/
 
 
private static void whichCmd( Interp interp, TclObject[] objv )
{
string arg;
WrappedCommand cmd;
Var variable;
int argIndex, lookup;
 
if ( objv.Length < 3 )
{
throw new TclNumArgsException( interp, 2, objv, "?-command? ?-variable? name" );
}
 
// Look for a flag controlling the lookup.
 
argIndex = 2;
lookup = 0; // assume command lookup by default
 
arg = objv[2].ToString();
if ( ( arg.Length > 1 ) && ( arg[0] == '-' ) )
{
if ( arg.Equals( "-command" ) )
{
lookup = 0;
}
else if ( arg.Equals( "-variable" ) )
{
lookup = 1;
}
else
{
throw new TclNumArgsException( interp, 2, objv, "?-command? ?-variable? name" );
}
argIndex = 3;
}
if ( objv.Length != ( argIndex + 1 ) )
{
throw new TclNumArgsException( interp, 2, objv, "?-command? ?-variable? name" );
}
 
// FIXME : check that this implementation works!
 
switch ( lookup )
{
 
case 0:
 
arg = objv[argIndex].ToString();
 
// FIXME : is this the right way to lookup a Command token?
//cmd = Tcl_GetCommandFromObj(interp, objv[argIndex]);
cmd = NamespaceCmd.findCommand( interp, arg, null, 0 );
 
if ( cmd == null )
{
return; // cmd not found, just return (no error)
}
interp.setResult( interp.getCommandFullName( cmd ) );
return;
 
 
case 1:
 
arg = objv[argIndex].ToString();
variable = NamespaceCmd.findNamespaceVar( interp, arg, null, 0 );
if ( variable != null )
{
interp.setResult( Var.getVariableFullName( interp, variable ) );
}
return;
}
 
return;
}
 
 
/*
*----------------------------------------------------------------------
*
* FreeNsNameInternalRep -> dispose
*
* Frees the resources associated with a object's internal
* representation. See src/tcljava/tcl/lang/InternalRep.java
*
* Results:
* None.
*
* Side effects:
* Decrements the ref count of any Namespace structure pointed
* to by the nsName's internal representation. If there are no more
* references to the namespace, it's structure will be freed.
*
*----------------------------------------------------------------------
*/
 
public void dispose()
{
bool debug;
System.Diagnostics.Debug.WriteLine( "dispose() called for namespace object " + ( otherValue == null ? null : otherValue.ns ) );
 
ResolvedNsName resName = otherValue;
Namespace ns;
 
// Decrement the reference count of the namespace. If there are no
// more references, free it up.
 
if ( resName != null )
{
resName.refCount--;
if ( resName.refCount == 0 )
{
 
// Decrement the reference count for the cached namespace. If
// the namespace is dead, and there are no more references to
// it, free it.
 
ns = resName.ns;
ns.refCount--;
if ( ( ns.refCount == 0 ) && ( ( ns.flags & NS_DEAD ) != 0 ) )
{
free( ns );
}
otherValue = null;
}
}
}
 
 
/*
*----------------------------------------------------------------------
*
* DupNsNameInternalRep -> duplicate
*
* Get a copy of this Object for copy-on-write
* operations. We just increment its useCount and return the same
* ReflectObject because ReflectObject's cannot be modified, so
* they don't need copy-on-write protections.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
 
public InternalRep duplicate()
{
System.Diagnostics.Debug.WriteLine( "duplicate() called for namespace object " + ( otherValue == null ? null : otherValue.ns ) );
 
ResolvedNsName resName = otherValue;
 
if ( resName != null )
{
resName.refCount++;
}
 
return this;
}
 
 
/*
*----------------------------------------------------------------------
*
* 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;
}
 
 
/*
*----------------------------------------------------------------------
*
* UpdateStringOfNsName -> toString
*
* Return the string representation for a nsName object.
* This method is called only by TclObject.toString()
* when TclObject.stringRep is null.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
 
public override string ToString()
{
bool debug;
 
System.Diagnostics.Debug.WriteLine( "toString() called for namespace object " + ( otherValue == null ? null : otherValue.ns ) );
 
ResolvedNsName resName = otherValue;
Namespace ns;
string name = "";
 
if ( ( resName != null ) && ( resName.nsId == resName.ns.nsId ) )
{
ns = resName.ns;
if ( ( ns.flags & NS_DEAD ) != 0 )
{
ns = null;
}
if ( ns != null )
{
name = ns.fullName;
}
}
 
return name;
}
 
 
// This interface is used to provide a callback when a namespace is deleted
// (ported Tcl_NamespaceDeleteProc to NamespaceCmd.DeleteProc)
 
internal interface DeleteProc
{
void delete();
}
 
 
// This structure contains a cached pointer to a namespace that is the
// result of resolving the namespace's name in some other namespace. It is
// the internal representation for a nsName object. It contains the
// pointer along with some information that is used to check the cached
// pointer's validity. (ported Tcl_Namespace to NamespaceCmd.Namespace)
 
public class Namespace
{
internal string name; // The namespace's simple (unqualified)
// name. This contains no ::'s. The name of
// the global namespace is "" although "::"
// is an synonym.
 
internal string fullName; // The namespace's fully qualified name.
// This starts with ::.
 
internal DeleteProc deleteProc; // method to invoke when namespace is deleted
 
internal Namespace parent; // reference to the namespace that contains
// this one. null is this is the global namespace.
 
internal Hashtable childTable; // Contains any child namespaces. Indexed
// by strings; values are references to
// Namespace objects
 
internal long nsId; // Unique id for the namespace.
internal Interp interp; // The interpreter containing this namespace.
 
internal int flags; // OR-ed combination of the namespace
// status flags NS_DYING and NS_DEAD (listed below)
 
internal int activationCount; // Number of "activations" or active call
// frames for this namespace that are on
// the Tcl call stack. The namespace won't
// be freed until activationCount becomes zero.
 
internal int refCount; // Count of references by nsName
// objects. The namespace can't be freed
// until refCount becomes zero.
 
internal Hashtable cmdTable; // Contains all the commands currently
// registered in the namespace. Indexed by
// strings; values have type (WrappedCommand).
// Commands imported by Tcl_Import have
// Command structures that point (via an
// ImportedCmdRef structure) to the
// Command structure in the source
// namespace's command table.
 
internal Hashtable varTable; // Contains all the (global) variables
// currently in this namespace. Indexed
// by strings; values have type (Var).
 
internal string[] exportArray; // Reference to an array of string patterns
// specifying which commands are exported.
// A pattern may include "string match"
// style wildcard characters to specify
// multiple commands; however, no namespace
// qualifiers are allowed. null if no
// export patterns are registered.
 
internal int numExportPatterns; // Number of export patterns currently
// registered using "namespace export".
 
internal int maxExportPatterns; // Mumber of export patterns for which
// space is currently allocated.
 
 
internal Resolver resolver;
// If non-null, this object overrides the
// usual command and variable resolution
// mechanism in Tcl. This procedure is invoked
// within findCommand and findNamespaceVar to
// resolve all command and variable references
// within the namespace.
 
// When printing out a Namespace use the full namespace name string
 
public override string ToString()
{
return fullName;
}
}
 
 
// (ported ResolvedNsName to NamespaceCmd.ResolvedNsName)
 
internal class ResolvedNsName
{
internal Namespace ns; // reference to namespace object
internal long nsId; // sPtr's unique namespace id. Used to
// verify that ns is still valid
// (e.g., it's possible that the namespace
// was deleted and a new one created at
// the same address).
 
internal Namespace refNs; // reference to the namespace containing the
// reference (not the namespace that
// contains the referenced namespace).
internal int refCount; // Reference count: 1 for each nsName
// object that has a pointer to this
// ResolvedNsName structure as its internal
// rep. This structure can be freed when
// refCount becomes zero.
}
static NamespaceCmd()
{
nsMutex = new System.Object();
}
}
}
/trunk/TCL/src/commands/OpenCmd.cs
@@ -0,0 +1,271 @@
/*
* OpenCmd.java --
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: OpenCmd.java,v 1.5 2003/03/08 03:42:44 mdejong Exp $
*
*/
using System;
using System.IO;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "open" command in Tcl.</summary>
 
class OpenCmd : Command
{
/// <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 ( 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 ( IOException e )
{
 
throw new TclException( interp, "cannot open file: " + argv[1].ToString() );
}
}
else
{
/*
* Pipeline code here...
*/
}
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/PackageCmd.cs
@@ -0,0 +1,859 @@
/*
* PackageCmd.java --
*
* This class implements the built-in "package" command in Tcl.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: PackageCmd.java,v 1.4 2002/04/12 21:00:26 mdejong Exp $
*/
using System.Collections;
using System.Text;
 
namespace tcl.lang
{
 
class PackageCmd : Command
{
 
private static readonly string[] validCmds = new string[] { "forget", "ifneeded", "names", "present", "provide", "require", "unknown", "vcompare", "versions", "vsatisfies" };
 
private const int OPT_FORGET = 0;
private const int OPT_IFNEEDED = 1;
private const int OPT_NAMES = 2;
private const int OPT_PRESENT = 3;
private const int OPT_PROVIDE = 4;
private const int OPT_REQUIRE = 5;
private const int OPT_UNKNOWN = 6;
private const int OPT_VCOMPARE = 7;
private const int OPT_VERSIONS = 8;
private const int OPT_VSATISFIES = 9;
internal static void pkgProvide( Interp interp, string pkgName, string version )
{
Package pkg;
 
// Validate the version string that was passed in.
 
checkVersion( interp, version );
pkg = findPackage( interp, pkgName );
if ( (System.Object)pkg.version == null )
{
pkg.version = version;
return;
}
if ( compareVersions( pkg.version, version, null ) != 0 )
{
throw new TclException( interp, "conflicting versions provided for package \"" + pkgName + "\": " + pkg.version + ", then " + version );
}
}
internal static string pkgRequire( Interp interp, string pkgName, string version, bool exact )
{
VersionSatisfiesResult vsres;
Package pkg;
PkgAvail avail, best;
string script;
StringBuilder sbuf;
int pass, result;
 
// Do extra check to make sure that version is not
// null when the exact flag is set to true.
 
if ( (System.Object)version == null && exact )
{
throw new TclException( interp, "conflicting arguments : version == null and exact == true" );
}
 
// Before we can compare versions the version string
// must be verified but if it is null we are just looking
// for the latest version so skip the check in this case.
 
if ( (System.Object)version != null )
{
checkVersion( interp, version );
}
 
// It can take up to three passes to find the package: one pass to
// run the "package unknown" script, one to run the "package ifneeded"
// script for a specific version, and a final pass to lookup the
// package loaded by the "package ifneeded" script.
 
vsres = new VersionSatisfiesResult();
for ( pass = 1; ; pass++ )
{
pkg = findPackage( interp, pkgName );
if ( (System.Object)pkg.version != null )
{
break;
}
 
// The package isn't yet present. Search the list of available
// versions and invoke the script for the best available version.
 
best = null;
for ( avail = pkg.avail; avail != null; avail = avail.next )
{
if ( ( best != null ) && ( compareVersions( avail.version, best.version, null ) <= 0 ) )
{
continue;
}
if ( (System.Object)version != null )
{
result = compareVersions( avail.version, version, vsres );
if ( ( result != 0 ) && exact )
{
continue;
}
if ( !vsres.satisfies )
{
continue;
}
}
best = avail;
}
if ( best != null )
{
// We found an ifneeded script for the package. Be careful while
// executing it: this could cause reentrancy, so (a) protect the
// script itself from deletion and (b) don't assume that best
// will still exist when the script completes.
 
script = best.script;
try
{
interp.eval( script, TCL.EVAL_GLOBAL );
}
catch ( TclException e )
{
interp.addErrorInfo( "\n (\"package ifneeded\" script)" );
 
// Throw the error with new info added to errorInfo.
 
throw;
}
interp.resetResult();
pkg = findPackage( interp, pkgName );
break;
}
 
// Package not in the database. If there is a "package unknown"
// command, invoke it (but only on the first pass; after that,
// we should not get here in the first place).
 
if ( pass > 1 )
{
break;
}
script = interp.packageUnknown;
if ( (System.Object)script != null )
{
sbuf = new StringBuilder();
try
{
Util.appendElement( interp, sbuf, script );
Util.appendElement( interp, sbuf, pkgName );
if ( (System.Object)version == null )
{
Util.appendElement( interp, sbuf, "" );
}
else
{
Util.appendElement( interp, sbuf, version );
}
if ( exact )
{
Util.appendElement( interp, sbuf, "-exact" );
}
}
catch ( TclException e )
{
throw new TclRuntimeError( "unexpected TclException: " + e.Message );
}
try
{
interp.eval( sbuf.ToString(), TCL.EVAL_GLOBAL );
}
catch ( TclException e )
{
interp.addErrorInfo( "\n (\"package unknown\" script)" );
 
// Throw the first exception.
 
throw;
}
interp.resetResult();
}
}
if ( (System.Object)pkg.version == null )
{
sbuf = new StringBuilder();
sbuf.Append( "can't find package " + pkgName );
if ( (System.Object)version != null )
{
sbuf.Append( " " + version );
}
throw new TclException( interp, sbuf.ToString() );
}
 
// At this point we know that the package is present. Make sure that the
// provided version meets the current requirement.
 
if ( (System.Object)version == null )
{
return pkg.version;
}
 
result = compareVersions( pkg.version, version, vsres );
if ( ( vsres.satisfies && !exact ) || ( result == 0 ) )
{
return pkg.version;
}
 
// If we have a version conflict we throw a TclException.
 
throw new TclException( interp, "version conflict for package \"" + pkgName + "\": have " + pkg.version + ", need " + version );
}
internal static string pkgPresent( Interp interp, string pkgName, string version, bool exact )
{
Package pkg;
VersionSatisfiesResult vsres = new VersionSatisfiesResult();
int result;
 
pkg = (Package)interp.packageTable[pkgName];
if ( pkg != null )
{
if ( (System.Object)pkg.version != null )
{
 
// At this point we know that the package is present. Make sure
// that the provided version meets the current requirement.
 
if ( (System.Object)version == null )
{
return pkg.version;
}
result = compareVersions( pkg.version, version, vsres );
if ( ( vsres.satisfies && !exact ) || ( result == 0 ) )
{
return pkg.version;
}
throw new TclException( interp, "version conflict for package \"" + pkgName + "\": have " + pkg.version + ", need " + version );
}
}
 
if ( (System.Object)version != null )
{
throw new TclException( interp, "package " + pkgName + " " + version + " is not present" );
}
else
{
throw new TclException( interp, "package " + pkgName + " is not present" );
}
}
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
VersionSatisfiesResult vsres;
Package pkg;
PkgAvail avail;
PkgAvail prev;
string version;
string pkgName;
string key;
string cmd;
string ver1, ver2;
StringBuilder sbuf;
IDictionaryEnumerator enum_Renamed;
int i, opt, exact;
bool once;
 
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, objv, "option ?arg arg ...?" );
}
opt = TclIndex.get( interp, objv[1], validCmds, "option", 0 );
switch ( opt )
{
 
case OPT_FORGET:
{
// Forget takes 0 or more arguments.
 
for ( i = 2; i < objv.Length; i++ )
{
// We do not need to check to make sure
// package name is "" because it would not
// be in the hash table so name will be ignored.
 
 
pkgName = objv[i].ToString();
pkg = (Package)interp.packageTable[pkgName];
 
// If this package does not exist, go to next one.
 
if ( pkg == null )
{
continue;
}
SupportClass.HashtableRemove( interp.packageTable, pkgName );
while ( pkg.avail != null )
{
avail = pkg.avail;
pkg.avail = avail.next;
avail = null;
}
pkg = null;
}
return TCL.CompletionCode.RETURN;
}
 
case OPT_IFNEEDED:
{
if ( ( objv.Length < 4 ) || ( objv.Length > 5 ) )
{
throw new TclNumArgsException( interp, 1, objv, "ifneeded package version ?script?" );
}
pkgName = objv[2].ToString();
version = objv[3].ToString();
 
// Verify that this version string is valid.
 
checkVersion( interp, version );
if ( objv.Length == 4 )
{
pkg = (Package)interp.packageTable[pkgName];
if ( pkg == null )
return TCL.CompletionCode.RETURN;
}
else
{
pkg = findPackage( interp, pkgName );
}
for ( avail = pkg.avail, prev = null; avail != null; prev = avail, avail = avail.next )
{
if ( compareVersions( avail.version, version, null ) == 0 )
{
if ( objv.Length == 4 )
{
// If doing a query return current script.
 
interp.setResult( avail.script );
return TCL.CompletionCode.RETURN;
}
 
// We matched so we must be setting the script.
 
break;
}
}
 
// When we do not match on a query return nothing.
 
if ( objv.Length == 4 )
{
return TCL.CompletionCode.RETURN;
}
if ( avail == null )
{
avail = new PkgAvail();
avail.version = version;
if ( prev == null )
{
avail.next = pkg.avail;
pkg.avail = avail;
}
else
{
avail.next = prev.next;
prev.next = avail;
}
}
 
avail.script = objv[4].ToString();
return TCL.CompletionCode.RETURN;
}
 
case OPT_NAMES:
{
if ( objv.Length != 2 )
{
throw new TclNumArgsException( interp, 1, objv, "names" );
}
 
try
{
sbuf = new StringBuilder();
enum_Renamed = interp.packageTable.GetEnumerator();
once = false;
while ( enum_Renamed.MoveNext() )
{
once = true;
key = ( (string)enum_Renamed.Current );
pkg = (Package)enum_Renamed.Value;
if ( ( (System.Object)pkg.version != null ) || ( pkg.avail != null ) )
{
Util.appendElement( interp, sbuf, key );
}
}
if ( once )
{
interp.setResult( sbuf.ToString() );
}
}
catch ( TclException e )
{
 
throw new TclRuntimeError( "unexpected TclException: " + e );
}
return TCL.CompletionCode.RETURN;
}
 
case OPT_PRESENT:
{
if ( objv.Length < 3 )
{
throw new TclNumArgsException( interp, 2, objv, "?-exact? package ?version?" );
}
 
if ( objv[2].ToString().Equals( "-exact" ) )
{
exact = 1;
}
else
{
exact = 0;
}
 
version = null;
if ( objv.Length == ( 4 + exact ) )
{
 
version = objv[3 + exact].ToString();
checkVersion( interp, version );
}
else if ( ( objv.Length != 3 ) || ( exact == 1 ) )
{
throw new TclNumArgsException( interp, 2, objv, "?-exact? package ?version?" );
}
if ( exact == 1 )
{
 
version = pkgPresent( interp, objv[3].ToString(), version, true );
}
else
{
 
version = pkgPresent( interp, objv[2].ToString(), version, false );
}
interp.setResult( version );
break;
}
 
case OPT_PROVIDE:
{
if ( ( objv.Length < 3 ) || ( objv.Length > 4 ) )
{
throw new TclNumArgsException( interp, 1, objv, "provide package ?version?" );
}
if ( objv.Length == 3 )
{
 
pkg = (Package)interp.packageTable[objv[2].ToString()];
if ( pkg != null )
{
if ( (System.Object)pkg.version != null )
{
interp.setResult( pkg.version );
}
}
return TCL.CompletionCode.RETURN;
}
 
pkgProvide( interp, objv[2].ToString(), objv[3].ToString() );
return TCL.CompletionCode.RETURN;
}
 
case OPT_REQUIRE:
{
if ( ( objv.Length < 3 ) || ( objv.Length > 5 ) )
{
throw new TclNumArgsException( interp, 1, objv, "require ?-exact? package ?version?" );
}
 
if ( objv[2].ToString().Equals( "-exact" ) )
{
exact = 1;
}
else
{
exact = 0;
}
version = null;
if ( objv.Length == ( 4 + exact ) )
{
 
version = objv[3 + exact].ToString();
checkVersion( interp, version );
}
else if ( ( objv.Length != 3 ) || ( exact == 1 ) )
{
throw new TclNumArgsException( interp, 1, objv, "require ?-exact? package ?version?" );
}
if ( exact == 1 )
{
 
version = pkgRequire( interp, objv[3].ToString(), version, true );
}
else
{
 
version = pkgRequire( interp, objv[2].ToString(), version, false );
}
interp.setResult( version );
return TCL.CompletionCode.RETURN;
}
 
case OPT_UNKNOWN:
{
if ( objv.Length > 3 )
{
throw new TclNumArgsException( interp, 1, objv, "unknown ?command?" );
}
if ( objv.Length == 2 )
{
if ( (System.Object)interp.packageUnknown != null )
{
interp.setResult( interp.packageUnknown );
}
}
else if ( objv.Length == 3 )
{
interp.packageUnknown = null;
 
cmd = objv[2].ToString();
if ( cmd.Length > 0 )
{
interp.packageUnknown = cmd;
}
}
return TCL.CompletionCode.RETURN;
}
 
case OPT_VCOMPARE:
{
if ( objv.Length != 4 )
{
throw new TclNumArgsException( interp, 1, objv, "vcompare version1 version2" );
}
 
ver1 = objv[2].ToString();
 
ver2 = objv[3].ToString();
checkVersion( interp, ver1 );
checkVersion( interp, ver2 );
interp.setResult( compareVersions( ver1, ver2, null ) );
return TCL.CompletionCode.RETURN;
}
 
case OPT_VERSIONS:
{
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 1, objv, "versions package" );
}
 
pkg = (Package)interp.packageTable[objv[2].ToString()];
if ( pkg != null )
{
try
{
sbuf = new StringBuilder();
once = false;
for ( avail = pkg.avail; avail != null; avail = avail.next )
{
once = true;
Util.appendElement( interp, sbuf, avail.version );
}
if ( once )
{
interp.setResult( sbuf.ToString() );
}
}
catch ( TclException e )
{
throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
}
}
return TCL.CompletionCode.RETURN;
}
 
case OPT_VSATISFIES:
{
if ( objv.Length != 4 )
{
throw new TclNumArgsException( interp, 1, objv, "vsatisfies version1 version2" );
}
 
 
ver1 = objv[2].ToString();
 
ver2 = objv[3].ToString();
checkVersion( interp, ver1 );
checkVersion( interp, ver2 );
vsres = new VersionSatisfiesResult();
compareVersions( ver1, ver2, vsres );
interp.setResult( vsres.satisfies );
return TCL.CompletionCode.RETURN;
}
 
default:
{
throw new TclRuntimeError( "TclIndex.get() error" );
}
 
} // end switch(opt)
return TCL.CompletionCode.RETURN;
}
private static Package findPackage( Interp interp, string pkgName )
{
Package pkg;
 
// check package name to make sure it is not null or "".
 
if ( (System.Object)pkgName == null || pkgName.Length == 0 )
{
throw new TclException( interp, "expected package name but got \"\"" );
}
 
pkg = (Package)interp.packageTable[pkgName];
if ( pkg == null )
{
// We should add a package with this name.
 
pkg = new Package();
SupportClass.PutElement( interp.packageTable, pkgName, pkg );
}
return pkg;
}
private static void checkVersion( Interp interp, string version )
{
int i, len;
char c;
bool error = true;
 
try
{
if ( ( (System.Object)version == null ) || ( version.Length == 0 ) )
{
version = "";
return;
}
if ( !System.Char.IsDigit( version[0] ) )
{
return;
}
len = version.Replace( ".C#", "" ).Replace( "(C#)", "" ).Replace( "C#", "" ).Length;
for ( i = 1; i < len; i++ )
{
c = version[i];
if ( !System.Char.IsDigit( c ) && ( c != '.' ) )
{
return;
}
}
if ( version[len - 1] == '.' )
{
return;
}
error = false;
}
finally
{
if ( error )
{
throw new TclException( interp, "expected version number but got \"" + version + "\"" );
}
}
}
private static int compareVersions( string v1, string v2, VersionSatisfiesResult vsres )
{
int i;
int max;
int n1 = 0;
int n2 = 0;
bool thisIsMajor = true;
string[] v1ns;
string[] v2ns;
 
// Each iteration of the following loop processes one number from
// each string, terminated by a ".". If those numbers don't match
// then the comparison is over; otherwise, we loop back for the
// next number.
 
 
// This should never happen because null strings would not
// have gotten past the version verify.
 
if ( ( (System.Object)v1 == null ) || ( (System.Object)v2 == null ) )
{
throw new TclRuntimeError( "null version in package version compare" );
}
v1ns = split( v1, '.' );
v2ns = split( v2, '.' );
 
// We are sure there is at least one string in each array so
// this should never happen.
 
if ( v1ns.Length == 0 || v2ns.Length == 0 )
{
throw new TclRuntimeError( "version length is 0" );
}
if ( v1ns.Length > v2ns.Length )
{
max = v1ns.Length;
}
else
{
max = v2ns.Length;
}
 
for ( i = 0; i < max; i++ )
{
n1 = n2 = 0;
 
// Grab number from each version ident if version spec
// ends the use a 0 as value.
 
try
{
if ( i < v1ns.Length )
{
n1 = System.Int32.Parse( v1ns[i] );
}
if ( i < v2ns.Length )
{
n2 = System.Int32.Parse( v2ns[i] );
}
}
catch ( System.FormatException ex )
{
throw new TclRuntimeError( "NumberFormatException for package versions \"" + v1 + "\" or \"" + v2 + "\"" );
}
 
// Compare and go on to the next version number if the
// current numbers match.
 
if ( n1 != n2 )
{
break;
}
thisIsMajor = false;
}
if ( vsres != null )
{
vsres.satisfies = ( ( n1 == n2 ) || ( ( n1 > n2 ) && !thisIsMajor ) );
}
if ( n1 > n2 )
{
return 1;
}
else if ( n1 == n2 )
{
return 0;
}
else
{
return -1;
}
}
internal static string[] split( string in_Renamed, char splitchar )
{
ArrayList words;
string[] ret;
int i;
int len;
char[] str;
int wordstart = 0;
 
// Create an array that is as big as the input
// str plus one for an extra split char.
 
len = in_Renamed.Length;
str = new char[len + 1];
SupportClass.GetCharsFromString( in_Renamed, 0, len, ref str, 0 );
str[len++] = splitchar;
words = new ArrayList( 5 );
 
for ( i = 0; i < len; i++ )
{
 
// Compare this char to the split char
// if they are the same the we need to
// add the last word to the array.
 
if ( str[i] == splitchar )
{
if ( wordstart <= ( i - 1 ) )
{
words.Add( new string( str, wordstart, i - wordstart ) );
}
wordstart = ( i + 1 );
}
}
 
// Create an array that is as big as the number
// of elements in the vector, copy over and return.
 
ret = new string[words.Count];
words.CopyTo( ret );
return ret;
}
 
 
 
 
 
 
 
 
// If compare versions is called with a third argument then one of
// these structures needs to be created and passed in
 
 
internal class VersionSatisfiesResult
{
internal bool satisfies = false;
}
 
// Each invocation of the "package ifneeded" command creates a class
// of the following type, which is used to load the package into the
// interpreter if it is requested with a "package require" command.
 
internal class PkgAvail
{
internal string version = null; // Version string.
internal string script = null; // Script to invoke to provide this package version
internal PkgAvail next = null; // Next in list of available package versions
}
 
 
 
// For each package that is known in any way to an interpreter, there
// is one record of the following type. These records are stored in
// the "packageTable" hash table in the interpreter, keyed by
// package name such as "Tk" (no version number).
 
internal class Package
{
internal string version = null; // Version that has been supplied in this
// interpreter via "package provide"
// null means the package doesn't
// exist in this interpreter yet.
 
internal PkgAvail avail = null; // First in list of all available package versions
}
} //end of class PackageCmd
}
/trunk/TCL/src/commands/ParseAdaptor.cs
@@ -0,0 +1,167 @@
#undef DEBUG
/*
* ParseAdaptor.java --
*
* Temporary adaptor class that creates the interface from the
* current expression parser to the new Parser class.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ParseAdaptor.java,v 1.6 2003/02/05 09:24:40 mdejong Exp $
*/
using System;
namespace tcl.lang
{
 
class ParseAdaptor
{
internal static ParseResult parseVar( Interp interp, string inString, int index, int length )
{
ParseResult result;
 
index--;
result = Parser.parseVar( interp, inString.Substring( index, ( length ) - ( index ) ) );
result.nextIndex += index;
return ( result );
}
internal static ParseResult parseNestedCmd( Interp interp, string inString, int index, int length )
{
CharPointer script;
TclObject obj;
 
// Check for the easy case where the last character in the string is '['.
if ( index == length )
{
throw new TclException( interp, "missing close-bracket" );
}
 
script = new CharPointer( inString );
script.index = index;
 
interp.evalFlags |= Parser.TCL_BRACKET_TERM;
Parser.eval2( interp, script.array, script.index, length - index, 0 );
obj = interp.getResult();
obj.preserve();
return ( new ParseResult( obj, index + interp.termOffset + 1 ) );
}
internal static ParseResult parseQuotes( Interp interp, string inString, int index, int length )
{
TclObject obj;
TclParse parse = null;
TclToken token;
CharPointer script;
 
try
{
 
script = new CharPointer( inString );
script.index = index;
 
parse = new TclParse( interp, script.array, length, null, 0 );
 
System.Diagnostics.Debug.WriteLine( "string is \"" + inString + "\"" );
System.Diagnostics.Debug.WriteLine( "script.array is \"" + new string( script.array ) + "\"" );
 
System.Diagnostics.Debug.WriteLine( "index is " + index );
System.Diagnostics.Debug.WriteLine( "length is " + length );
 
System.Diagnostics.Debug.WriteLine( "parse.endIndex is " + parse.endIndex );
 
 
parse.commandStart = script.index;
token = parse.getToken( 0 );
token.type = Parser.TCL_TOKEN_WORD;
token.script_array = script.array;
token.script_index = script.index;
parse.numTokens++;
parse.numWords++;
parse = Parser.parseTokens( script.array, script.index, Parser.TYPE_QUOTE, parse );
 
// Check for the error condition where the parse did not end on
// a '"' char. Is this happened raise an error.
 
if ( script.array[parse.termIndex] != '"' )
{
throw new TclException( interp, "missing \"" );
}
 
// if there was no error then parsing will continue after the
// last char that was parsed from the string
 
script.index = parse.termIndex + 1;
 
// Finish filling in the token for the word and check for the
// special case of a word consisting of a single range of
// literal text.
 
token = parse.getToken( 0 );
token.size = script.index - token.script_index;
token.numComponents = parse.numTokens - 1;
if ( ( token.numComponents == 1 ) && ( parse.getToken( 1 ).type == Parser.TCL_TOKEN_TEXT ) )
{
token.type = Parser.TCL_TOKEN_SIMPLE_WORD;
}
parse.commandSize = script.index - parse.commandStart;
if ( parse.numTokens > 0 )
{
obj = Parser.evalTokens( interp, parse.tokenList, 1, parse.numTokens - 1 );
}
else
{
throw new TclRuntimeError( "parseQuotes error: null obj result" );
}
}
finally
{
parse.release();
}
 
return ( new ParseResult( obj, script.index ) );
}
internal static ParseResult parseBraces( Interp interp, string str, int index, int length )
{
char[] arr = str.ToCharArray();
int level = 1;
 
for ( int i = index; i < length; )
{
if ( Parser.charType( arr[i] ) == Parser.TYPE_NORMAL )
{
i++;
}
else if ( arr[i] == '}' )
{
level--;
if ( level == 0 )
{
str = new string( arr, index, i - index );
return new ParseResult( str, i + 1 );
}
i++;
}
else if ( arr[i] == '{' )
{
level++;
i++;
}
else if ( arr[i] == '\\' )
{
BackSlashResult bs = Parser.backslash( arr, i );
i = bs.nextIndex;
}
else
{
i++;
}
}
 
//if you run off the end of the string you went too far
throw new TclException( interp, "missing close-brace" );
}
} // end ParseAdaptor
}
/trunk/TCL/src/commands/ProcCmd.cs
@@ -0,0 +1,116 @@
/*
* ProcCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ProcCmd.java,v 1.2 1999/08/03 03:04:19 mo Exp $
*
*/
using System.Text;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "proc" command in Tcl.</summary>
 
class ProcCmd : Command
{
/// <summary>
/// Tcl_ProcObjCmd -> ProcCmd.cmdProc
///
/// Creates a new Tcl procedure.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="objv">command arguments.
/// </param>
/// <exception cref=""> TclException If incorrect number of arguments.
/// </exception>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
Procedure proc;
string fullName, procName;
NamespaceCmd.Namespace ns, altNs, cxtNs;
Command cmd;
StringBuilder ds;
 
if ( objv.Length != 4 )
{
throw new TclNumArgsException( interp, 1, objv, "name args body" );
}
 
// Determine the namespace where the procedure should reside. Unless
// the command name includes namespace qualifiers, this will be the
// current namespace.
 
 
fullName = objv[1].ToString();
 
// Java does not support passing an address so we pass
// an array of size 1 and then assign arr[0] to the value
NamespaceCmd.Namespace[] nsArr = new NamespaceCmd.Namespace[1];
NamespaceCmd.Namespace[] altNsArr = new NamespaceCmd.Namespace[1];
NamespaceCmd.Namespace[] cxtNsArr = new NamespaceCmd.Namespace[1];
string[] procNameArr = new string[1];
 
NamespaceCmd.getNamespaceForQualName( interp, fullName, null, 0, nsArr, altNsArr, cxtNsArr, procNameArr );
 
// Get the values out of the arrays
ns = nsArr[0];
altNs = altNsArr[0];
cxtNs = cxtNsArr[0];
procName = procNameArr[0];
 
if ( ns == null )
{
throw new TclException( interp, "can't create procedure \"" + fullName + "\": unknown namespace" );
}
if ( (System.Object)procName == null )
{
throw new TclException( interp, "can't create procedure \"" + fullName + "\": bad procedure name" );
}
// FIXME : could there be a problem with a command named ":command" ?
if ( ( ns != NamespaceCmd.getGlobalNamespace( interp ) ) && ( (System.Object)procName != null ) && ( ( procName.Length > 0 ) && ( procName[0] == ':' ) ) )
{
throw new TclException( interp, "can't create procedure \"" + procName + "\" in non-global namespace with name starting with \":\"" );
}
 
// Create the data structure to represent the procedure.
 
proc = new Procedure( interp, ns, procName, objv[2], objv[3], interp.ScriptFile, interp.getArgLineNumber( 3 ) );
 
// Now create a command for the procedure. This will initially be in
// the current namespace unless the procedure's name included namespace
// qualifiers. To create the new command in the right namespace, we
// generate a fully qualified name for it.
 
ds = new StringBuilder();
if ( ns != NamespaceCmd.getGlobalNamespace( interp ) )
{
ds.Append( ns.fullName );
ds.Append( "::" );
}
ds.Append( procName );
 
interp.createCommand( ds.ToString(), proc );
 
// Now initialize the new procedure's cmdPtr field. This will be used
// later when the procedure is called to determine what namespace the
// procedure will run in. This will be different than the current
// namespace if the proc was renamed into a different namespace.
 
// FIXME : we do not handle renaming into another namespace correctly yet!
//procPtr->cmdPtr = (Command *) cmd;
 
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/PutsCmd.cs
@@ -0,0 +1,110 @@
/*
* PutsCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: PutsCmd.java,v 1.6 2002/01/21 06:34:26 mdejong Exp $
*
*/
using System;
using System.IO;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "puts" command in Tcl.</summary>
 
class PutsCmd : Command
{
/// <summary> Prints the given string to a channel. See Tcl user
/// documentation for details.
///
/// </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
string channelId; // String containing the key to chanTable
string arg; // Argv[i] converted to a string
int i = 1; // Index to the next arg in argv
bool newline = true;
// Indicates to print a newline in result
 
 
if ( ( argv.Length >= 2 ) && ( argv[1].ToString().Equals( "-nonewline" ) ) )
{
newline = false;
i++;
}
if ( ( i < argv.Length - 3 ) || ( i >= argv.Length ) )
{
throw new TclNumArgsException( interp, 1, argv, "?-nonewline? ?channelId? string" );
}
 
// The code below provides backwards compatibility with an old
// form of the command that is no longer recommended or documented.
 
if ( i == ( argv.Length - 3 ) )
{
 
arg = argv[i + 2].ToString();
if ( !arg.Equals( "nonewline" ) )
{
throw new TclException( interp, "bad argument \"" + arg + "\": should be \"nonewline\"" );
}
newline = false;
}
 
if ( i == ( argv.Length - 1 ) )
{
channelId = "stdout";
}
else
{
 
channelId = argv[i].ToString();
i++;
}
 
if ( i != ( argv.Length - 1 ) )
{
throw new TclNumArgsException( interp, 1, argv, "?-nonewline? ?channelId? string" );
}
 
chan = TclIO.getChannel( interp, channelId );
if ( chan == null )
{
throw new TclException( interp, "can not find channel named \"" + channelId + "\"" );
}
 
try
{
if ( newline )
{
chan.write( interp, argv[i] );
chan.write( interp, "\n" );
}
else
{
chan.write( interp, argv[i] );
}
}
catch ( IOException e )
{
throw new TclRuntimeError( "PutsCmd.cmdProc() Error: IOException when putting " + chan.ChanName );
}
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/PwdCmd.cs
@@ -0,0 +1,53 @@
/*
* PwdCmd.java
*
* This file contains the Jacl implementation of the built-in Tcl "pwd"
* command.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: PwdCmd.java,v 1.2 1999/05/09 01:12:14 dejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements the built-in "pwd" command in Tcl.
*/
 
class PwdCmd : Command
{
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
if ( argv.Length != 1 )
{
throw new TclNumArgsException( interp, 1, argv, null );
}
 
// Get the name of the working dir.
 
string dirName = interp.getWorkingDir().ToString();
 
// Java File Object methods use backslashes on Windows.
// Convert them to forward slashes before returning the dirName to Tcl.
 
if ( JACL.PLATFORM == JACL.PLATFORM_WINDOWS )
{
dirName = dirName.Replace( '\\', '/' );
}
 
interp.setResult( dirName );
return TCL.CompletionCode.RETURN;
}
} // end PwdCmd class
}
/trunk/TCL/src/commands/ReadCmd.cs
@@ -0,0 +1,183 @@
/*
* ReadCmd.java --
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ReadCmd.java,v 1.8 2003/03/08 03:42:44 mdejong Exp $
*
*/
using System.Text;
using System.IO;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "read" command in Tcl.</summary>
 
class ReadCmd : Command
{
 
/// <summary> This procedure is invoked to process the "read" 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
int i = 1; // Index to the next arg in argv
int toRead = 0; // Number of bytes or chars to read from channel
int charactersRead; // Number of bytes or chars read from channel
bool readAll = true; // If true read-all else toRead
bool noNewline = false; // If true, strip the newline if there
TclObject result;
 
 
if ( ( argv.Length != 2 ) && ( argv.Length != 3 ) )
{
 
errorWrongNumArgs( interp, argv[0].ToString() );
}
 
 
if ( argv[i].ToString().Equals( "-nonewline" ) )
{
noNewline = true;
i++;
}
 
if ( i == argv.Length )
{
 
errorWrongNumArgs( interp, argv[0].ToString() );
}
 
 
chan = TclIO.getChannel( interp, argv[i].ToString() );
if ( chan == null )
{
 
throw new TclException( interp, "can not find channel named \"" + argv[i].ToString() + "\"" );
}
 
// Consumed channel name.
 
i++;
 
// Compute how many bytes or chars to read, and see whether the final
// noNewline should be dropped.
 
if ( i < argv.Length )
{
 
string arg = argv[i].ToString();
 
if ( System.Char.IsDigit( arg[0] ) )
{
toRead = TclInteger.get( interp, argv[i] );
readAll = false;
}
else if ( arg.Equals( "nonewline" ) )
{
noNewline = true;
}
else
{
throw new TclException( interp, "bad argument \"" + arg + "\": should be \"nonewline\"" );
}
}
 
try
{
if ( (System.Object)chan.Encoding == null )
{
result = TclByteArray.newInstance();
}
else
{
result = TclString.newInstance( new StringBuilder( 64 ) );
}
if ( readAll )
{
charactersRead = chan.read( interp, result, TclIO.READ_ALL, 0 );
 
// If -nonewline was specified, and we have not hit EOF
// and the last char is a "\n", then remove it and return.
 
if ( noNewline )
{
 
string inStr = result.ToString();
if ( ( charactersRead > 0 ) && ( inStr[charactersRead - 1] == '\n' ) )
{
interp.setResult( inStr.Substring( 0, ( ( charactersRead - 1 ) ) - ( 0 ) ) );
return TCL.CompletionCode.RETURN;
}
}
}
else
{
// FIXME: Bug here, the -nonewline flag must be respected
// when reading a set number of bytes
charactersRead = chan.read( interp, result, TclIO.READ_N_BYTES, toRead );
}
 
/*
// FIXME: Port this -nonewline logic from the C code.
if (charactersRead < 0) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading \"", name, "\": ",
Tcl_PosixError(interp), (char *) NULL);
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
// If requested, remove the last newline in the channel if at EOF.
if ((charactersRead > 0) && (newline != 0)) {
char *result;
int length;
result = Tcl_GetStringFromObj(resultPtr, length);
if (result[length - 1] == '\n') {
Tcl_SetObjLength(resultPtr, length - 1);
}
}
*/
 
interp.setResult( result );
}
catch ( IOException e )
{
throw new TclRuntimeError( "ReadCmd.cmdProc() Error: IOException when reading " + chan.ChanName );
}
return TCL.CompletionCode.RETURN;
}
 
/// <summary> A unique error msg is printed for read, therefore dont call this
/// instead of the standard TclNumArgsException().
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="cmd">the name of the command (extracted form argv[0] of cmdProc)
/// </param>
 
private void errorWrongNumArgs( Interp interp, string cmd )
{
throw new TclException( interp, "wrong # args: should be \"" + "read channelId ?numChars?\" " + "or \"read ?-nonewline? channelId\"" );
}
}
}
/trunk/TCL/src/commands/RegexpCmd.cs
@@ -0,0 +1,130 @@
/*
* RegexpCmd.java --
*
* This file contains the Jacl implementation of the built-in Tcl
* "regexp" command.
*
* Copyright (c) 1997-1999 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: RegexpCmd.java,v 1.3 2000/02/23 22:07:23 mo Exp $
*/
using System;
using Regexp = sunlabs.brazil.util.regexp.Regexp;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "regexp" command in Tcl.</summary>
 
class RegexpCmd : Command
{
 
private static readonly string[] validOpts = new string[] { "-indices", "-nocase", "--" };
private const int OPT_INDICES = 0;
private const int OPT_NOCASE = 1;
private const int OPT_LAST = 2;
internal static void init( Interp interp )
// Current interpreter.
{
interp.createCommand( "regexp", new tcl.lang.RegexpCmd() );
interp.createCommand( "regsub", new tcl.lang.RegsubCmd() );
}
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
bool nocase = false;
bool indices = false;
 
try
{
int i = 1;
 
while ( argv[i].ToString().StartsWith( "-" ) )
{
int index = TclIndex.get( interp, argv[i], validOpts, "switch", 0 );
i++;
switch ( index )
{
 
case OPT_INDICES:
{
indices = true;
break;
}
 
case OPT_NOCASE:
{
nocase = true;
break;
}
 
case OPT_LAST:
{
goto opts_brk;
}
}
}
 
opts_brk:
;
 
 
TclObject exp = TclString.newInstance( argv[i++].ToString().Replace( "\\d", "[0-9]" ) );
 
string inString = argv[i++].ToString();
 
int matches = argv.Length - i;
 
Regexp r = TclRegexp.compile( interp, exp, nocase );
 
int[] args = new int[matches * 2];
bool matched = r.match( inString, args );
if ( matched )
{
for ( int match = 0; i < argv.Length; i++ )
{
TclObject obj;
 
int start = args[match++];
int end = args[match++];
if ( indices )
{
if ( end >= 0 )
{
end--;
}
obj = TclList.newInstance();
TclList.append( interp, obj, TclInteger.newInstance( start ) );
TclList.append( interp, obj, TclInteger.newInstance( end ) );
}
else
{
string range = ( start >= 0 ) ? inString.Substring( start, ( end ) - ( start ) ) : "";
obj = TclString.newInstance( range );
}
try
{
 
interp.setVar( argv[i].ToString(), obj, 0 );
}
catch ( TclException e )
{
 
throw new TclException( interp, "couldn't set variable \"" + argv[i] + "\"" );
}
}
}
interp.setResult( matched );
}
catch ( System.IndexOutOfRangeException e )
{
throw new TclNumArgsException( interp, 1, argv, "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?" );
}
return TCL.CompletionCode.RETURN;
}
} // end RegexpCmd
}
/trunk/TCL/src/commands/RegsubCmd.cs
@@ -0,0 +1,137 @@
using System.Text;
/*
* RegsubCmd.java
*
* This contains the Jacl implementation of the built-in Tcl
* "regsub" command.
*
* Copyright (c) 1997-1999 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: RegsubCmd.java,v 1.4 2000/02/23 22:07:23 mo Exp $
*/
using Regexp = sunlabs.brazil.util.regexp.Regexp;
using Regsub = sunlabs.brazil.util.regexp.Regsub;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "regsub" command in Tcl.</summary>
 
class RegsubCmd : Command
{
 
private static readonly string[] validOpts = new string[] { "-all", "-nocase", "--" };
private const int OPT_ALL = 0;
private const int OPT_NOCASE = 1;
private const int OPT_LAST = 2;
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
bool all = false;
bool nocase = false;
 
try
{
int i = 1;
 
while ( argv[i].ToString().StartsWith( "-" ) )
{
int index = TclIndex.get( interp, argv[i], validOpts, "switch", 0 );
i++;
switch ( index )
{
 
case OPT_ALL:
{
all = true;
break;
}
 
case OPT_NOCASE:
{
nocase = true;
break;
}
 
case OPT_LAST:
{
goto opts_brk;
}
}
}
 
opts_brk:
;
 
 
TclObject exp = argv[i++];
 
string inString = argv[i++].ToString();
 
string subSpec = argv[i++].ToString();
 
string varName = null;
if (i != argv.Length) varName = argv[i++].ToString();
if ( i != argv.Length )
{
throw new System.IndexOutOfRangeException();
}
 
Regexp r = TclRegexp.compile( interp, exp, nocase );
 
int count = 0;
string result;
 
if ( all == false )
{
result = r.sub( inString, subSpec );
if ( (System.Object)result == null )
{
result = inString;
}
else
{
count++;
}
}
else
{
StringBuilder sb = new StringBuilder();
Regsub s = new Regsub( r, inString );
while ( s.nextMatch() )
{
count++;
sb.Append( s.skipped() );
Regexp.applySubspec( s, subSpec, sb );
}
sb.Append( s.rest() );
result = sb.ToString();
}
 
TclObject obj = TclString.newInstance( result );
if ( varName == null )
interp.setResult( result );
else {
try
{
interp.setVar( varName, obj, 0 );
}
catch ( TclException e )
{
throw new TclException( interp, "couldn't set variable \"" + varName + "\"" );
}
interp.setResult( count );
}
}
catch ( System.IndexOutOfRangeException e )
{
throw new TclNumArgsException( interp, 1, argv, "?switches? exp string subSpec ?varName?" );
}
return TCL.CompletionCode.RETURN;
}
} // end RegsubCmd
}
/trunk/TCL/src/commands/RenameCmd.cs
@@ -0,0 +1,59 @@
/*
* RenameCmd.java
*
* Copyright (c) 1999 Mo DeJong.
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: RenameCmd.java,v 1.2 1999/08/03 03:07:54 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "rename" command in Tcl.</summary>
 
class RenameCmd : Command
{
/// <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;
}
}
}
/trunk/TCL/src/commands/ReturnCmd.cs
@@ -0,0 +1,131 @@
/*
* ReturnCmd.java --
*
* This file implements the Tcl "return" command.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ReturnCmd.java,v 1.1.1.1 1998/10/14 21:09:19 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements the built-in "return" command in Tcl.
*/
 
class ReturnCmd : Command
{
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
interp.errorCode = null;
interp.errorInfo = null;
TCL.CompletionCode returnCode;
int i;
 
/*
* Note: returnCode is the value given by the -code option. Don't
* confuse this value with the compCode variable of the
* TclException thrown by this method, which is always TCL.CompletionCode.RETURN.
*/
 
returnCode = TCL.CompletionCode.OK;
for ( i = 1; i < argv.Length - 1; i += 2 )
{
 
if ( argv[i].ToString().Equals( "-code" ) )
{
 
if ( argv[i + 1].ToString().Equals( "ok" ) )
{
returnCode = TCL.CompletionCode.OK;
}
else
{
 
if ( argv[i + 1].ToString().Equals( "error" ) )
{
returnCode = TCL.CompletionCode.ERROR;
}
else
{
 
if ( argv[i + 1].ToString().Equals( "return" ) )
{
returnCode = TCL.CompletionCode.RETURN;
}
else
{
 
if ( argv[i + 1].ToString().Equals( "break" ) )
{
returnCode = TCL.CompletionCode.BREAK;
}
else
{
 
if ( argv[i + 1].ToString().Equals( "continue" ) )
{
returnCode = TCL.CompletionCode.CONTINUE;
}
else
{
try
{
returnCode = (TCL.CompletionCode)TclInteger.get( interp, argv[i + 1] );
}
catch ( TclException e )
{
 
throw new TclException( interp, "bad completion code \"" + argv[i + 1] + "\": must be ok, error, return, break, " + "continue, or an integer" );
}
}
}
}
}
}
}
else
{
 
if ( argv[i].ToString().Equals( "-errorcode" ) )
{
 
interp.errorCode = argv[i + 1].ToString();
}
else
{
 
if ( argv[i].ToString().Equals( "-errorinfo" ) )
{
 
interp.errorInfo = argv[i + 1].ToString();
}
else
{
 
throw new TclException( interp, "bad option \"" + argv[i] + "\": must be -code, -errorcode, or -errorinfo" );
}
}
}
}
if ( i != argv.Length )
{
interp.setResult( argv[argv.Length - 1] );
}
 
interp.returnCode = returnCode;
throw new TclException( TCL.CompletionCode.RETURN );
}
} // end ReturnCmd
}
/trunk/TCL/src/commands/ScanCmd.cs
@@ -0,0 +1,685 @@
/*
* ScanCmd.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: ScanCmd.java,v 1.2 1999/05/09 01:22:09 dejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "scan" command in Tcl.
///
/// </summary>
 
class ScanCmd : Command
{
/// <summary> This procedure is invoked to process the "scan" Tcl command.
/// See the user documentation for details on what it does.
///
/// Each iteration of the cmdProc compares the scanArr's current index to
/// the frmtArr's index. If the chars are equal then the indicies are
/// incremented. If a '%' is found in the frmtArr, the formatSpecifier
/// is parced from the frmtArr, the corresponding value is extracted from
/// the scanArr, and that value is set in the Tcl Interp.
///
/// If the chars are not equal, or the conversion fails, the boolean
/// scanArrDone is set to true, indicating the scanArr is not to be
/// parced and no new values are to be set. However the frmtArr is still
/// parced because of the priority of error messages. In the C version
/// of Tcl, bad format specifiers throw errors before incorrect argument
/// input or other scan errors. Thus we need to parce the entire frmtArr
/// to verify correct formating. This is dumb and inefficient but it is
/// consistent w/ the current C-version of Tcl.
/// </summary>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
 
if ( argv.Length < 3 )
{
throw new TclNumArgsException( interp, 1, argv, "string format ?varName varName ...?" );
}
;
 
StrtoulResult strul; // Return value for parcing the scanArr when
// extracting integers/longs
StrtodResult strd;
; // Return value for parcing the scanArr when
// extracting doubles
char[] scanArr; // Array containing parce info
char[] frmtArr; // Array containing info on how to
// parse the scanArr
int scanIndex; // Index into the scan array
int frmtIndex; // Index into the frmt array
int tempIndex; // Temporary index holder
int argIndex; // Index into the current arg
int width; // Stores the user specified result width
int base_; // Base of the integer being converted
int numUnMatched; // Number of fields actually set.
int numMatched; // Number of fields actually matched.
int negateScan; // Mult by result, set to -1 if true
int i; // Generic variable
char ch; // Generic variable
bool cont; // Used in loops to indicate when to stop
bool scanOK; // Set to false if strtoul/strtod fails
bool scanArrDone; // Set to false if strtoul/strtod fails
bool widthFlag; // True is width is specified
bool discardFlag; // If a "%*" is in the formatString dont
// write output to arg
 
 
scanArr = argv[1].ToString().ToCharArray();
 
frmtArr = argv[2].ToString().ToCharArray();
width = base_ = numMatched = numUnMatched = 0;
scanIndex = frmtIndex = 0;
scanOK = true;
scanArrDone = false;
argIndex = 3;
 
// Skip all (if any) of the white space before getting to a char
 
frmtIndex = skipWhiteSpace( frmtArr, frmtIndex );
 
// Search through the frmtArr. If the next char is a '%' parse the
// next chars and determine the type (if any) of the format specifier.
// If the scanArr has been fully searched, do nothing but incerment
// "numUnMatched". The reason to continue the frmtArr search is for
// consistency in output. Previously scan format errors were reported
// before arg input mismatch, so this maintains the same level of error
// checking.
 
while ( frmtIndex < frmtArr.Length )
{
discardFlag = widthFlag = false;
negateScan = 1;
cont = true;
 
// Parce the format array and read in the correct value from the
// scan array. When the correct value is retrieved, set the
// variable (from argv) in the interp.
 
if ( frmtArr[frmtIndex] == '%' )
{
 
frmtIndex++;
checkOverFlow( interp, frmtArr, frmtIndex );
 
// Two '%'s in a row, do nothing...
 
if ( frmtArr[frmtIndex] == '%' )
{
frmtIndex++;
scanIndex++;
continue;
}
 
// Check for a discard field flag
 
if ( frmtArr[frmtIndex] == '*' )
{
discardFlag = true;
frmtIndex++;
checkOverFlow( interp, frmtArr, frmtIndex );
}
 
// Check for a width field and accept the 'h', 'l', 'L'
// characters, but do nothing with them.
//
// Note: The order of the width specifier and the other
// chars is unordered, so we need to iterate until all
// of the specifiers are identified.
 
while ( cont )
{
cont = false;
 
switch ( frmtArr[frmtIndex] )
{
 
case 'h':
case 'l':
case 'L':
{
// Just ignore these values
 
frmtIndex++;
cont = true;
break;
}
 
default:
{
if ( System.Char.IsDigit( frmtArr[frmtIndex] ) )
{
strul = Util.strtoul( new string( frmtArr ), frmtIndex, base_ );
frmtIndex = strul.index;
width = (int)strul.value;
widthFlag = true;
cont = true;
}
}
break;
 
}
checkOverFlow( interp, frmtArr, frmtIndex );
}
 
// On all conversion specifiers except 'c', move the
// scanIndex to the next non-whitespace.
 
ch = frmtArr[frmtIndex];
if ( ( ch != 'c' ) && ( ch != '[' ) && !scanArrDone )
{
scanIndex = skipWhiteSpace( scanArr, scanIndex );
}
if ( scanIndex >= scanArr.Length )
{
scanArrDone = true;
}
 
if ( ( scanIndex < scanArr.Length ) && ( ch != 'c' ) && ( ch != '[' ) )
{
// Since strtoul dosent take signed numbers, make the
// value positive and store the sign.
 
if ( scanArr[scanIndex] == '-' )
{
negateScan = -1;
scanIndex++;
width--;
}
else if ( scanArr[scanIndex] == '+' )
{
scanIndex++;
width--;
}
 
// The width+scanIndex might be greater than
// the scanArr so we need to re-adjust when this
// happens.
 
if ( widthFlag && ( width + scanIndex > scanArr.Length ) )
{
width = scanArr.Length - scanIndex;
}
}
 
if ( scanIndex >= scanArr.Length )
{
scanArrDone = true;
}
 
// Foreach iteration we want strul and strd to be
// null since we error check on this case.
 
strul = null;
strd = null;
 
switch ( ch )
{
 
case 'd':
case 'o':
case 'x':
{
 
if ( !scanArrDone )
{
 
if ( ch == 'd' )
{
base_ = 10;
}
else if ( ch == 'o' )
{
base_ = 8;
}
else
{
base_ = 16;
}
 
// If the widthFlag is set then convert only
// "width" characters to an ascii representation,
// else read in until the end of the integer. The
// scanIndex is moved to the point where we stop
// reading in.
 
if ( widthFlag )
{
strul = Util.strtoul( new string( scanArr, 0, width + scanIndex ), scanIndex, base_ );
}
else
{
strul = Util.strtoul( new string( scanArr ), scanIndex, base_ );
}
if ( strul.errno != 0 )
{
scanOK = false;
break;
}
scanIndex = strul.index;
 
if ( !discardFlag )
{
i = (int)strul.value * negateScan;
if ( argIndex == argv.Length )
numMatched--;
else
testAndSetVar( interp, argv, argIndex++, TclInteger.newInstance( i ) );
}
}
break;
}
 
case 'c':
{
if ( widthFlag )
{
errorCharFieldWidth( interp );
}
if ( !discardFlag && !scanArrDone )
{
testAndSetVar( interp, argv, argIndex++, TclInteger.newInstance( scanArr[scanIndex++] ) );
}
break;
}
 
case 's':
{
if ( !scanArrDone )
{
// If the widthFlag is set then read only "width"
// characters into the string, else read in until
// the first whitespace or endArr is found. The
// scanIndex is moved to the point where we stop
// reading in.
 
tempIndex = scanIndex;
if ( !widthFlag )
{
width = scanArr.Length;
}
for ( i = 0; ( scanIndex < scanArr.Length ) && ( i < width ); i++ )
{
ch = scanArr[scanIndex];
if ( ( ch == ' ' ) || ( ch == '\n' ) || ( ch == '\r' ) || ( ch == '\t' ) || ( ch == '\f' ) )
{
break;
}
scanIndex++;
}
 
if ( !discardFlag )
{
string str = new string( scanArr, tempIndex, scanIndex - tempIndex );
testAndSetVar( interp, argv, argIndex++, TclString.newInstance( str ) );
}
}
break;
}
 
case 'e':
case 'f':
case 'g':
{
if ( !scanArrDone )
{
// If the wisthFlag is set then read only "width"
// characters into the string, else read in until
// the first whitespace or endArr is found. The
// scanIndex is moved to the point where we stop
// reading in.
 
if ( widthFlag )
{
strd = Util.strtod( new string( scanArr, 0, width + scanIndex ), scanIndex );
}
else
{
strd = Util.strtod( new string( scanArr ), scanIndex );
}
if ( strd.errno != 0 )
{
scanOK = false;
break;
}
scanIndex = strd.index;
 
if ( !discardFlag )
{
double d = strd.value * negateScan;
testAndSetVar( interp, argv, argIndex++, TclDouble.newInstance( d ) );
}
}
break;
}
 
case '[':
{
bool charMatchFound = false;
bool charNotMatch = false;
char[] tempArr;
int startIndex;
int endIndex;
string unmatched = "unmatched [ in format string";
 
if ( ( ++frmtIndex ) >= frmtArr.Length )
{
throw new TclException( interp, unmatched );
}
 
if ( frmtArr[frmtIndex] == '^' )
{
charNotMatch = true;
frmtIndex += 2;
}
else
{
frmtIndex++;
}
tempIndex = frmtIndex - 1;
 
if ( frmtIndex >= frmtArr.Length )
{
throw new TclException( interp, unmatched );
}
 
// Extract the list of chars for matching.
 
while ( frmtArr[frmtIndex] != ']' )
{
if ( ( ++frmtIndex ) >= frmtArr.Length )
{
throw new TclException( interp, unmatched );
}
}
tempArr = new string( frmtArr, tempIndex, frmtIndex - tempIndex ).ToCharArray();
 
startIndex = scanIndex;
if ( charNotMatch )
{
// Format specifier contained a '^' so interate
// until one of the chars in tempArr is found.
 
while ( scanOK && !charMatchFound )
{
if ( scanIndex >= scanArr.Length )
{
scanOK = false;
break;
}
for ( i = 0; i < tempArr.Length; i++ )
{
if ( tempArr[i] == scanArr[scanIndex] )
{
charMatchFound = true;
break;
}
}
if ( widthFlag && ( ( scanIndex - startIndex ) >= width ) )
{
break;
}
if ( !charMatchFound )
{
scanIndex++;
}
}
}
else
{
// Iterate until the char in the scanArr is not
// in the tempArr.
 
charMatchFound = true;
while ( scanOK && charMatchFound )
{
if ( scanIndex >= scanArr.Length )
{
scanOK = false;
break;
}
charMatchFound = false;
for ( i = 0; i < tempArr.Length; i++ )
{
if ( tempArr[i] == scanArr[scanIndex] )
{
charMatchFound = true;
break;
}
}
if ( widthFlag && ( scanIndex - startIndex ) >= width )
{
break;
}
if ( charMatchFound )
{
scanIndex++;
}
}
}
 
// Indicates nothing was found.
 
endIndex = scanIndex - startIndex;
if ( endIndex <= 0 )
{
scanOK = false;
break;
}
 
if ( !discardFlag )
{
string str = new string( scanArr, startIndex, endIndex );
testAndSetVar( interp, argv, argIndex++, TclString.newInstance( str ) );
}
break;
}
 
default:
{
errorBadField( interp, ch );
}
break;
 
}
 
// As long as the scan was successful (scanOK), the format
// specifier did not contain a '*' (discardFlag), and
// we are not at the end of the scanArr (scanArrDone);
// increment the num of vars set in the interp. Otherwise
// increment the number of valid format specifiers.
 
if ( scanOK && !discardFlag && !scanArrDone )
{
numMatched++;
}
else if ( ( scanArrDone || !scanOK ) && !discardFlag )
{
numUnMatched++;
}
frmtIndex++;
}
else if ( scanIndex < scanArr.Length && scanArr[scanIndex] == frmtArr[frmtIndex] )
{
// No '%' was found, but the characters matched
 
scanIndex++;
frmtIndex++;
}
else
{
// No '%' found and the characters int frmtArr & scanArr
// did not match.
 
frmtIndex++;
}
}
 
// The numMatched is the return value: a count of the num of vars set.
// While the numUnMatched is the number of formatSpecifiers that
// passed the parsing stage, but did not match anything in the scanArr.
 
if ( ( numMatched + numUnMatched ) != ( argv.Length - 3 ) )
{
errorDiffVars( interp );
}
interp.setResult( TclInteger.newInstance( numMatched ) );
return TCL.CompletionCode.RETURN;
}
 
 
/// <summary> Given an array and an index into it, move the index forward
/// until a non-whitespace char is found.
///
/// </summary>
/// <param name="arr"> - the array to search
/// </param>
/// <param name="index">- where to begin the search
/// </param>
/// <returns> The index value where the whitespace ends.
/// </returns>
 
private int skipWhiteSpace( char[] arr, int index )
{
bool cont;
do
{
if ( index >= arr.Length )
{
return index;
}
cont = false;
switch ( arr[index] )
{
 
case '\t':
case '\n':
case '\r':
case '\f':
case ' ':
{
cont = true;
index++;
}
break;
}
}
while ( cont );
 
return index;
}
 
 
/// <summary> Called whenever the cmdProc wants to set an interp value.
/// This method <ol>
/// <li> verifies that there exisits a varName from the argv array,
/// <li> that the variable either dosent exisit or is of type scalar
/// <li> set the variable in interp if (1) and (2) are OK
/// </ol>
///
/// </summary>
/// <param name="interp"> - the Tcl interpreter
/// </param>
/// <param name="argv"> - the argument array
/// </param>
/// <param name="argIndex">- the current index into the argv array
/// </param>
/// <param name="tobj"> - the TclObject that the varName equals
///
/// </param>
 
private static void testAndSetVar( Interp interp, TclObject[] argv, int argIndex, TclObject tobj )
{
if ( argIndex < argv.Length )
{
try
{
 
interp.setVar( argv[argIndex].ToString(), tobj, 0 );
}
catch ( TclException e )
{
 
throw new TclException( interp, "couldn't set variable \"" + argv[argIndex].ToString() + "\"" );
}
}
else
{
errorDiffVars( interp );
}
}
 
 
/// <summary> Called whenever the frmtIndex in the cmdProc is changed. It verifies
/// the the array index is still within the bounds of the array. If no
/// throw error.
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method .
/// </param>
/// <param name="arr"> - The array to be checked.
/// </param>
/// <param name="index"> - The new value for the array index.
/// </param>
 
private static void checkOverFlow( Interp interp, char[] arr, int index )
{
if ( ( index >= arr.Length ) || ( index < 0 ) )
{
throw new TclException( interp, "\"%n$\" argument index out of range" );
}
}
 
 
/// <summary> Called whenever the number of varName args do not match the number
/// of found and valid formatSpecifiers (matched and unmatched).
///
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method .
/// </param>
 
private static void errorDiffVars( Interp interp )
{
 
throw new TclException( interp, "different numbers of variable names and field specifiers" );
}
 
 
/// <summary> Called whenever the current char in the frmtArr is erroneous
///
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method .
/// </param>
/// <param name="fieldSpecifier"> - The erroneous character
/// </param>
 
private static void errorBadField( Interp interp, char fieldSpecifier )
{
throw new TclException( interp, "bad scan conversion character \"" + fieldSpecifier + "\"" );
}
 
 
/// <summary> Called whenever the a width field is used in a char ('c') format
/// specifier
///
/// </summary>
/// <param name="interp"> - The TclInterp which called the cmdProc method .
/// </param>
 
private static void errorCharFieldWidth( Interp interp )
{
throw new TclException( interp, "field width may not be specified in %c conversion" );
}
}
}
/trunk/TCL/src/commands/SeekCmd.cs
@@ -0,0 +1,99 @@
/*
* SeekCmd.java --
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: SeekCmd.java,v 1.3 2003/03/08 03:42:44 mdejong Exp $
*
*/
using System;
using System.IO;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "seek" command in Tcl.</summary>
 
class SeekCmd : Command
{
 
private static readonly string[] validOrigins = new string[] { "start", "current", "end" };
 
internal const int OPT_START = 0;
internal const int OPT_CURRENT = 1;
internal const int OPT_END = 2;
 
/// <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 ( 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;
}
}
}
/trunk/TCL/src/commands/SetCmd.cs
@@ -0,0 +1,51 @@
#undef DEBUG
/*
* SetCmd.java --
*
* Implements the built-in "set" Tcl command.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: SetCmd.java,v 1.2 1999/05/09 01:23:19 dejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements the built-in "set" command in Tcl.
*/
 
class SetCmd : Command
{
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
bool debug;
 
if ( argv.Length == 2 )
{
System.Diagnostics.Debug.WriteLine( "getting value of \"" + argv[1].ToString() + "\"" );
 
interp.setResult( interp.getVar( argv[1], 0 ) );
}
else if ( argv.Length == 3 )
{
System.Diagnostics.Debug.WriteLine( "setting value of \"" + argv[1].ToString() + "\" to \"" + argv[2].ToString() + "\"" );
interp.setResult( interp.setVar( argv[1], argv[2], 0 ) );
}
else
{
throw new TclNumArgsException( interp, 1, argv, "varName ?newValue?" );
}
return TCL.CompletionCode.RETURN;
}
} // end SetCmd
}
/trunk/TCL/src/commands/SocketChannel.cs
@@ -0,0 +1,134 @@
/*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* SocketChannel.java
*
* Implements a socket channel.
*/
using System;
using System.IO;
namespace tcl.lang
{
 
/// <summary> The SocketChannel class implements a channel object for Socket
/// connections, created using the socket command.
///
/// </summary>
 
public class SocketChannel : Channel
{
public override string ChanType
{
get
{
return "tcp";
}
 
}
override protected internal Stream InputStream
{
get
{
return (Stream)sock.GetStream();
}
 
}
override protected internal Stream OutputStream
{
get
{
return (Stream)sock.GetStream();
}
 
}
 
/// <summary> The java Socket object associated with this Channel
///
/// </summary>
 
private System.Net.Sockets.TcpClient sock;
 
/// <summary> Constructor - creates a new SocketChannel object with the given
/// options. Also creates an underlying Socket object, and Input and
/// Output Streams.
///
/// </summary>
 
public SocketChannel( Interp interp, int mode, string localAddr, int localPort, bool async, string address, int port )
{
System.Net.IPAddress localAddress = null;
System.Net.IPAddress addr = null;
 
if ( async )
throw new TclException( interp, "Asynchronous socket connection not " + "currently implemented" );
 
// Resolve addresses
if ( !localAddr.Equals( "" ) )
{
try
{
localAddress = System.Net.Dns.GetHostByName( localAddr ).AddressList[0];
}
catch ( System.Exception e )
{
throw new TclException( interp, "host unknown: " + localAddr );
}
}
 
try
{
addr = System.Net.Dns.GetHostByName( address ).AddressList[0];
}
catch ( System.Exception e )
{
throw new TclException( interp, "host unknown: " + address );
}
 
 
// Set the mode of this socket.
this.mode = mode;
 
// Create the Socket object
 
// if ((localAddress != null) && (localPort != 0))
// {
//
// sock = new Socket(addr, port, localAddress, localPort);
// }
// else
sock = new System.Net.Sockets.TcpClient( addr.ToString(), port );
 
// If we got this far, then the socket has been created.
// Create the channel name
ChanName = TclIO.getNextDescriptor( interp, "sock" );
}
 
/// <summary> Constructor for making SocketChannel objects from connections
/// made to a ServerSocket.
///
/// </summary>
 
public SocketChannel( Interp interp, System.Net.Sockets.TcpClient s )
{
this.mode = TclIO.RDWR;
this.sock = s;
 
ChanName = TclIO.getNextDescriptor( interp, "sock" );
}
 
/// <summary> Close the SocketChannel.</summary>
 
internal override void close()
{
// Invoke super.close() first since it might write an eof char
try
{
base.close();
}
finally
{
sock.Close();
}
}
}
}
/trunk/TCL/src/commands/SourceCmd.cs
@@ -0,0 +1,103 @@
/*
* SourceCmd.java
*
* Implements the "source" command.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: SourceCmd.java,v 1.1.1.1 1998/10/14 21:09:20 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements the built-in "source" command in Tcl.
*/
 
class SourceCmd : Command
{
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
string fileName = null;
bool url = false;
 
if ( argv.Length == 2 )
{
 
fileName = argv[1].ToString();
}
else if ( argv.Length == 3 )
{
 
if ( argv[1].ToString().Equals( "-url" ) )
{
url = true;
 
fileName = argv[2].ToString();
}
}
 
if ( (System.Object)fileName == null )
{
throw new TclNumArgsException( interp, 1, argv, "?-url? fileName" );
}
 
try
{
if ( url )
{
if ( fileName.StartsWith( "resource:/" ) )
{
interp.evalResource( fileName.Substring( 9 ) );
}
else
{
interp.evalURL( null, fileName );
}
}
else
{
interp.evalFile( fileName );
}
}
catch ( TclException e )
{
TCL.CompletionCode code = e.getCompletionCode();
 
if ( code == TCL.CompletionCode.RETURN )
{
TCL.CompletionCode realCode = interp.updateReturnInfo();
if ( realCode != TCL.CompletionCode.OK )
{
e.setCompletionCode( realCode );
throw;
}
}
else if ( code == TCL.CompletionCode.ERROR )
{
/*
* Record information telling where the error occurred.
*/
 
interp.addErrorInfo( "\n (file line " + interp.errorLine + ")" );
throw;
}
else
{
throw;
}
}
return TCL.CompletionCode.RETURN;
}
} // end SourceCmd
}
/trunk/TCL/src/commands/SplitCmd.cs
@@ -0,0 +1,123 @@
/*
* SplitCmd.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: SplitCmd.java,v 1.1.1.1 1998/10/14 21:09:19 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "split" command in Tcl.</summary>
 
class SplitCmd : Command
{
/// <summary> Default characters for splitting up strings.</summary>
 
private static char[] defSplitChars = new char[] { ' ', '\n', '\t', '\r' };
 
/// <summary> This procedure is invoked to process the "split" Tcl
/// command. See Tcl user documentation for details.
///
/// </summary>
/// <param name="interp">the current interpreter.
/// </param>
/// <param name="argv">command arguments.
/// </param>
/// <exception cref=""> TclException If incorrect number of arguments.
/// </exception>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
char[] splitChars = null;
string inString;
 
if ( argv.Length == 2 )
{
splitChars = defSplitChars;
}
else if ( argv.Length == 3 )
{
 
splitChars = argv[2].ToString().ToCharArray();
}
else
{
throw new TclNumArgsException( interp, 1, argv, "string ?splitChars?" );
}
 
 
inString = argv[1].ToString();
int len = inString.Length;
int num = splitChars.Length;
 
/*
* Handle the special case of splitting on every character.
*/
 
if ( num == 0 )
{
TclObject list = TclList.newInstance();
 
list.preserve();
try
{
for ( int i = 0; i < len; i++ )
{
TclList.append( interp, list, TclString.newInstance( inString[i] ) );
}
interp.setResult( list );
}
finally
{
list.release();
}
return TCL.CompletionCode.RETURN;
}
 
/*
* Normal case: split on any of a given set of characters.
* Discard instances of the split characters.
*/
TclObject list2 = TclList.newInstance();
int elemStart = 0;
 
list2.preserve();
try
{
int i, j;
for ( i = 0; i < len; i++ )
{
char c = inString[i];
for ( j = 0; j < num; j++ )
{
if ( c == splitChars[j] )
{
TclList.append( interp, list2, TclString.newInstance( inString.Substring( elemStart, ( i ) - ( elemStart ) ) ) );
elemStart = i + 1;
break;
}
}
}
if ( i != 0 )
{
TclList.append( interp, list2, TclString.newInstance( inString.Substring( elemStart ) ) );
}
interp.setResult( list2 );
}
finally
{
list2.release();
}
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/StdChannel.cs
@@ -0,0 +1,195 @@
#undef DEBUG
/*
* StdChannel.java --
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: StdChannel.java,v 1.19 2003/03/08 03:42:44 mdejong Exp $
*
*/
using System;
using System.IO;
namespace tcl.lang
{
 
/// <summary> Subclass of the abstract class Channel. It implements all of the
/// methods to perform read, write, open, close, etc on system stdio channels.
/// </summary>
 
public class StdChannel : Channel
{
public override string ChanType
{
get
{
return "tty";
}
 
}
override protected internal Stream InputStream
{
get
{
return null;
// return System.Console.In;
}
 
}
override protected internal Stream OutputStream
{
get
{
throw new System.SystemException( "should never be called" );
}
 
}
 
/// <summary> stdType store which type, of the three below, this StdChannel is.</summary>
 
private int stdType = -1;
 
/// <summary> Flags indicating the type of this StdChannel.</summary>
 
public const int STDIN = 0;
public const int STDOUT = 1;
public const int STDERR = 2;
 
/// <summary> Constructor that does nothing. Open() must be called before
/// any of the subsequent read, write, etc calls can be made.
/// </summary>
 
internal StdChannel()
{
}
 
/// <summary> Constructor that will automatically call open.
///
/// </summary>
/// <param name="stdName">name of the stdio channel; stdin, stderr or stdout.
/// </param>
 
internal StdChannel( string stdName )
{
if ( stdName.Equals( "stdin" ) )
{
open( STDIN );
}
else if ( stdName.Equals( "stdout" ) )
{
open( STDOUT );
}
else if ( stdName.Equals( "stderr" ) )
{
open( STDERR );
}
else
{
throw new TclRuntimeError( "Error: unexpected type for StdChannel" );
}
}
 
 
internal StdChannel( int type )
{
open( type );
}
 
 
/// <summary> Set the channel type to one of the three stdio types. Throw a
/// tclRuntimeEerror if the stdName is not one of the three types. If
/// it is a stdin channel, initialize the "in" data member. Since "in"
/// is static it may have already be initialized, test for this case
/// first. Set the names to fileX, this will be the key in the chanTable
/// hashtable to access this object. Note: it is not put into the hash
/// table in this function. The calling function is responsible for that.
///
/// </summary>
/// <param name="stdName">String that equals stdin, stdout, stderr
/// </param>
/// <returns> The name of the channelId
/// </returns>
 
internal string open( int type )
{
 
switch ( type )
{
 
case STDIN:
mode = TclIO.RDONLY;
Buffering = TclIO.BUFF_LINE;
ChanName = "stdin";
break;
 
case STDOUT:
mode = TclIO.WRONLY;
Buffering = TclIO.BUFF_LINE;
ChanName = "stdout";
break;
 
case STDERR:
mode = TclIO.WRONLY;
Buffering = TclIO.BUFF_NONE;
ChanName = "stderr";
break;
 
default:
throw new System.SystemException( "type does not match one of STDIN, STDOUT, or STDERR" );
 
}
 
stdType = type;
 
return ChanName;
}
 
/// <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();
}
}
}
 
/// <summary> Check for any output that might still need to be flushed
/// when the channel is closed.
/// </summary>
 
internal override void close()
{
if ( stdType == STDOUT )
System.Console.Out.Flush();
base.close();
}
}
}
/trunk/TCL/src/commands/StringCmd.cs
@@ -0,0 +1,1268 @@
/*
* StringCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 Scriptics Corporation.
* Copyright (c) 2000 Christian Krone.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: StringCmd.java,v 1.4 2000/08/20 08:37:47 mo Exp $
*
*/
using System.Text;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "string" command in Tcl.</summary>
 
class StringCmd : Command
{
 
private static readonly string[] options = new string[] { "bytelength", "compare", "equal", "first", "index", "is", "last", "length", "map", "match", "range", "repeat", "replace", "tolower", "toupper", "totitle", "trim", "trimleft", "trimright", "wordend", "wordstart" };
private const int STR_BYTELENGTH = 0;
private const int STR_COMPARE = 1;
private const int STR_EQUAL = 2;
private const int STR_FIRST = 3;
private const int STR_INDEX = 4;
private const int STR_IS = 5;
private const int STR_LAST = 6;
private const int STR_LENGTH = 7;
private const int STR_MAP = 8;
private const int STR_MATCH = 9;
private const int STR_RANGE = 10;
private const int STR_REPEAT = 11;
private const int STR_REPLACE = 12;
private const int STR_TOLOWER = 13;
private const int STR_TOUPPER = 14;
private const int STR_TOTITLE = 15;
private const int STR_TRIM = 16;
private const int STR_TRIMLEFT = 17;
private const int STR_TRIMRIGHT = 18;
private const int STR_WORDEND = 19;
private const int STR_WORDSTART = 20;
 
private static readonly string[] isOptions = new string[] { "alnum", "alpha", "ascii", "control", "boolean", "digit", "double", "false", "graph", "integer", "lower", "print", "punct", "space", "true", "upper", "wideinteger", "wordchar", "xdigit" };
private const int STR_IS_ALNUM = 0;
private const int STR_IS_ALPHA = 1;
private const int STR_IS_ASCII = 2;
private const int STR_IS_CONTROL = 3;
private const int STR_IS_BOOL = 4;
private const int STR_IS_DIGIT = 5;
private const int STR_IS_DOUBLE = 6;
private const int STR_IS_FALSE = 7;
private const int STR_IS_GRAPH = 8;
private const int STR_IS_INT = 9;
private const int STR_IS_LOWER = 10;
private const int STR_IS_PRINT = 11;
private const int STR_IS_PUNCT = 12;
private const int STR_IS_SPACE = 13;
private const int STR_IS_TRUE = 14;
private const int STR_IS_UPPER = 15;
private const int STR_IS_WIDE = 16;
private const int STR_IS_WORD = 17;
private const int STR_IS_XDIGIT = 18;
 
/// <summary> Java's Character class has a many boolean test functions to check
/// the kind of a character (like isLowerCase() or isISOControl()).
/// Unfortunately some are missing (like isPunct() or isPrint()), so
/// here we define bitsets to compare the result of Character.getType().
/// </summary>
 
private static readonly int ALPHA_BITS = ( ( 1 << (byte)System.Globalization.UnicodeCategory.UppercaseLetter ) | ( 1 << (byte)System.Globalization.UnicodeCategory.LowercaseLetter ) | ( 1 << (byte)System.Globalization.UnicodeCategory.TitlecaseLetter ) | ( 1 << (byte)System.Globalization.UnicodeCategory.ModifierLetter ) | ( 1 << (byte)System.Globalization.UnicodeCategory.OtherLetter ) );
private static readonly int PUNCT_BITS = ( ( 1 << (byte)System.Globalization.UnicodeCategory.ConnectorPunctuation ) | ( 1 << (byte)System.Globalization.UnicodeCategory.DashPunctuation ) | ( 1 << (byte)System.Globalization.UnicodeCategory.InitialQuotePunctuation ) | ( 1 << (byte)System.Globalization.UnicodeCategory.FinalQuotePunctuation ) | ( 1 << (byte)System.Globalization.UnicodeCategory.OtherPunctuation ) );
private static readonly int PRINT_BITS = ( ALPHA_BITS | ( 1 << (byte)System.Globalization.UnicodeCategory.DecimalDigitNumber ) | ( 1 << (byte)System.Globalization.UnicodeCategory.SpaceSeparator ) | ( 1 << (byte)System.Globalization.UnicodeCategory.LineSeparator ) | ( 1 << (byte)System.Globalization.UnicodeCategory.ParagraphSeparator ) | ( 1 << (byte)System.Globalization.UnicodeCategory.NonSpacingMark ) | ( 1 << (byte)System.Globalization.UnicodeCategory.EnclosingMark ) | ( 1 << (byte)System.Globalization.UnicodeCategory.SpacingCombiningMark ) | ( 1 << (byte)System.Globalization.UnicodeCategory.LetterNumber ) | ( 1 << (byte)System.Globalization.UnicodeCategory.OtherNumber ) | PUNCT_BITS | ( 1 << (byte)System.Globalization.UnicodeCategory.MathSymbol ) | ( 1 << (byte)System.Globalization.UnicodeCategory.CurrencySymbol ) | ( 1 << (byte)System.Globalization.UnicodeCategory.ModifierSymbol ) | ( 1 << (byte)System.Globalization.UnicodeCategory.OtherSymbol ) );
private static readonly int WORD_BITS = ( ALPHA_BITS | ( 1 << (byte)System.Globalization.UnicodeCategory.DecimalDigitNumber ) | ( 1 << (byte)System.Globalization.UnicodeCategory.ConnectorPunctuation ) );
 
/// <summary>----------------------------------------------------------------------
///
/// Tcl_StringObjCmd -> StringCmd.cmdProc
///
/// This procedure is invoked to process the "string" Tcl command.
/// See the user documentation for details on what it does.
///
/// Results:
/// None.
///
/// Side effects:
/// See the user documentation.
///
/// ----------------------------------------------------------------------
/// </summary>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, objv, "option arg ?arg ...?" );
}
int index = TclIndex.get( interp, objv[1], options, "option", 0 );
 
switch ( index )
{
 
case STR_EQUAL:
case STR_COMPARE:
{
 
if ( objv.Length < 4 || objv.Length > 7 )
{
throw new TclNumArgsException( interp, 2, objv, "?-nocase? ?-length int? string1 string2" );
}
 
bool nocase = false;
int reqlength = -1;
for ( int i = 2; i < objv.Length - 2; i++ )
{
 
string string2 = objv[i].ToString();
int length2 = string2.Length;
if ( ( length2 > 1 ) && "-nocase".StartsWith( string2 ) )
{
nocase = true;
}
else if ( ( length2 > 1 ) && "-length".StartsWith( string2 ) )
{
if ( i + 1 >= objv.Length - 2 )
{
throw new TclNumArgsException( interp, 2, objv, "?-nocase? ?-length int? string1 string2" );
}
reqlength = TclInteger.get( interp, objv[++i] );
}
else
{
throw new TclException( interp, "bad option \"" + string2 + "\": must be -nocase or -length" );
}
}
 
 
string string1 = objv[objv.Length - 2].ToString();
 
string string3 = objv[objv.Length - 1].ToString();
int length1 = string1.Length;
int length3 = string3.Length;
 
// This is the min length IN BYTES of the two strings
 
int length = ( length1 < length3 ) ? length1 : length3;
 
int match;
 
if ( reqlength == 0 )
{
// Anything matches at 0 chars, right?
 
match = 0;
}
else if ( nocase || ( ( reqlength > 0 ) && ( reqlength <= length ) ) )
{
// In Java, strings are always encoded in unicode, so we do
// not need to worry about individual char lengths
 
// Do the reqlength check again, against 0 as well for
// the benfit of nocase
 
if ( ( reqlength > 0 ) && ( reqlength < length ) )
{
length = reqlength;
}
else if ( reqlength < 0 )
{
// The requested length is negative, so we ignore it by
// setting it to the longer of the two lengths.
 
reqlength = ( length1 > length3 ) ? length1 : length3;
}
if ( nocase )
{
string1 = string1.ToLower();
string3 = string3.ToLower();
}
match = System.Globalization.CultureInfo.InvariantCulture.CompareInfo.Compare( string1, 0, length, string3, 0, length, System.Globalization.CompareOptions.Ordinal );
// match = string1.Substring(0, (length) - (0)).CompareTo(string3.Substring(0, (length) - (0)));
 
if ( ( match == 0 ) && ( reqlength > length ) )
{
match = length1 - length3;
}
}
else
{
match = System.Globalization.CultureInfo.InvariantCulture.CompareInfo.Compare( string1, 0, length, string3, 0, length, System.Globalization.CompareOptions.Ordinal );
// ATK match = string1.Substring(0, (length) - (0)).CompareTo(string3.Substring(0, (length) - (0)));
if ( match == 0 )
{
match = length1 - length3;
}
}
 
if ( index == STR_EQUAL )
{
interp.setResult( ( match != 0 ) ? false : true );
}
else
{
interp.setResult( ( ( match > 0 ) ? 1 : ( match < 0 ) ? -1 : 0 ) );
}
break;
}
 
 
case STR_FIRST:
{
if ( objv.Length < 4 || objv.Length > 5 )
{
throw new TclNumArgsException( interp, 2, objv, "subString string ?startIndex?" );
}
 
string string1 = objv[2].ToString();
 
string string2 = objv[3].ToString();
int length2 = string2.Length;
 
int start = 0;
 
if ( objv.Length == 5 )
{
// If a startIndex is specified, we will need to fast
// forward to that point in the string before we think
// about a match.
 
start = Util.getIntForIndex( interp, objv[4], length2 - 1 );
if ( start >= length2 )
{
interp.setResult( -1 );
return TCL.CompletionCode.RETURN;
}
}
 
if ( string1.Length == 0 )
{
interp.setResult( -1 );
}
else
{
 
interp.setResult( string2.IndexOf( string1, start ) );
}
break;
}
 
 
case STR_INDEX:
{
if ( objv.Length != 4 )
{
throw new TclNumArgsException( interp, 2, objv, "string charIndex" );
}
 
 
string string1 = objv[2].ToString();
int length1 = string1.Length;
 
int i = Util.getIntForIndex( interp, objv[3], length1 - 1 );
 
if ( ( i >= 0 ) && ( i < length1 ) )
{
interp.setResult( string1.Substring( i, ( i + 1 ) - ( i ) ) );
}
break;
}
 
 
case STR_IS:
{
if ( objv.Length < 4 || objv.Length > 7 )
{
throw new TclNumArgsException( interp, 2, objv, "class ?-strict? ?-failindex var? str" );
}
index = TclIndex.get( interp, objv[2], isOptions, "class", 0 );
 
bool strict = false;
TclObject failVarObj = null;
 
if ( objv.Length != 4 )
{
for ( int i = 3; i < objv.Length - 1; i++ )
{
 
string string2 = objv[i].ToString();
int length2 = string2.Length;
if ( ( length2 > 1 ) && "-strict".StartsWith( string2 ) )
{
strict = true;
}
else if ( ( length2 > 1 ) && "-failindex".StartsWith( string2 ) )
{
if ( i + 1 >= objv.Length - 1 )
{
throw new TclNumArgsException( interp, 3, objv, "?-strict? ?-failindex var? str" );
}
failVarObj = objv[++i];
}
else
{
throw new TclException( interp, "bad option \"" + string2 + "\": must be -strict or -failindex" );
}
}
}
 
bool result = true;
int failat = 0;
 
// We get the objPtr so that we can short-cut for some classes
// by checking the object type (int and double), but we need
// the string otherwise, because we don't want any conversion
// of type occuring (as, for example, Tcl_Get*FromObj would do
 
TclObject obj = objv[objv.Length - 1];
 
string string1 = obj.ToString();
int length1 = string1.Length;
if ( length1 == 0 )
{
if ( strict )
{
result = false;
}
}
 
switch ( index )
{
 
case STR_IS_BOOL:
case STR_IS_TRUE:
case STR_IS_FALSE:
{
if ( obj.InternalRep is TclBoolean )
{
if ( ( ( index == STR_IS_TRUE ) && !TclBoolean.get( interp, obj ) ) || ( ( index == STR_IS_FALSE ) && TclBoolean.get( interp, obj ) ) )
{
result = false;
}
}
else
{
try
{
bool i = TclBoolean.get( null, obj );
if ( ( ( index == STR_IS_TRUE ) && !i ) || ( ( index == STR_IS_FALSE ) && i ) )
{
result = false;
}
}
catch ( TclException e )
{
result = false;
}
}
break;
}
 
case STR_IS_DOUBLE:
{
if ( ( obj.InternalRep is TclDouble ) || ( obj.InternalRep is TclInteger ) )
{
break;
}
 
// This is adapted from Tcl_GetDouble
//
// The danger in this function is that
// "12345678901234567890" is an acceptable 'double',
// but will later be interp'd as an int by something
// like [expr]. Therefore, we check to see if it looks
// like an int, and if so we do a range check on it.
// If strtoul gets to the end, we know we either
// received an acceptable int, or over/underflow
 
if ( Expression.looksLikeInt( string1, length1, 0 ) )
{
char c = string1[0];
int signIx = ( c == '-' || c == '+' ) ? 1 : 0;
StrtoulResult res = Util.strtoul( string1, signIx, 0 );
if ( res.index == length1 )
{
if ( res.errno == TCL.INTEGER_RANGE )
{
result = false;
failat = -1;
}
break;
}
}
 
char c2 = string1[0];
int signIx2 = ( c2 == '-' || c2 == '+' ) ? 1 : 0;
StrtodResult res2 = Util.strtod( string1, signIx2 );
if ( res2.errno == TCL.DOUBLE_RANGE )
{
// if (errno == ERANGE), then it was an over/underflow
// problem, but in this method, we only want to know
// yes or no, so bad flow returns 0 (false) and sets
// the failVarObj to the string length.
 
result = false;
failat = -1;
}
else if ( res2.index == 0 )
{
// In this case, nothing like a number was found
 
result = false;
failat = 0;
}
else
{
// Go onto SPACE, since we are
// allowed trailing whitespace
 
failat = res2.index;
for ( int i = res2.index; i < length1; i++ )
{
if ( !System.Char.IsWhiteSpace( string1[i] ) )
{
result = false;
break;
}
}
}
break;
}
 
case STR_IS_INT:
{
if ( obj.InternalRep is TclInteger )
{
break;
}
bool isInteger = true;
try
{
TclInteger.get( null, obj );
}
catch ( TclException e )
{
isInteger = false;
}
if ( isInteger )
{
break;
}
 
char c = string1[0];
int signIx = ( c == '-' || c == '+' ) ? 1 : 0;
StrtoulResult res = Util.strtoul( string1, signIx, 0 );
if ( res.errno == TCL.INTEGER_RANGE )
{
// if (errno == ERANGE), then it was an over/underflow
// problem, but in this method, we only want to know
// yes or no, so bad flow returns false and sets
// the failVarObj to the string length.
 
result = false;
failat = -1;
}
else if ( res.index == 0 )
{
// In this case, nothing like a number was found
 
result = false;
failat = 0;
}
else
{
// Go onto SPACE, since we are
// allowed trailing whitespace
 
failat = res.index;
for ( int i = res.index; i < length1; i++ )
{
if ( !System.Char.IsWhiteSpace( string1[i] ) )
{
result = false;
break;
}
}
}
break;
}
 
case STR_IS_WIDE:
{
if ( obj.InternalRep is TclLong )
{
break;
}
bool isInteger = true;
try
{
TclLong.get( null, obj );
}
catch ( TclException e )
{
isInteger = false;
}
if ( isInteger )
{
break;
}
 
char c = string1[0];
int signIx = ( c == '-' || c == '+' ) ? 1 : 0;
StrtoulResult res = Util.strtoul( string1, signIx, 0 );
if ( res.errno == TCL.INTEGER_RANGE )
{
// if (errno == ERANGE), then it was an over/underflow
// problem, but in this method, we only want to know
// yes or no, so bad flow returns false and sets
// the failVarObj to the string length.
 
result = false;
failat = -1;
}
else if ( res.index == 0 )
{
// In this case, nothing like a number was found
 
result = false;
failat = 0;
}
else
{
// Go onto SPACE, since we are
// allowed trailing whitespace
 
failat = res.index;
for ( int i = res.index; i < length1; i++ )
{
if ( !System.Char.IsWhiteSpace( string1[i] ) )
{
result = false;
break;
}
}
}
break;
}
 
default:
{
for ( failat = 0; failat < length1; failat++ )
{
char c = string1[failat];
switch ( index )
{
 
case STR_IS_ASCII:
 
result = c < 0x80;
break;
 
case STR_IS_ALNUM:
result = System.Char.IsLetterOrDigit( c );
break;
 
case STR_IS_ALPHA:
result = System.Char.IsLetter( c );
break;
 
case STR_IS_DIGIT:
result = System.Char.IsDigit( c );
break;
 
case STR_IS_GRAPH:
result = ( ( 1 << (int)System.Char.GetUnicodeCategory( c ) ) & PRINT_BITS ) != 0 && c != ' ';
break;
 
case STR_IS_PRINT:
result = ( ( 1 << (int)System.Char.GetUnicodeCategory( c ) ) & PRINT_BITS ) != 0;
break;
 
case STR_IS_PUNCT:
result = ( ( 1 << (int)System.Char.GetUnicodeCategory( c ) ) & PUNCT_BITS ) != 0;
break;
 
case STR_IS_UPPER:
result = System.Char.IsUpper( c );
break;
 
case STR_IS_SPACE:
result = System.Char.IsWhiteSpace( c );
break;
 
case STR_IS_CONTROL:
result = ( System.Char.GetUnicodeCategory( c ) == System.Globalization.UnicodeCategory.Control );
break;
 
case STR_IS_LOWER:
result = System.Char.IsLower( c );
break;
 
case STR_IS_WORD:
result = ( ( 1 << (int)System.Char.GetUnicodeCategory( c ) ) & WORD_BITS ) != 0;
break;
 
case STR_IS_XDIGIT:
result = "0123456789ABCDEFabcdef".IndexOf( c ) >= 0;
break;
 
default:
throw new TclRuntimeError( "unimplemented" );
 
}
if ( !result )
{
break;
}
}
}
break;
 
}
 
// Only set the failVarObj when we will return 0
// and we have indicated a valid fail index (>= 0)
 
if ( ( !result ) && ( failVarObj != null ) )
{
interp.setVar( failVarObj, TclInteger.newInstance( failat ), 0 );
}
interp.setResult( result );
break;
}
 
 
case STR_LAST:
{
if ( objv.Length < 4 || objv.Length > 5 )
{
throw new TclNumArgsException( interp, 2, objv, "subString string ?startIndex?" );
}
 
string string1 = objv[2].ToString();
 
string string2 = objv[3].ToString();
int length2 = string2.Length;
 
int start = 0;
if ( objv.Length == 5 )
{
// If a startIndex is specified, we will need to fast
// forward to that point in the string before we think
// about a match.
 
start = Util.getIntForIndex( interp, objv[4], length2 - 1 );
if ( start < 0 )
{
interp.setResult( -1 );
break;
}
else if ( start < length2 )
{
string2 = string2.Substring( 0, ( start + 1 ) - ( 0 ) );
}
}
 
if ( string1.Length == 0 )
{
interp.setResult( -1 );
}
else
{
interp.setResult( string2.LastIndexOf( string1 ) );
}
break;
}
 
 
case STR_BYTELENGTH:
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "string" );
}
 
interp.setResult( Utf8Count( objv[2].ToString() ) );
break;
 
 
case STR_LENGTH:
{
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "string" );
}
 
interp.setResult( objv[2].ToString().Length );
break;
}
 
 
case STR_MAP:
{
if ( objv.Length < 4 || objv.Length > 5 )
{
throw new TclNumArgsException( interp, 2, objv, "?-nocase? charMap string" );
}
 
bool nocase = false;
if ( objv.Length == 5 )
{
 
string string2 = objv[2].ToString();
int length2 = string2.Length;
if ( ( length2 > 1 ) && "-nocase".StartsWith( string2 ) )
{
nocase = true;
}
else
{
throw new TclException( interp, "bad option \"" + string2 + "\": must be -nocase" );
}
}
 
TclObject[] mapElemv = TclList.getElements( interp, objv[objv.Length - 2] );
if ( mapElemv.Length == 0 )
{
// empty charMap, just return whatever string was given
 
interp.setResult( objv[objv.Length - 1] );
}
else if ( ( mapElemv.Length % 2 ) != 0 )
{
// The charMap must be an even number of key/value items
 
throw new TclException( interp, "char map list unbalanced" );
}
 
string string1 = objv[objv.Length - 1].ToString();
string cmpString1;
if ( nocase )
{
cmpString1 = string1.ToLower();
}
else
{
cmpString1 = string1;
}
int length1 = string1.Length;
if ( length1 == 0 )
{
// Empty input string, just stop now
 
break;
}
 
// Precompute pointers to the unicode string and length.
// This saves us repeated function calls later,
// significantly speeding up the algorithm.
 
string[] mapStrings = new string[mapElemv.Length];
int[] mapLens = new int[mapElemv.Length];
for ( int ix = 0; ix < mapElemv.Length; ix++ )
{
 
mapStrings[ix] = mapElemv[ix].ToString();
mapLens[ix] = mapStrings[ix].Length;
}
string[] cmpStrings;
if ( nocase )
{
cmpStrings = new string[mapStrings.Length];
for ( int ix = 0; ix < mapStrings.Length; ix++ )
{
cmpStrings[ix] = mapStrings[ix].ToLower();
}
}
else
{
cmpStrings = mapStrings;
}
 
TclObject result = TclString.newInstance( "" );
int p, str1;
for ( p = 0, str1 = 0; str1 < length1; str1++ )
{
for ( index = 0; index < mapStrings.Length; index += 2 )
{
// Get the key string to match on
 
string string2 = mapStrings[index];
int length2 = mapLens[index];
if ( ( length2 > 0 ) && ( cmpString1.Substring( str1 ).StartsWith( cmpStrings[index] ) ) )
{
if ( p != str1 )
{
// Put the skipped chars onto the result first
 
TclString.append( result, string1.Substring( p, ( str1 ) - ( p ) ) );
p = str1 + length2;
}
else
{
p += length2;
}
 
// Adjust len to be full length of matched string
 
str1 = p - 1;
 
// Append the map value to the unicode string
 
TclString.append( result, mapStrings[index + 1] );
break;
}
}
}
 
if ( p != str1 )
{
// Put the rest of the unmapped chars onto result
 
TclString.append( result, string1.Substring( p, ( str1 ) - ( p ) ) );
}
interp.setResult( result );
break;
}
 
 
case STR_MATCH:
{
if ( objv.Length < 4 || objv.Length > 5 )
{
throw new TclNumArgsException( interp, 2, objv, "?-nocase? pattern string" );
}
 
string string1, string2;
if ( objv.Length == 5 )
{
 
string inString = objv[2].ToString();
if ( !( ( inString.Length > 1 ) && "-nocase".StartsWith( inString ) ) )
{
throw new TclException( interp, "bad option \"" + inString + "\": must be -nocase" );
}
 
string1 = objv[4].ToString().ToLower();
 
string2 = objv[3].ToString().ToLower();
}
else
{
 
string1 = objv[3].ToString();
 
string2 = objv[2].ToString();
}
 
interp.setResult( Util.stringMatch( string1, string2 ) );
break;
}
 
 
case STR_RANGE:
{
if ( objv.Length != 5 )
{
throw new TclNumArgsException( interp, 2, objv, "string first last" );
}
 
 
string string1 = objv[2].ToString();
int length1 = string1.Length;
 
int first = Util.getIntForIndex( interp, objv[3], length1 - 1 );
if ( first < 0 )
{
first = 0;
}
int last = Util.getIntForIndex( interp, objv[4], length1 - 1 );
if ( last >= length1 )
{
last = length1 - 1;
}
 
if ( first > last )
{
interp.resetResult();
}
else
{
interp.setResult( string1.Substring( first, ( last + 1 ) - ( first ) ) );
}
break;
}
 
 
case STR_REPEAT:
{
if ( objv.Length != 4 )
{
throw new TclNumArgsException( interp, 2, objv, "string count" );
}
 
int count = TclInteger.get( interp, objv[3] );
 
 
string string1 = objv[2].ToString();
if ( string1.Length > 0 )
{
TclObject tstr = TclString.newInstance( "" );
for ( index = 0; index < count; index++ )
{
TclString.append( tstr, string1 );
}
interp.setResult( tstr );
}
break;
}
 
 
case STR_REPLACE:
{
if ( objv.Length < 5 || objv.Length > 6 )
{
throw new TclNumArgsException( interp, 2, objv, "string first last ?string?" );
}
 
 
string string1 = objv[2].ToString();
int length1 = string1.Length - 1;
 
int first = Util.getIntForIndex( interp, objv[3], length1 );
int last = Util.getIntForIndex( interp, objv[4], length1 );
 
if ( ( last < first ) || ( first > length1 ) || ( last < 0 ) )
{
interp.setResult( objv[2] );
}
else
{
if ( first < 0 )
{
first = 0;
}
string start = string1.Substring( first );
int ind = ( ( last > length1 ) ? length1 : last ) - first + 1;
string end;
if ( ind <= 0 )
{
end = start;
}
else if ( ind >= start.Length )
{
end = "";
}
else
{
end = start.Substring( ind );
}
 
TclObject tstr = TclString.newInstance( string1.Substring( 0, ( first ) - ( 0 ) ) );
 
if ( objv.Length == 6 )
{
TclString.append( tstr, objv[5] );
}
if ( last < length1 )
{
TclString.append( tstr, end );
}
 
interp.setResult( tstr );
}
break;
}
 
 
case STR_TOLOWER:
case STR_TOUPPER:
case STR_TOTITLE:
{
if ( objv.Length < 3 || objv.Length > 5 )
{
throw new TclNumArgsException( interp, 2, objv, "string ?first? ?last?" );
}
 
string string1 = objv[2].ToString();
 
if ( objv.Length == 3 )
{
if ( index == STR_TOLOWER )
{
interp.setResult( string1.ToLower() );
}
else if ( index == STR_TOUPPER )
{
interp.setResult( string1.ToUpper() );
}
else
{
interp.setResult( Util.toTitle( string1 ) );
}
}
else
{
int length1 = string1.Length - 1;
int first = Util.getIntForIndex( interp, objv[3], length1 );
if ( first < 0 )
{
first = 0;
}
int last = first;
if ( objv.Length == 5 )
{
last = Util.getIntForIndex( interp, objv[4], length1 );
}
if ( last >= length1 )
{
last = length1;
}
if ( last < first )
{
interp.setResult( objv[2] );
break;
}
 
string string2;
StringBuilder buf = new StringBuilder();
buf.Append( string1.Substring( 0, ( first ) - ( 0 ) ) );
if ( last + 1 > length1 )
{
string2 = string1.Substring( first );
}
else
{
string2 = string1.Substring( first, ( last + 1 ) - ( first ) );
}
if ( index == STR_TOLOWER )
{
buf.Append( string2.ToLower() );
}
else if ( index == STR_TOUPPER )
{
buf.Append( string2.ToUpper() );
}
else
{
buf.Append( Util.toTitle( string2 ) );
}
if ( last + 1 <= length1 )
{
buf.Append( string1.Substring( last + 1 ) );
}
 
interp.setResult( buf.ToString() );
}
break;
}
 
 
case STR_TRIM:
{
if ( objv.Length == 3 )
{
// Case 1: "string trim str" --
// Remove leading and trailing white space
 
 
interp.setResult( objv[2].ToString().Trim() );
}
else if ( objv.Length == 4 )
{
 
// Case 2: "string trim str chars" --
// Remove leading and trailing chars in the chars set
 
 
string tmp = Util.TrimLeft( objv[2].ToString(), objv[3].ToString() );
 
interp.setResult( Util.TrimRight( tmp, objv[3].ToString() ) );
}
else
{
// Case 3: Wrong # of args
 
throw new TclNumArgsException( interp, 2, objv, "string ?chars?" );
}
break;
}
 
 
case STR_TRIMLEFT:
{
if ( objv.Length == 3 )
{
// Case 1: "string trimleft str" --
// Remove leading and trailing white space
 
 
interp.setResult( Util.TrimLeft( objv[2].ToString() ) );
}
else if ( objv.Length == 4 )
{
// Case 2: "string trimleft str chars" --
// Remove leading and trailing chars in the chars set
 
 
interp.setResult( Util.TrimLeft( objv[2].ToString(), objv[3].ToString() ) );
}
else
{
// Case 3: Wrong # of args
 
throw new TclNumArgsException( interp, 2, objv, "string ?chars?" );
}
break;
}
 
 
case STR_TRIMRIGHT:
{
if ( objv.Length == 3 )
{
// Case 1: "string trimright str" --
// Remove leading and trailing white space
 
 
interp.setResult( Util.TrimRight( objv[2].ToString() ) );
}
else if ( objv.Length == 4 )
{
// Case 2: "string trimright str chars" --
// Remove leading and trailing chars in the chars set
 
 
interp.setResult( Util.TrimRight( objv[2].ToString(), objv[3].ToString() ) );
}
else
{
// Case 3: Wrong # of args
 
throw new TclNumArgsException( interp, 2, objv, "string ?chars?" );
}
break;
}
 
 
case STR_WORDEND:
{
if ( objv.Length != 4 )
{
throw new TclNumArgsException( interp, 2, objv, "string index" );
}
 
 
string string1 = objv[2].ToString();
char[] strArray = string1.ToCharArray();
int cur;
int length1 = string1.Length;
index = Util.getIntForIndex( interp, objv[3], length1 - 1 );
 
if ( index < 0 )
{
index = 0;
}
if ( index >= length1 )
{
interp.setResult( length1 );
return TCL.CompletionCode.RETURN;
}
for ( cur = index; cur < length1; cur++ )
{
char c = strArray[cur];
if ( ( ( 1 << (int)System.Char.GetUnicodeCategory( c ) ) & WORD_BITS ) == 0 )
{
break;
}
}
if ( cur == index )
{
cur = index + 1;
}
interp.setResult( cur );
break;
}
 
 
case STR_WORDSTART:
{
if ( objv.Length != 4 )
{
throw new TclNumArgsException( interp, 2, objv, "string index" );
}
 
 
string string1 = objv[2].ToString();
char[] strArray = string1.ToCharArray();
int cur;
int length1 = string1.Length;
index = Util.getIntForIndex( interp, objv[3], length1 - 1 );
 
if ( index > length1 )
{
index = length1 - 1;
}
if ( index < 0 )
{
interp.setResult( 0 );
return TCL.CompletionCode.RETURN;
}
for ( cur = index; cur >= 0; cur-- )
{
char c = strArray[cur];
if ( ( ( 1 << (int)System.Char.GetUnicodeCategory( c ) ) & WORD_BITS ) == 0 )
{
break;
}
}
if ( cur != index )
{
cur += 1;
}
interp.setResult( cur );
break;
}
}
return TCL.CompletionCode.RETURN;
}
 
// return the number of Utf8 bytes that would be needed to store s
 
private int Utf8Count( string s )
{
int p = 0;
int len = s.Length;
char c;
int sum = 0;
 
while ( p < len )
{
c = s[p++];
 
if ( ( c > 0 ) && ( c < 0x80 ) )
{
sum += 1;
continue;
}
if ( c <= 0x7FF )
{
sum += 2;
continue;
}
if ( c <= 0xFFFF )
{
sum += 3;
continue;
}
}
 
return sum;
}
} // end StringCmd
}
/trunk/TCL/src/commands/StrtodResult.cs
@@ -0,0 +1,57 @@
/*
* StrtodResult.java --
*
* Stores the result of the Util.strtod() method.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: StrtodResult.java,v 1.1.1.1 1998/10/14 21:09:21 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class stores the result of the Util.strtod() method.
*/
 
class StrtodResult
{
 
/*
* If the conversion is successful, errno = 0;
*
* If the number cannot be converted to a valid unsigned 32-bit integer,
* contains the error code (TCL.DOUBLE_RANGE or TCL.UNVALID_DOUBLE).
*/
 
internal int errno;
 
/*
* If errno is 0, points to the character right after the number
*/
 
internal int index;
 
/*
* If errno is 0, contains the value of the number.
*/
 
internal double value;
 
internal StrtodResult( double v, int i, int e )
{
value = v;
index = i;
errno = e;
}
} // end StrtodResult
}
/trunk/TCL/src/commands/StrtoulResult.cs
@@ -0,0 +1,49 @@
/*
* StrtoulResult.java
*
* Stores the result of the Util.strtoul() method.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: StrtoulResult.java,v 1.2 1999/05/09 01:30:54 dejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class stores the result of the Util.strtoul() method.</summary>
 
class StrtoulResult
{
 
// If the conversion is successful, errno = 0;
//
// If the number cannot be converted to a valid unsigned 32-bit integer,
// contains the error code (TCL.INTEGER_RANGE or TCL.INVALID_INTEGER).
 
internal int errno;
 
// If errno is 0, points to the character right after the number
 
internal int index;
 
// If errno is 0, contains the value of the number.
 
internal long value;
 
internal StrtoulResult( long v, int i, int e )
{
value = v;
index = i;
errno = e;
}
} // end StrtoulResult
}
/trunk/TCL/src/commands/SubstCmd.cs
@@ -0,0 +1,158 @@
/*
* SubstCmd.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: SubstCmd.java,v 1.3 2003/01/09 02:15:39 mdejong Exp $
*
*/
using System.Text;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "subst" command in Tcl.</summary>
 
class SubstCmd : Command
{
private static readonly string[] validCmds = new string[] { "-nobackslashes", "-nocommands", "-novariables" };
 
internal const int OPT_NOBACKSLASHES = 0;
internal const int OPT_NOCOMMANDS = 1;
internal const int OPT_NOVARS = 2;
 
/// <summary> This procedure is invoked to process the "subst" 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 wrong # of args or invalid argument(s).
/// </exception>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
int currentObjIndex, len, i;
int objc = argv.Length - 1;
bool doBackslashes = true;
bool doCmds = true;
bool doVars = true;
StringBuilder result = new StringBuilder();
string s;
char c;
 
for ( currentObjIndex = 1; currentObjIndex < objc; currentObjIndex++ )
{
 
if ( !argv[currentObjIndex].ToString().StartsWith( "-" ) )
{
break;
}
int opt = TclIndex.get( interp, argv[currentObjIndex], validCmds, "switch", 0 );
switch ( opt )
{
 
case OPT_NOBACKSLASHES:
doBackslashes = false;
break;
 
case OPT_NOCOMMANDS:
doCmds = false;
break;
 
case OPT_NOVARS:
doVars = false;
break;
 
default:
throw new TclException( interp, "SubstCmd.cmdProc: bad option " + opt + " index to cmds" );
 
}
}
if ( currentObjIndex != objc )
{
throw new TclNumArgsException( interp, currentObjIndex, argv, "?-nobackslashes? ?-nocommands? ?-novariables? string" );
}
 
/*
* Scan through the string one character at a time, performing
* command, variable, and backslash substitutions.
*/
 
 
s = argv[currentObjIndex].ToString();
len = s.Length;
i = 0;
while ( i < len )
{
c = s[i];
 
if ( ( c == '[' ) && doCmds )
{
ParseResult res;
try
{
interp.evalFlags = Parser.TCL_BRACKET_TERM;
interp.eval( s.Substring( i + 1, ( len ) - ( i + 1 ) ) );
TclObject interp_result = interp.getResult();
interp_result.preserve();
res = new ParseResult( interp_result, i + interp.termOffset );
}
catch ( TclException e )
{
i = e.errIndex + 1;
throw;
}
i = res.nextIndex + 2;
 
result.Append( res.value.ToString() );
res.release();
}
else if ( c == '\r' )
{
/*
* (ToDo) may not be portable on Mac
*/
 
i++;
}
else if ( ( c == '$' ) && doVars )
{
ParseResult vres = Parser.parseVar( interp, s.Substring( i, ( len ) - ( i ) ) );
i += vres.nextIndex;
 
result.Append( vres.value.ToString() );
vres.release();
}
else if ( ( c == '\\' ) && doBackslashes )
{
BackSlashResult bs = tcl.lang.Interp.backslash( s, i, len );
i = bs.nextIndex;
if ( bs.isWordSep )
{
break;
}
else
{
result.Append( bs.c );
}
}
else
{
result.Append( c );
i++;
}
}
 
interp.setResult( result.ToString() );
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/SwitchCmd.cs
@@ -0,0 +1,158 @@
/*
* SwitchCmd.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: SwitchCmd.java,v 1.2 1999/05/09 01:32:03 dejong Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "switch" command in Tcl.</summary>
 
class SwitchCmd : Command
{
 
private static readonly string[] validCmds = new string[] { "-exact", "-glob", "-regexp", "--" };
private const int EXACT = 0;
private const int GLOB = 1;
private const int REGEXP = 2;
private const int LAST = 3;
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
int i, mode, body;
bool matched;
string inString;
TclObject[] switchArgv = null;
 
mode = EXACT;
for ( i = 1; i < argv.Length; i++ )
{
 
if ( !argv[i].ToString().StartsWith( "-" ) )
{
break;
}
int opt = TclIndex.get( interp, argv[i], validCmds, "option", 1 );
if ( opt == LAST )
{
i++;
break;
}
else if ( opt > LAST )
{
throw new TclException( interp, "SwitchCmd.cmdProc: bad option " + opt + " index to validCmds" );
}
else
{
mode = opt;
}
}
 
if ( argv.Length - i < 2 )
{
throw new TclNumArgsException( interp, 1, argv, "?switches? string pattern body ... ?default body?" );
}
 
inString = argv[i].ToString();
i++;
 
// If all of the pattern/command pairs are lumped into a single
// argument, split them out again.
 
if ( argv.Length - i == 1 )
{
switchArgv = TclList.getElements( interp, argv[i] );
i = 0;
}
else
{
switchArgv = argv;
}
 
for ( ; i < switchArgv.Length; i += 2 )
{
if ( i == ( switchArgv.Length - 1 ) )
{
throw new TclException( interp, "extra switch pattern with no body" );
}
 
// See if the pattern matches the string.
 
matched = false;
 
string pattern = switchArgv[i].ToString();
 
if ( ( i == switchArgv.Length - 2 ) && pattern.Equals( "default" ) )
{
matched = true;
}
else
{
switch ( mode )
{
 
case EXACT:
matched = inString.Equals( pattern );
break;
 
case GLOB:
matched = Util.stringMatch( inString, pattern );
break;
 
case REGEXP:
matched = Util.regExpMatch( interp, inString, switchArgv[i] );
break;
}
}
if ( !matched )
{
continue;
}
 
// We've got a match. Find a body to execute, skipping bodies
// that are "-".
 
for ( body = i + 1; ; body += 2 )
{
if ( body >= switchArgv.Length )
{
 
throw new TclException( interp, "no body specified for pattern \"" + switchArgv[i] + "\"" );
}
 
if ( !switchArgv[body].ToString().Equals( "-" ) )
{
break;
}
}
 
try
{
interp.eval( switchArgv[body], 0 );
return TCL.CompletionCode.RETURN;
}
catch ( TclException e )
{
if ( e.getCompletionCode() == TCL.CompletionCode.ERROR )
{
 
interp.addErrorInfo( "\n (\"" + switchArgv[i] + "\" arm line " + interp.errorLine + ")" );
}
throw;
}
}
 
// Nothing matched: return nothing.
return TCL.CompletionCode.RETURN;
}
} // end SwitchCmd
}
/trunk/TCL/src/commands/TellCmd.cs
@@ -0,0 +1,63 @@
/*
* TellCmd.java --
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TellCmd.java,v 1.1.1.1 1998/10/14 21:09:20 cvsadmin Exp $
*
*/
using System;
using System.IO;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "tell" command in Tcl.</summary>
 
class TellCmd : Command
{
 
/// <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;
}
}
}
/trunk/TCL/src/commands/TimeCmd.cs
@@ -0,0 +1,61 @@
/*
* TimeCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TimeCmd.java,v 1.1.1.1 1998/10/14 21:09:18 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "time" command in Tcl.</summary>
 
class TimeCmd : Command
{
/// <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;
}
}
}
/trunk/TCL/src/commands/TraceCmd.cs
@@ -0,0 +1,291 @@
/*
* TraceCmd.java --
*
* This file implements the Tcl "trace" command.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TraceCmd.java,v 1.6 1999/08/15 19:38:36 mo Exp $
*
*/
using System.Collections;
using System.Text;
 
namespace tcl.lang
{
 
/// <summary> The TraceCmd class implements the Command interface for specifying
/// a new Tcl command. The method cmdProc implements the built-in Tcl
/// command "trace" which is used to manupilate variable traces. See
/// user documentation for more details.
/// </summary>
 
class TraceCmd : Command
{
 
// Valid sub-commands for the trace command.
 
private static readonly string[] validCmds = new string[] { "variable", "vdelete", "vinfo" };
 
private const int OPT_VARIABLE = 0;
private const int OPT_VDELETE = 1;
private const int OPT_VINFO = 2;
 
// An array for quickly generating the Tcl strings corresponding to
// the TCL.VarFlag.TRACE_READS, TCL.VarFlag.TRACE_WRITES and TCL.VarFlag.TRACE_UNSETS flags.
 
private static TclObject[] opStr;
 
/*
*----------------------------------------------------------------------
*
* initOptStr --
*
* This static method is called when the TraceCmd class is loaded
* into the VM. It initializes the opStr array.
*
* Results:
* Initial value for opStr.
*
* Side effects:
* The TclObjects stored in opStr are preserve()'ed.
*
*----------------------------------------------------------------------
*/
 
private static TclObject[] initOptStr()
{
TclObject[] strings = new TclObject[8];
strings[0] = TclString.newInstance( "error" );
strings[1] = TclString.newInstance( "r" );
strings[2] = TclString.newInstance( "w" );
strings[3] = TclString.newInstance( "rw" );
strings[4] = TclString.newInstance( "u" );
strings[5] = TclString.newInstance( "ru" );
strings[6] = TclString.newInstance( "wu" );
strings[7] = TclString.newInstance( "rwu" );
 
for ( int i = 0; i < 8; i++ )
{
strings[i].preserve();
}
 
return strings;
}
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
int len;
 
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, objv, "option [arg arg ...]" );
}
int opt = TclIndex.get( interp, objv[1], validCmds, "option", 0 );
 
switch ( opt )
{
 
case OPT_VARIABLE:
case OPT_VDELETE:
if ( objv.Length != 5 )
{
if ( opt == OPT_VARIABLE )
{
throw new TclNumArgsException( interp, 1, objv, "variable name ops command" );
}
else
{
throw new TclNumArgsException( interp, 1, objv, "vdelete name ops command" );
}
}
 
TCL.VarFlag flags = 0;
 
string ops = objv[3].ToString();
len = ops.Length;
{
for ( int i = 0; i < len; i++ )
{
switch ( ops[i] )
{
 
case 'r':
flags |= TCL.VarFlag.TRACE_READS;
break;
 
case 'w':
flags |= TCL.VarFlag.TRACE_WRITES;
break;
 
case 'u':
flags |= TCL.VarFlag.TRACE_UNSETS;
break;
 
default:
flags = 0;
goto check_ops_brk;
 
}
}
}
 
check_ops_brk:
;
 
 
if ( flags == 0 )
{
 
throw new TclException( interp, "bad operations \"" + objv[3] + "\": should be one or more of rwu" );
}
 
if ( opt == OPT_VARIABLE )
{
 
CmdTraceProc trace = new CmdTraceProc( objv[4].ToString(), flags );
Var.traceVar( interp, objv[2], flags, trace );
}
else
{
// Search through all of our traces on this variable to
// see if there's one with the given command. If so, then
// delete the first one that matches.
 
 
ArrayList traces = Var.getTraces( interp, objv[2].ToString(), 0 );
if ( traces != null )
{
len = traces.Count;
for ( int i = 0; i < len; i++ )
{
TraceRecord rec = (TraceRecord)traces[i];
 
if ( rec.trace is CmdTraceProc )
{
CmdTraceProc proc = (CmdTraceProc)rec.trace;
 
if ( proc.flags == flags && proc.command.ToString().Equals( objv[4].ToString() ) )
{
Var.untraceVar( interp, objv[2], flags, proc );
break;
}
}
}
}
}
break;
 
 
case OPT_VINFO:
if ( objv.Length != 3 )
{
throw new TclNumArgsException( interp, 2, objv, "name" );
}
 
ArrayList traces2 = Var.getTraces( interp, objv[2].ToString(), 0 );
if ( traces2 != null )
{
len = traces2.Count;
TclObject list = TclList.newInstance();
TclObject cmd = null;
list.preserve();
 
try
{
for ( int i = 0; i < len; i++ )
{
TraceRecord rec = (TraceRecord)traces2[i];
 
if ( rec.trace is CmdTraceProc )
{
CmdTraceProc proc = (CmdTraceProc)rec.trace;
TCL.VarFlag mode = proc.flags;
mode &= ( TCL.VarFlag.TRACE_READS | TCL.VarFlag.TRACE_WRITES | TCL.VarFlag.TRACE_UNSETS );
int modeInt = (int)mode;
modeInt /= ( (int)TCL.VarFlag.TRACE_READS );
 
cmd = TclList.newInstance();
TclList.append( interp, cmd, opStr[modeInt] );
TclList.append( interp, cmd, TclString.newInstance( proc.command ) );
TclList.append( interp, list, cmd );
}
}
interp.setResult( list );
}
finally
{
list.release();
}
}
break;
}
return TCL.CompletionCode.RETURN;
}
static TraceCmd()
{
opStr = initOptStr();
}
} // TraceCmd
class CmdTraceProc : VarTrace
{
 
// The command holds the Tcl script that will execute. The flags
// hold the mode flags that define what conditions to fire under.
 
internal string command;
internal TCL.VarFlag flags;
 
internal CmdTraceProc( string cmd, TCL.VarFlag newFlags )
{
flags = newFlags;
command = cmd;
}
public void traceProc( Interp interp, string part1, string part2, TCL.VarFlag flags )
{
if ( ( ( this.flags & flags ) != 0 ) && ( ( flags & TCL.VarFlag.INTERP_DESTROYED ) == 0 ) )
{
StringBuilder sbuf = new StringBuilder( command );
 
try
{
Util.appendElement( interp, sbuf, part1 );
if ( (System.Object)part2 != null )
{
Util.appendElement( interp, sbuf, part2 );
}
else
{
Util.appendElement( interp, sbuf, "" );
}
 
if ( ( flags & TCL.VarFlag.TRACE_READS ) != 0 )
{
Util.appendElement( interp, sbuf, "r" );
}
else if ( ( flags & TCL.VarFlag.TRACE_WRITES ) != 0 )
{
Util.appendElement( interp, sbuf, "w" );
}
else if ( ( flags & TCL.VarFlag.TRACE_UNSETS ) != 0 )
{
Util.appendElement( interp, sbuf, "u" );
}
}
catch ( TclException e )
{
throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
}
 
// Execute the command.
 
interp.eval( sbuf.ToString(), 0 );
}
}
} // CmdTraceProc
}
/trunk/TCL/src/commands/UnsetCmd.cs
@@ -0,0 +1,57 @@
/*
* UnsetCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: UnsetCmd.java,v 1.2 1999/07/28 03:28:52 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "unset" command in Tcl.</summary>
 
class UnsetCmd : Command
{
/// <summary> Tcl_UnsetObjCmd -> UnsetCmd.cmdProc
///
/// Unsets Tcl variable (s). See Tcl user documentation * for
/// details.
/// </summary>
/// <exception cref=""> TclException If tries to unset a variable that does
/// not exist.
/// </exception>
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
switch ( objv.Length )
{
case 2:
interp.unsetVar( objv[1], 0 );
break;
case 3:
for ( int i = ( objv[1].ToString() != "-nocomplain" ) ? 1 : 2; i < objv.Length; i++ )
{
Var.unsetVar( interp, objv[i].ToString(), 0 );
}
break;
default:
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, objv, "varName ?varName ...?" );
}
break;
}
 
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/UpdateCmd.cs
@@ -0,0 +1,74 @@
/*
* UpdateCmd.java --
*
* Implements the "update" command.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: UpdateCmd.java,v 1.1.1.1 1998/10/14 21:09:19 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements the built-in "update" command in Tcl.
*/
 
class UpdateCmd : Command
{
 
/*
* Valid command options.
*/
 
private static readonly string[] validOpts = new string[] { "idletasks" };
 
internal const int OPT_IDLETASKS = 0;
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] argv )
{
int flags;
 
if ( argv.Length == 1 )
{
flags = TCL.ALL_EVENTS | TCL.DONT_WAIT;
}
else if ( argv.Length == 2 )
{
TclIndex.get( interp, argv[1], validOpts, "option", 0 );
 
/*
* Since we just have one valid option, if the above call returns
* without an exception, we've got "idletasks" (or abreviations).
*/
 
flags = TCL.IDLE_EVENTS | TCL.DONT_WAIT;
}
else
{
throw new TclNumArgsException( interp, 1, argv, "?idletasks?" );
}
 
while ( interp.getNotifier().doOneEvent( flags ) != 0 )
{
/* Empty loop body */
}
 
/*
* Must clear the interpreter's result because event handlers could
* have executed commands.
*/
 
interp.resetResult();
return TCL.CompletionCode.RETURN;
}
} // end UpdateCmd
}
/trunk/TCL/src/commands/UplevelCmd.cs
@@ -0,0 +1,96 @@
/*
* UplevelCmd.java --
*
* Implements the "uplevel" command.
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: UplevelCmd.java,v 1.3 1999/07/12 02:38:53 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements the built-in "uplevel" command in Tcl.
*/
 
class UplevelCmd : Command
{
 
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
string optLevel;
int result;
CallFrame savedVarFrame, frame;
int objc = objv.Length;
int objv_index;
TclObject cmd;
 
if ( objv.Length < 2 )
{
throw new TclNumArgsException( interp, 1, objv, "?level? command ?arg ...?" );
}
 
// Find the level to use for executing the command.
 
 
optLevel = objv[1].ToString();
// Java does not support passing a reference by refernece so use an array
CallFrame[] frameArr = new CallFrame[1];
result = CallFrame.getFrame( interp, optLevel, frameArr );
frame = frameArr[0];
 
objc -= ( result + 1 );
if ( objc == 0 )
{
throw new TclNumArgsException( interp, 1, objv, "?level? command ?arg ...?" );
}
objv_index = ( result + 1 );
 
// Modify the interpreter state to execute in the given frame.
 
savedVarFrame = interp.varFrame;
interp.varFrame = frame;
 
// Execute the residual arguments as a command.
 
if ( objc == 1 )
{
cmd = objv[objv_index];
}
else
{
cmd = TclString.newInstance( Util.concat( objv_index, objv.Length - 1, objv ) );
}
cmd.preserve();
 
try
{
interp.eval( cmd, 0 );
}
catch ( TclException e )
{
if ( e.getCompletionCode() == TCL.CompletionCode.ERROR )
{
interp.addErrorInfo( "\n (\"uplevel\" body line " + interp.errorLine + ")" );
}
throw;
}
finally
{
interp.varFrame = savedVarFrame;
cmd.release();
}
return TCL.CompletionCode.RETURN;
}
} // end UplevelCmd
}
/trunk/TCL/src/commands/UpvarCmd.cs
@@ -0,0 +1,88 @@
/*
* UpvarCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: UpvarCmd.java,v 1.3 1999/07/12 02:38:53 mo Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "upvar" command in Tcl.</summary>
 
class UpvarCmd : Command
{
/// <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;
}
}
}
/trunk/TCL/src/commands/VariableCmd.cs
@@ -0,0 +1,116 @@
/*
* VariableCmd.java
*
* Copyright (c) 1987-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 1999 by Moses DeJong.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: VariableCmd.java,v 1.3 1999/06/30 00:13:39 mo Exp $
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "variable" command in Tcl.</summary>
 
class VariableCmd : Command
{
public TCL.CompletionCode cmdProc( Interp interp, TclObject[] objv )
{
 
 
string varName;
int tail, cp;
Var var, array;
TclObject varValue;
int i;
 
for ( i = 1; i < objv.Length; i = i + 2 )
{
// Look up each variable in the current namespace context, creating
// it if necessary.
 
 
varName = objv[i].ToString();
Var[] result = Var.lookupVar( interp, varName, null, ( TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.LEAVE_ERR_MSG ), "define", true, false );
if ( result == null )
{
// FIXME:
throw new TclException( interp, "" );
}
 
var = result[0];
array = result[1];
 
// Mark the variable as a namespace variable and increment its
// reference count so that it will persist until its namespace is
// destroyed or until the variable is unset.
 
if ( ( var.flags & VarFlags.NAMESPACE_VAR ) == 0 )
{
var.flags |= VarFlags.NAMESPACE_VAR;
var.refCount++;
}
 
// If a value was specified, set the variable to that value.
// Otherwise, if the variable is new, leave it undefined.
// (If the variable already exists and no value was specified,
// leave its value unchanged; just create the local link if
// we're in a Tcl procedure).
 
if ( i + 1 < objv.Length )
{
// a value was specified
varValue = Var.setVar( interp, objv[i], null, objv[i + 1], ( TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.LEAVE_ERR_MSG ) );
 
if ( varValue == null )
{
// FIXME:
throw new TclException( interp, "" );
}
}
 
 
 
// If we are executing inside a Tcl procedure, create a local
// variable linked to the new namespace variable "varName".
 
if ( ( interp.varFrame != null ) && interp.varFrame.isProcCallFrame )
{
 
// varName might have a scope qualifier, but the name for the
// local "link" variable must be the simple name at the tail.
//
// Locate tail in one pass: drop any prefix after two *or more*
// consecutive ":" characters).
 
int len = varName.Length;
 
for ( tail = cp = 0; cp < len; )
{
if ( varName[cp++] == ':' )
{
while ( ( cp < len ) && ( varName[cp++] == ':' ) )
{
tail = cp;
}
}
}
 
// Create a local link "tail" to the variable "varName" in the
// current namespace.
 
Var.makeUpvar( interp, null, varName, null, TCL.VarFlag.NAMESPACE_ONLY, varName.Substring( tail ), 0 );
}
}
return TCL.CompletionCode.RETURN;
}
}
}
/trunk/TCL/src/commands/VwaitCmd.cs
@@ -0,0 +1,75 @@
/*
* VwaitCmd.java --
*
* This file implements the Tcl "vwait" command.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: VwaitCmd.java,v 1.2 1999/08/03 03:22:47 mo Exp $
*/
using System;
namespace tcl.lang
{
 
/*
* This class implements the built-in "vwait" command in Tcl.
*/
 
class VwaitCmd : Command
{
 
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;
}
} // end VwaitCmd
 
class VwaitTrace : VarTrace
{
 
/*
* TraceCmd.cmdProc continuously watches this variable across calls to
* doOneEvent(). It returns immediately when done is set to true.
*/
 
internal bool done = false;
 
public void traceProc( Interp interp, string part1, string part2, TCL.VarFlag flags )
// Mode flags: Should only be TCL.VarFlag.TRACE_WRITES.
{
done = true;
}
} // end VwaitTrace
}
/trunk/TCL/src/commands/WhileCmd.cs
@@ -0,0 +1,86 @@
/*
* WhileCmd.java
*
* Copyright (c) 1997 Cornell University.
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: WhileCmd.java,v 1.1.1.1 1998/10/14 21:09:20 cvsadmin Exp $
*
*/
using System;
namespace tcl.lang
{
 
/// <summary> This class implements the built-in "while" command in Tcl.</summary>
 
class WhileCmd : Command
{
/// <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;
}
}
}
/trunk/TCL/src/csTCL.cs
@@ -0,0 +1,503 @@
using System;
using System.Collections.Generic;
using System.Text;
using tcl.lang;
using System.Reflection;
 
class csTCL
{
/*
** 2009 July 17
**
** 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.
**
*************************************************************************
** This file contains code to implement the "sqlite" test harness
** which runs TCL commands for testing the C#-SQLite port.
**
** $Header$
*/
public static void Main(string[] args)
{
// Array of command-line argument strings.
{
string fileName = null;
 
// Create the interpreter. This will also create the built-in
// Tcl commands.
 
Interp interp = new Interp();
 
// Make command-line arguments available in the Tcl variables "argc"
// and "argv". If the first argument doesn't start with a "-" then
// strip it off and use it as the name of a script file to process.
// We also set the argv0 and TCL.Tcl_interactive vars here.
 
if ((args.Length > 0) && !(args[0].StartsWith("-")))
{
fileName = args[0];
}
 
TclObject argv = TclList.newInstance();
argv.preserve();
try
{
int i = 0;
int argc = args.Length;
if ((System.Object)fileName == null)
{
interp.setVar("argv0", "tcl.lang.Shell", TCL.VarFlag.GLOBAL_ONLY);
interp.setVar("tcl_interactive", "1", TCL.VarFlag.GLOBAL_ONLY);
}
else
{
interp.setVar("argv0", fileName, TCL.VarFlag.GLOBAL_ONLY);
interp.setVar("tcl_interactive", "0", TCL.VarFlag.GLOBAL_ONLY);
i++;
argc--;
}
for (; i < args.Length; i++)
{
TclList.append(interp, argv, TclString.newInstance(args[i]));
}
interp.setVar("argv", argv, TCL.VarFlag.GLOBAL_ONLY);
interp.setVar("argc", System.Convert.ToString(argc), TCL.VarFlag.GLOBAL_ONLY);
}
catch (TclException e)
{
throw new TclRuntimeError("unexpected TclException: " + e.Message);
}
finally
{
argv.release();
}
 
// Normally we would do application specific initialization here.
// However, that feature is not currently supported.
// If a script file was specified then just source that file
// and quit.
 
Console.WriteLine("C#-TCL version " + Assembly.GetExecutingAssembly().GetName().Version.ToString());
Console.WriteLine("==============================================================");
Console.WriteLine("");
 
if ((System.Object)fileName != null)
{
try
{
interp.evalFile(fileName);
}
catch (TclException e)
{
TCL.CompletionCode code = e.getCompletionCode();
if (code == TCL.CompletionCode.RETURN)
{
code = interp.updateReturnInfo();
if (code != TCL.CompletionCode.OK)
{
System.Console.Error.WriteLine("command returned bad code: " + code);
if (tcl.lang.ConsoleThread.debug) System.Diagnostics.Debug.WriteLine("command returned bad code: " + code);
}
}
else if (code == TCL.CompletionCode.ERROR)
{
System.Console.Error.WriteLine(interp.getResult().ToString());
if (tcl.lang.ConsoleThread.debug) System.Diagnostics.Debug.WriteLine(interp.getResult().ToString());
System.Diagnostics.Debug.Assert(false, interp.getResult().ToString());
}
else
{
System.Console.Error.WriteLine("command returned bad code: " + code);
if (tcl.lang.ConsoleThread.debug) System.Diagnostics.Debug.WriteLine("command returned bad code: " + code);
}
}
 
// Note that if the above interp.evalFile() returns the main
// thread will exit. This may bring down the VM and stop
// the execution of Tcl.
//
// If the script needs to handle events, it must call
// vwait or do something similar.
//
// Note that the script can create AWT widgets. This will
// start an AWT event handling thread and keep the VM up. However,
// the interpreter thread (the same as the main thread) would
// have exited and no Tcl scripts can be executed.
 
interp.dispose();
 
System.Environment.Exit(0);
}
 
if ((System.Object)fileName == null)
{
// We are running in interactive mode. Start the ConsoleThread
// that loops, grabbing stdin and passing it to the interp.
 
ConsoleThread consoleThread = new ConsoleThread(interp);
consoleThread.IsBackground = true;
consoleThread.Start();
 
// Loop forever to handle user input events in the command line.
 
Notifier notifier = interp.getNotifier();
while (true)
{
// process events until "exit" is called.
 
notifier.doOneEvent(TCL.ALL_EVENTS);
}
}
}
}
}
 
namespace tcl.lang
{
class ConsoleThread : SupportClass.ThreadClass
{
private class AnonymousClassTclEvent : TclEvent
{
public AnonymousClassTclEvent(string command, ConsoleThread enclosingInstance)
{
InitBlock(command, enclosingInstance);
}
private void InitBlock(string command, ConsoleThread enclosingInstance)
{
this.command = command;
this.enclosingInstance = enclosingInstance;
}
private string command;
private ConsoleThread enclosingInstance;
public ConsoleThread Enclosing_Instance
{
get
{
return enclosingInstance;
}
 
}
public override int processEvent(int flags)
{
 
// See if the command is a complete Tcl command
 
if (Interp.commandComplete(command))
{
if (tcl.lang.ConsoleThread.debug)
{
WriteLine("line was a complete command");
}
 
bool eval_exception = true;
TclObject commandObj = TclString.newInstance(command);
 
try
{
commandObj.preserve();
Enclosing_Instance.interp.recordAndEval(commandObj, 0);
eval_exception = false;
}
catch (TclException e)
{
if (tcl.lang.ConsoleThread.debug)
{
WriteLine("eval returned exceptional condition");
}
 
TCL.CompletionCode code = e.getCompletionCode();
switch (code)
{
 
case TCL.CompletionCode.ERROR:
 
Enclosing_Instance.putLine(Enclosing_Instance.err, Enclosing_Instance.interp.getResult().ToString());
break;
 
case TCL.CompletionCode.BREAK:
Enclosing_Instance.putLine(Enclosing_Instance.err, "invoked \"break\" outside of a loop");
break;
 
case TCL.CompletionCode.CONTINUE:
Enclosing_Instance.putLine(Enclosing_Instance.err, "invoked \"continue\" outside of a loop");
break;
 
default:
Enclosing_Instance.putLine(Enclosing_Instance.err, "command returned bad code: " + code);
break;
 
}
}
finally
{
commandObj.release();
}
 
if (!eval_exception)
{
if (tcl.lang.ConsoleThread.debug)
{
WriteLine("eval returned normally");
}
 
 
string evalResult = Enclosing_Instance.interp.getResult().ToString();
 
if (tcl.lang.ConsoleThread.debug)
{
WriteLine("eval result was \"" + evalResult + "\"");
}
 
if (evalResult.Length > 0)
{
Enclosing_Instance.putLine(Enclosing_Instance.out_Renamed, evalResult);
}
}
 
// Empty out the incoming command buffer
Enclosing_Instance.sbuf.Length = 0;
 
// See if the user set a custom shell prompt for the next command
 
TclObject prompt;
 
try
{
prompt = Enclosing_Instance.interp.getVar("tcl_prompt1", TCL.VarFlag.GLOBAL_ONLY);
}
catch (TclException e)
{
prompt = null;
}
if (prompt != null)
{
try
{
 
Enclosing_Instance.interp.eval(prompt.ToString(), TCL.EVAL_GLOBAL);
}
catch (TclException e)
{
Enclosing_Instance.put(Enclosing_Instance.out_Renamed, "% ");
}
}
else
{
Enclosing_Instance.put(Enclosing_Instance.out_Renamed, "% ");
}
 
return 1;
}
else
{
// Interp.commandComplete() returned false
 
if (tcl.lang.ConsoleThread.debug)
{
WriteLine("line was not a complete command");
}
 
// We don't have a complete command yet. Print out a level 2
// prompt message and wait for further inputs.
 
TclObject prompt;
 
try
{
prompt = Enclosing_Instance.interp.getVar("tcl_prompt2", TCL.VarFlag.GLOBAL_ONLY);
}
catch (TclException)
{
prompt = null;
}
if (prompt != null)
{
try
{
 
Enclosing_Instance.interp.eval(prompt.ToString(), TCL.EVAL_GLOBAL);
}
catch (TclException e)
{
Enclosing_Instance.put(Enclosing_Instance.out_Renamed, "");
}
}
else
{
Enclosing_Instance.put(Enclosing_Instance.out_Renamed, "");
}
 
return 1;
}
} // end processEvent method
}
 
// Interpreter associated with this console thread.
 
internal Interp interp;
 
// Collect the user input in this buffer until it forms a complete Tcl
// command.
 
internal System.Text.StringBuilder sbuf;
 
// Used to for interactive input/output
 
private Channel out_Renamed;
private Channel err;
 
// set to true to get extra debug output
public const bool debug = true;
 
// used to keep track of wether or not System.in.available() works
private static bool sysInAvailableWorks = false;
 
internal ConsoleThread(Interp i)
{
Name = "ConsoleThread";
interp = i;
sbuf = new System.Text.StringBuilder(100);
 
out_Renamed = TclIO.getStdChannel(StdChannel.STDOUT);
err = TclIO.getStdChannel(StdChannel.STDERR);
}
override public void Run()
{
if (debug)
{
WriteLine("entered ConsoleThread run() method");
}
 
 
put(out_Renamed, "% ");
 
while (true)
{
// Loop forever to collect user inputs in a StringBuffer.
// When we have a complete command, then execute it and print
// out the results.
//
// The loop is broken under two conditions: (1) when EOF is
// received inside getLine(). (2) when the "exit" command is
// executed in the script.
 
getLine();
string command = sbuf.ToString();
 
if (debug)
{
WriteLine("got line from console");
WriteLine("\"" + command + "\"");
}
 
// When interacting with the interpreter, one must
// be careful to never call a Tcl method from
// outside of the event loop thread. If we did
// something like just call interp.eval() it
// could crash the whole process because two
// threads might write over each other.
 
// The only safe way to interact with Tcl is
// to create an event and add it to the thread
// safe event queue.
 
TclEvent Tevent = new AnonymousClassTclEvent(command, this); // end TclEvent innerclass
 
// Add the event to the thread safe event queue
interp.getNotifier().queueEvent(Tevent, TCL.QUEUE_TAIL);
 
// Tell this thread to wait until the event has been processed.
Tevent.sync();
}
}
private static void WriteLine(string s)
{
System.Console.Out.WriteLine(s);
if (debug) System.Diagnostics.Debug.WriteLine(s);
}
private void getLine()
{
sbuf.Append(Console.In.ReadLine());
}
private void putLine(Channel channel, string s)
// The String to print.
{
try
{
channel.write(interp, s);
channel.write(interp, "\n");
channel.flush(interp);
}
catch (System.IO.IOException ex)
{
System.Console.Error.WriteLine("IOException in Shell.putLine()");
SupportClass.WriteStackTrace(ex, System.Console.Error);
}
catch (TclException ex)
{
System.Console.Error.WriteLine("TclException in Shell.putLine()");
SupportClass.WriteStackTrace(ex, System.Console.Error);
}
}
private void put(Channel channel, string s)
// The String to print.
{
try
{
channel.write(interp, s);
channel.flush(interp);
}
catch (System.IO.IOException ex)
{
System.Console.Error.WriteLine("IOException in Shell.put()");
SupportClass.WriteStackTrace(ex, System.Console.Error);
}
catch (TclException ex)
{
System.Console.Error.WriteLine("TclException in Shell.put()");
SupportClass.WriteStackTrace(ex, System.Console.Error);
}
}
static ConsoleThread()
{
{
try
{
// There is no way to tell whether System.in will block AWT
// threads, so we assume it does block if we can use
// System.in.available().
 
long available = 0;
// HACK ATK
// available = System.Console.In.Length - System.Console.In.Position;
int generatedAux5 = (int)available;
sysInAvailableWorks = true;
}
catch (System.Exception e)
{
// If System.in.available() causes an exception -- it's probably
// no supported on this platform (e.g. MS Java SDK). We assume
// sysInAvailableWorks is false and let the user suffer ...
}
 
// Sun's JDK 1.2 on Windows systems is screwed up, it does not
// echo chars to the console unless blocking IO is used.
// For this reason we need to use blocking IO under Windows.
 
if (Util.Windows)
{
sysInAvailableWorks = false;
}
if (debug)
{
WriteLine("sysInAvailableWorks = " + sysInAvailableWorks);
}
}
}
} // end of class ConsoleThread
}
/trunk/TCL/src/io/Channel.cs
@@ -0,0 +1,700 @@
/*
* Channel.java
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: Channel.java,v 1.25 2003/03/08 03:42:43 mdejong Exp $
*/
using System;
using System.Text;
using System.IO;
 
namespace tcl.lang
{
 
/// <summary> The Channel class provides functionality that will
/// be needed for any type of Tcl channel. It performs
/// generic reads, writes, without specifying how a
/// given channel is actually created. Each new channel
/// type will need to extend the abstract Channel class
/// and override any methods it needs to provide a
/// specific implementation for.
/// </summary>
 
public abstract class Channel
{
private void InitBlock()
{
buffering = TclIO.BUFF_FULL;
inputTranslation = TclIO.TRANS_AUTO;
outputTranslation = TclIO.TRANS_PLATFORM;
}
/// <summary> This method should be overridden in the subclass to provide
/// a channel specific InputStream object.
/// </summary>
protected internal abstract Stream InputStream
{
get;
}
/// <summary> This method should be overridden in the subclass to provide
/// a channel specific OutputStream object.
/// </summary>
protected internal abstract Stream OutputStream
{
get;
}
/// <summary> Gets the chanName that is the key for the chanTable hashtable.</summary>
/// <returns> channelId
/// </returns>
/// <summary> Sets the chanName that is the key for the chanTable hashtable.</summary>
/// <param name="chan">the unique channelId
/// </param>
public string ChanName
{
 
 
get
{
return chanName;
}
 
 
 
set
{
chanName = value;
}
 
}
/// <summary> Return a string that describes the channel type.
///
/// This is the equivilent of the Tcl_ChannelTypE.typeName field.
/// </summary>
public abstract string ChanType
{
get;
}
/// <summary> Return number of references to this Channel.</summary>
public int RefCount
{
 
 
get
{
return refCount;
}
 
}
public bool ReadOnly
{
get
{
return ( ( mode & TclIO.RDONLY ) != 0 );
}
 
}
public bool WriteOnly
{
get
{
return ( ( mode & TclIO.WRONLY ) != 0 );
}
 
}
public bool ReadWrite
{
get
{
return ( ( mode & TclIO.RDWR ) != 0 );
}
 
}
/// <summary> Query blocking mode.</summary>
/// <summary> Set blocking mode.
///
/// </summary>
/// <param name="blocking">new blocking mode
/// </param>
public bool Blocking
{
 
 
get
{
return blocking;
}
 
 
 
set
{
blocking = value;
 
if ( input != null )
input.Blocking = blocking;
if ( output != null )
output.Blocking = blocking;
}
 
}
/// <summary> Query buffering mode.</summary>
/// <summary> Set buffering mode
///
/// </summary>
/// <param name="buffering">One of TclIO.BUFF_FULL, TclIO.BUFF_LINE,
/// or TclIO.BUFF_NONE
/// </param>
public int Buffering
{
 
 
get
{
return buffering;
}
 
 
 
set
{
if ( value < TclIO.BUFF_FULL || value > TclIO.BUFF_NONE )
throw new TclRuntimeError( "invalid buffering mode in Channel.setBuffering()" );
 
buffering = value;
if ( input != null )
input.Buffering = buffering;
if ( output != null )
output.Buffering = buffering;
}
 
}
/// <summary> Query buffer size</summary>
/// <summary> Tcl_SetChannelBufferSize -> setBufferSize
///
/// </summary>
/// <param name="size">new buffer size
/// </param>
public int BufferSize
{
 
 
get
{
return bufferSize;
}
 
 
 
set
{
 
// If the buffer size is smaller than 10 bytes or larger than 1 Meg
// do not accept the requested size and leave the current buffer size.
 
if ( ( value < 10 ) || ( value > ( 1024 * 1024 ) ) )
{
return;
}
 
bufferSize = value;
if ( input != null )
input.BufferSize = bufferSize;
if ( output != null )
output.BufferSize = bufferSize;
}
 
}
public int NumBufferedInputBytes
{
get
{
if ( input != null )
return input.NumBufferedBytes;
else
return 0;
}
 
}
public int NumBufferedOutputBytes
{
get
{
if ( output != null )
return output.NumBufferedBytes;
else
return 0;
}
 
}
/// <summary> Returns true if a background flush is waiting to happen.</summary>
public bool BgFlushScheduled
{
 
 
get
{
// FIXME: Need to query output here
return false;
}
 
}
/// <summary> Query encoding
///
/// </summary>
/// <returns> Name of Channel's Java encoding (null if no encoding)
/// </returns>
/// <summary> Set new Java encoding</summary>
internal System.Text.Encoding Encoding
{
get
{
return encoding;
}
set
{
encoding = value;
if ( (System.Object)encoding == null )
bytesPerChar = 1;
else
bytesPerChar = EncodingCmd.getBytesPerChar( encoding );
 
if ( input != null )
input.Encoding = encoding;
if ( output != null )
output.Encoding = encoding;
 
// FIXME: Pass bytesPerChar to input and output
}
 
}
/// <summary> Query input translation
/// Set new input translation</summary>
public int InputTranslation
{
 
 
get
{
return inputTranslation;
}
 
 
 
set
{
inputTranslation = value;
if ( input != null )
input.Translation = inputTranslation;
}
 
}
/// <summary> Query output translation
/// Set new output translation</summary>
public int OutputTranslation
{
 
 
get
{
return outputTranslation;
}
 
 
 
set
{
outputTranslation = value;
if ( output != null )
output.Translation = outputTranslation;
}
 
}
/// <summary> Query input eof character</summary>
/// <summary> Set new input eof character</summary>
internal char InputEofChar
{
 
 
get
{
return inputEofChar;
}
 
 
 
set
{
// Store as a byte, not a unicode character
inputEofChar = (char)( value & 0xFF );
if ( input != null )
input.EofChar = inputEofChar;
}
 
}
/// <summary> Query output eof character</summary>
/// <summary> Set new output eof character</summary>
internal char OutputEofChar
{
 
 
get
{
return outputEofChar;
}
 
 
 
set
{
// Store as a byte, not a unicode character
outputEofChar = (char)( value & 0xFF );
if ( output != null )
output.EofChar = outputEofChar;
}
 
}
 
/// <summary> The read, write, append and create flags are set here. The
/// variables used to set the flags are found in the class TclIO.
/// </summary>
 
protected internal int mode;
 
/// <summary> This is a unique name that sub-classes need to set. It is used
/// as the key in the hashtable of registered channels (in interp).
/// </summary>
 
private string chanName;
 
/// <summary> How many interpreters hold references to this IO channel?</summary>
 
protected internal int refCount = 0;
 
/// <summary> Tcl input and output objecs. These are like a mix between
/// a Java Stream and a Reader.
/// </summary>
 
protected internal TclInputStream input = null;
protected internal TclOutputStream output = null;
 
/// <summary> Set to false when channel is in non-blocking mode.</summary>
 
protected internal bool blocking = true;
 
/// <summary> Buffering (full,line, or none)</summary>
 
protected internal int buffering;
 
/// <summary> Buffer size, in bytes, allocated for channel to store input or output</summary>
 
protected internal int bufferSize = 4096;
 
/// <summary> Name of Java encoding for this Channel.
/// A null value means use no encoding (binary).
/// </summary>
 
// FIXME: Check to see if this field is updated after a call
// to "encoding system $enc" for new Channel objects!
 
protected internal System.Text.Encoding encoding;
protected internal int bytesPerChar;
 
/// <summary> Translation mode for end-of-line character</summary>
 
protected internal int inputTranslation;
protected internal int outputTranslation;
 
/// <summary> If nonzero, use this as a signal of EOF on input.</summary>
 
protected internal char inputEofChar = (char)( 0 );
 
/// <summary> If nonzero, append this to a writeable channel on close.</summary>
 
protected internal char outputEofChar = (char)( 0 );
 
internal Channel()
{
InitBlock();
Encoding = EncodingCmd.systemJavaEncoding;
}
 
/// <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> Tcl_WriteObj -> write
///
/// Write data to the Channel
///
/// </summary>
/// <param name="interp">is used for TclExceptions.
/// </param>
/// <param name="outData">the TclObject that holds the data to write.
/// </param>
 
public virtual void write( Interp interp, TclObject outData )
{
 
checkWrite( interp );
initOutput();
 
// FIXME: Is it possible for a write to happen with a null output?
if ( output != null )
{
output.writeObj( outData );
}
}
 
/// <summary> Tcl_WriteChars -> write
///
/// Write string data to the Channel.
///
/// </summary>
/// <param name="interp">is used for TclExceptions.
/// </param>
/// <param name="outStr">the String object to write.
/// </param>
 
public void write( Interp interp, string outStr )
{
write( interp, TclString.newInstance( outStr ) );
}
 
/// <summary> Close the Channel. The channel is only closed, it is
/// the responsibility of the "closer" to remove the channel from
/// the channel table.
/// </summary>
 
internal virtual void close()
{
 
IOException ex = null;
 
if ( input != null )
{
try
{
input.close();
}
catch ( IOException e )
{
ex = e;
}
input = null;
}
 
if ( output != null )
{
try
{
output.close();
}
catch ( IOException e )
{
ex = e;
}
output = null;
}
 
if ( ex != null )
throw ex;
}
 
/// <summary> Flush the Channel.
///
/// </summary>
/// <exception cref=""> TclException is thrown when attempting to flush a
/// read only channel.
/// </exception>
/// <exception cref=""> IOEcception is thrown for all other flush errors.
/// </exception>
 
public void flush( Interp interp )
{
 
checkWrite( interp );
 
if ( output != null )
{
output.flush();
}
}
 
/// <summary> Move the current file pointer. If seek is not supported on the
/// given channel then -1 will be returned. A subclass should
/// override this method if it supports the seek operation.
///
/// </summary>
/// <param name="interp">currrent interpreter.
/// </param>
/// <param name="offset">The number of bytes to move the file pointer.
/// </param>
/// <param name="mode">where to begin incrementing the file pointer; beginning,
/// current, end.
/// </param>
 
public virtual void seek( Interp interp, long offset, int mode )
{
throw new TclPosixException( interp, TclPosixException.EINVAL, true, "error during seek on \"" + ChanName + "\"" );
}
 
/// <summary> Return the current file pointer. If tell is not supported on the
/// given channel then -1 will be returned. A subclass should override
/// this method if it supports the tell operation.
/// </summary>
 
public virtual long tell()
{
return (long)( -1 );
}
 
/// <summary> Setup the TclInputStream on the first call to read</summary>
 
protected internal void initInput()
{
if ( input != null )
return;
 
input = new TclInputStream( InputStream );
input.Encoding = encoding;
input.Translation = inputTranslation;
input.EofChar = inputEofChar;
input.Buffering = buffering;
input.BufferSize = bufferSize;
input.Blocking = blocking;
}
 
/// <summary> Setup the TclOutputStream on the first call to write</summary>
 
protected internal void initOutput()
{
if ( output != null )
return;
 
output = new TclOutputStream( OutputStream );
output.Encoding = encoding;
output.Translation = outputTranslation;
output.EofChar = outputEofChar;
output.Buffering = buffering;
output.BufferSize = bufferSize;
output.Blocking = blocking;
}
 
/// <summary> Returns true if the last read reached the EOF.</summary>
 
public bool eof()
{
if ( input != null )
return input.eof();
else
return false;
}
 
// Helper methods to check read/write permission and raise a
// TclException if reading is not allowed.
 
protected internal void checkRead( Interp interp )
{
if ( !ReadOnly && !ReadWrite )
{
throw new TclException( interp, "channel \"" + ChanName + "\" wasn't opened for reading" );
}
}
 
protected internal void checkWrite( Interp interp )
{
if ( !WriteOnly && !ReadWrite )
{
throw new TclException( interp, "channel \"" + ChanName + "\" wasn't opened for writing" );
}
}
 
/// <summary> Tcl_InputBlocked -> isBlocked
///
/// Returns true if input is blocked on this channel, false otherwise.
///
/// </summary>
 
public bool isBlocked( Interp interp )
{
checkRead( interp );
 
if ( input != null )
return input.Blocked;
else
return false;
}
 
/// <summary> Channel is in CRLF eol input translation mode and the last
/// byte seen was a CR.
/// </summary>
 
public bool inputSawCR()
{
if ( input != null )
return input.sawCR();
return false;
}
}
}
/trunk/TCL/src/io/ChannelBuffer.cs
@@ -0,0 +1,66 @@
// Port of the ChannelBuffer struct from tclIO.h/tclIO.c
// and associated functionality
//
// Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
//$Header$
 
using System;
namespace tcl.lang
{
 
class ChannelBuffer
{
 
// The next position into which a character
// will be put in the buffer.
 
internal int nextAdded;
 
// Position of next byte to be removed
// from the buffer.
 
internal int nextRemoved;
 
// How big is the buffer?
 
internal int bufLength;
 
// Next buffer in chain.
 
internal ChannelBuffer next;
 
// The actual bytes stored in the buffer
 
internal byte[] buf;
 
// A channel buffer has BUFFER_PADDING bytes extra at beginning to
// hold any bytes of a native-encoding character that got split by
// the end of the previous buffer and need to be moved to the
// beginning of the next buffer to make a contiguous string so it
// can be converted to UTF-8.
//
// A channel buffer has BUFFER_PADDING bytes extra at the end to
// hold any bytes of a native-encoding character (generated from a
// UTF-8 character) that overflow past the end of the buffer and
// need to be moved to the next buffer.
 
internal const int BUFFER_PADDING = 16;
 
/// <summary> AllocChannelBuffer -> ChannelBuffer
///
/// Create a new ChannelBuffer object
/// </summary>
 
internal ChannelBuffer( int length )
{
int n;
 
n = length + BUFFER_PADDING + BUFFER_PADDING;
buf = new byte[n];
nextAdded = BUFFER_PADDING;
nextRemoved = BUFFER_PADDING;
bufLength = length + BUFFER_PADDING;
next = null;
}
}
}
/trunk/TCL/src/io/FileChannel.cs
@@ -0,0 +1,403 @@
#undef DEBUG
/*
* FileChannel.java --
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: FileChannel.java,v 1.20 2003/03/08 03:42:44 mdejong Exp $
*
*/
using System;
using System.IO;
 
namespace tcl.lang
{
 
/// <summary> Subclass of the abstract class Channel. It implements all of the
/// methods to perform read, write, open, close, etc on a file.
/// </summary>
 
class FileChannel : Channel
{
public override string ChanType
{
get
{
return "file";
}
 
}
override protected internal Stream InputStream
{
get
{
 
 
// return new FileInputStream(file.getFD());
return file;
}
 
}
override protected internal Stream OutputStream
{
get
{
 
 
// return new FileOutputStream(file.getFD());
return file;
}
 
}
 
/// <summary> The file needs to have a file pointer that can be moved randomly
/// within the file. The RandomAccessFile is the only java.io class
/// that allows this behavior.
/// </summary>
 
private FileStream file = null;
 
/// <summary> Open a file with the read/write permissions determined by modeFlags.
/// This method must be called before any other methods will function
/// properly.
///
/// </summary>
/// <param name="interp">currrent interpreter.
/// </param>
/// <param name="fileName">the absolute path or name of file in the current
/// directory to open
/// </param>
/// <param name="modeFlags">modes used to open a file for reading, writing, etc
/// </param>
/// <returns> the channelId of the file.
/// </returns>
/// <exception cref=""> TclException is thrown when the modeFlags try to open
/// a file it does not have permission for or if the
/// file dosent exist and CREAT wasnt specified.
/// </exception>
/// <exception cref=""> IOException is thrown when an IO error occurs that was not
/// correctly tested for. Most cases should be caught.
/// </exception>
 
internal string open( Interp interp, string fileName, int modeFlags )
{
 
mode = modeFlags;
FileInfo fileObj = FileUtil.getNewFileObj( interp, fileName );
FileMode fileMode = 0;
FileAccess fileAccess = 0;
 
if ( ( ( modeFlags & TclIO.CREAT ) != 0 ) && ( ( modeFlags & TclIO.EXCL ) != 0 ) )
{
fileMode = FileMode.CreateNew;
}
else if ( ( modeFlags & TclIO.CREAT ) != 0 )
{
fileMode = FileMode.Create;
}
else
{
fileMode = FileMode.Open;
}
if ( ( modeFlags & TclIO.TRUNC ) != 0 )
{
fileMode = fileMode & FileMode.Truncate;
}
if ( ( modeFlags & TclIO.APPEND ) != 0 )
{
fileMode = fileMode & FileMode.Append;
}
 
if ( ( modeFlags & TclIO.RDWR ) != 0 )
{
fileAccess = FileAccess.ReadWrite;
}
else if ( ( modeFlags & TclIO.RDONLY ) != 0 )
{
fileAccess = FileAccess.Read;
}
else if ( ( modeFlags & TclIO.WRONLY ) != 0 )
{
fileAccess = FileAccess.Write;
}
else
{
throw new TclRuntimeError( "FileChannel.java: invalid mode value" );
}
 
file = new FileStream( fileObj.FullName, fileMode, fileAccess, FileShare.ReadWrite );
 
string fName = TclIO.getNextDescriptor( interp, "file" );
ChanName = fName;
//Console.Out.WriteLine("",file.Name);
return fName;
}
 
/// <summary> Close the file. The file MUST be open or a TclRuntimeError
/// is thrown.
/// </summary>
 
internal override void close()
{
if ( file == null )
{
throw new TclRuntimeError( "FileChannel.close(): null file object" );
}
 
// Invoke super.close() first since it might write an eof char
try
{
base.close();
}
finally
{
// Console.Out.WriteLine("Debugg Closing {0}",file.Name);
file.Close();
}
}
 
/// <summary> Move the file pointer internal to the RandomAccessFile object.
/// The file MUST be open or a TclRuntimeError is thrown.
///
/// </summary>
/// <param name="offset">The number of bytes to move the file pointer.
/// </param>
/// <param name="inmode">to begin incrementing the file pointer; beginning,
/// current, or end of the file.
/// </param>
public override void seek( Interp interp, long offset, int inmode )
{
 
if ( file == null )
{
throw new TclRuntimeError( "FileChannel.seek(): null file object" );
}
 
//FIXME: Disallow seek on dead channels (raise TclPosixException ??)
//if (CheckForDeadChannel(NULL, statePtr)) {
// return Tcl_LongAsWide(-1);
//}
 
// Compute how much input and output is buffered. If both input and
// output is buffered, cannot compute the current position.
 
int inputBuffered = NumBufferedInputBytes;
int outputBuffered = NumBufferedOutputBytes;
 
if ( ( inputBuffered != 0 ) && ( outputBuffered != 0 ) )
{
throw new TclPosixException( interp, TclPosixException.EFAULT, true, "error during seek on \"" + ChanName + "\"" );
}
 
// If we are seeking relative to the current position, compute the
// corrected offset taking into account the amount of unread input.
 
if ( inmode == TclIO.SEEK_CUR )
{
offset -= inputBuffered;
}
 
// The seekReset method will discard queued input and
// reset flags like EOF and BLOCKED.
 
if ( input != null )
{
input.seekReset();
}
 
// FIXME: Next block is disabled since non-blocking is not implemented.
// If the channel is in asynchronous output mode, switch it back
// to synchronous mode and cancel any async flush that may be
// scheduled. After the flush, the channel will be put back into
// asynchronous output mode.
 
bool wasAsync = false;
//if (false && !Blocking)
//{
// wasAsync = true;
// Blocking = true;
// if (BgFlushScheduled)
// {
// //scheduleBgFlush();
// }
//}
 
// If there is data buffered in curOut then mark the
// channel as ready to flush before invoking flushChannel.
 
if ( output != null )
{
output.seekCheckBuferReady();
}
 
// If the flush fails we cannot recover the original position. In
// that case the seek is not attempted because we do not know where
// the access position is - instead we return the error. FlushChannel
// has already called Tcl_SetErrno() to report the error upwards.
// If the flush succeeds we do the seek also.
 
if ( output != null && output.flushChannel( null, false ) != 0 )
{
// FIXME: IS this the proper action to take on error?
throw new IOException( "flush error while seeking" );
}
else
{
// Now seek to the new position in the channel as requested by the
// caller.
 
long actual_offset;
 
switch ( inmode )
{
 
case TclIO.SEEK_SET:
{
actual_offset = offset;
break;
}
 
case TclIO.SEEK_CUR:
{
actual_offset = file.Position + offset;
break;
}
 
case TclIO.SEEK_END:
{
actual_offset = file.Length + offset;
break;
}
 
default:
{
throw new TclRuntimeError( "invalid seek mode" );
}
 
}
 
// A negative offset to seek() would raise an IOException, but
// we want to raise an invalid argument error instead
 
if ( actual_offset < 0 )
{
throw new TclPosixException( interp, TclPosixException.EINVAL, true, "error during seek on \"" + ChanName + "\"" );
}
 
file.Seek( actual_offset, SeekOrigin.Begin );
}
 
// Restore to nonblocking mode if that was the previous behavior.
//
// NOTE: Even if there was an async flush active we do not restore
// it now because we already flushed all the queued output, above.
 
if ( wasAsync )
{
Blocking = false;
}
}
 
/// <summary> Tcl_Tell -> tell
///
/// Return the current offset of the file pointer in number of bytes from
/// the beginning of the file. The file MUST be open or a TclRuntimeError
/// is thrown.
///
/// </summary>
/// <returns> The current value of the file pointer.
/// </returns>
public override long tell()
{
if ( file == null )
{
throw new TclRuntimeError( "FileChannel.tell(): null file object" );
}
int inputBuffered = NumBufferedInputBytes;
int outputBuffered = NumBufferedOutputBytes;
 
if ( ( inputBuffered != 0 ) && ( outputBuffered != 0 ) )
{
// FIXME: Posix error EFAULT ?
return -1;
}
long curPos = file.Position;
if ( curPos == -1 )
{
// FIXME: Set errno here?
return -1;
}
if ( inputBuffered != 0 )
{
return curPos - inputBuffered;
}
return curPos + outputBuffered;
}
 
/// <summary> If the file dosent exist then a TclExcpetion is thrown.
///
/// </summary>
/// <param name="interp">currrent interpreter.
/// </param>
/// <param name="fileObj">a java.io.File object of the file for this channel.
/// </param>
 
private void checkFileExists( Interp interp, FileInfo fileObj )
{
bool tmpBool;
if ( File.Exists( fileObj.FullName ) )
tmpBool = true;
else
tmpBool = Directory.Exists( fileObj.FullName );
if ( !tmpBool )
{
throw new TclPosixException( interp, TclPosixException.ENOENT, true, "couldn't open \"" + fileObj.Name + "\"" );
}
}
 
 
/// <summary> Checks the read/write permissions on the File object. If inmode is less
/// than 0 it checks for read permissions, if mode greater than 0 it checks
/// for write permissions, and if it equals 0 then it checks both.
///
/// </summary>
/// <param name="interp">currrent interpreter.
/// </param>
/// <param name="fileObj">a java.io.File object of the file for this channel.
/// </param>
/// <param name="inmode">what permissions to check for.
/// </param>
 
private void checkReadWritePerm( Interp interp, FileInfo fileObj, int inmode )
{
bool error = false;
 
if ( inmode <= 0 )
{
 
// HACK
// if (!fileObj.canRead())
// {
// error = true;
// }
}
if ( inmode >= 0 )
{
if ( !SupportClass.FileCanWrite( fileObj ) )
{
error = true;
}
}
if ( error )
{
throw new TclPosixException( interp, TclPosixException.EACCES, true, "couldn't open \"" + fileObj.Name + "\"" );
}
}
}
}
/trunk/TCL/src/io/FileUtil.cs
@@ -0,0 +1,968 @@
#undef DEBUG
/*
* FileUtil.java --
*
* This file contains utility methods for file-related operations.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: FileUtil.java,v 1.6 2003/02/02 00:59:16 mdejong Exp $
*
*/
using System;
using System.Text;
using System.IO;
namespace tcl.lang
{
 
/*
* This class implements utility methods for file-related operations.
*/
 
public class FileUtil
{
 
internal const int PATH_RELATIVE = 0;
internal const int PATH_VOLUME_RELATIVE = 1;
internal const int PATH_ABSOLUTE = 2;
 
/*
*-----------------------------------------------------------------------------
*
* getWinHomePath --
*
* In the Windows file system, one type of absolute path follows this
* regular expression: ^(//+[a-zA-Z]+/+[a-zA-Z]+)
*
* If "path" doesn't fit the pattern, then return 0.
* If the stopEarly bool is true, then return the index of the first
* non-slash character in path, as soon as we know that path fits the
* pattern. Otherwise, return the index of the slash (or end of string)
* following the entire absolute path.
*
* Results:
* Returns an integer index in path.
*
* Side effects:
* If "path" fits the pattern, and "stopEarly" is not chosen, the absolute
* path is coppied (without extra slashes) to "absBuf". Otherwise, absBuf
* is set to "".
*
*-----------------------------------------------------------------------------
*/
 
private static int getWinHomePath( string path, bool stopEarly, StringBuilder absBuf )
// Buffer to store side effect.
{
int pIndex, oldIndex, firstNonSlash;
 
// The first 2 or more chars must be slashes.
 
for ( pIndex = 0; pIndex < path.Length; pIndex++ )
{
if ( path[pIndex] != '/' )
{
break;
}
}
if ( pIndex < 2 )
{
absBuf.Length = 0;
return 0;
}
firstNonSlash = pIndex;
 
 
// The next 1 or more chars may not be slashes.
 
for ( ; pIndex < path.Length; pIndex++ )
{
if ( path[pIndex] == '/' )
{
break;
}
}
if ( pIndex == firstNonSlash )
{
absBuf.Length = 0;
return 0;
}
absBuf.EnsureCapacity( absBuf.Length + path.Length );
absBuf.Append( "//" );
absBuf.Append( path.Substring( firstNonSlash, ( pIndex ) - ( firstNonSlash ) ) );
 
// The next 1 or more chars must be slashes.
 
oldIndex = pIndex;
for ( ; pIndex < path.Length; pIndex++ )
{
if ( path[pIndex] != '/' )
{
if ( pIndex == oldIndex )
{
absBuf.Length = 0;
return 0;
}
 
// We know that the path fits the pattern.
 
if ( stopEarly )
{
absBuf.Length = 0;
return firstNonSlash;
}
firstNonSlash = pIndex;
 
// Traverse the path until a new slash (or end of string) is found.
// Return the index of the new slash.
 
pIndex++;
for ( ; pIndex < path.Length; pIndex++ )
{
if ( path[pIndex] == '/' )
{
break;
}
}
absBuf.Append( '/' );
absBuf.Append( path.Substring( firstNonSlash, ( pIndex ) - ( firstNonSlash ) ) );
return pIndex;
}
}
absBuf.Length = 0;
return 0;
}
private static int beginsWithLetterColon( string path )
// Path to check start pattern.
{
if ( ( path.Length > 1 ) && ( System.Char.IsLetter( path[0] ) ) && ( path[1] == ':' ) )
{
 
int pIndex;
for ( pIndex = 2; pIndex < path.Length; pIndex++ )
{
if ( path[pIndex] != '/' )
{
break;
}
}
return pIndex;
}
return 0;
}
private static int getWinAbsPath( string path, StringBuilder absBuf )
// Buffer to store side effect.
{
absBuf.Length = 0;
 
if ( path.Length < 1 )
{
return 0;
}
 
absBuf.EnsureCapacity( absBuf.Length + path.Length );
 
int colonIndex = beginsWithLetterColon( path );
if ( colonIndex > 0 )
{
if ( colonIndex > 2 )
{
absBuf.Append( path.Substring( 0, ( 3 ) - ( 0 ) ) );
}
else
{
absBuf.Append( path.Substring( 0, ( 2 ) - ( 0 ) ) );
}
return colonIndex;
}
else
{
int absIndex = getWinHomePath( path, false, absBuf );
if ( absIndex > 0 )
{
return absIndex;
}
else if ( path[0] == '/' )
{
int pIndex;
for ( pIndex = 1; pIndex < path.Length; pIndex++ )
{
if ( path[pIndex] != '/' )
{
break;
}
}
absBuf.Append( "/" );
return pIndex;
}
}
return 0;
}
private static int getDegenerateUnixPath( string path )
// Path to check.
{
int pIndex = 0;
 
while ( ( pIndex < path.Length ) && ( path[pIndex] == '/' ) )
{
++pIndex;
}
 
// "path" doesn't begin with a '/'.
 
if ( pIndex == 0 )
{
return 0;
}
while ( pIndex < path.Length )
{
string tmpPath = path.Substring( pIndex );
if ( tmpPath.StartsWith( "./" ) )
{
pIndex += 2;
}
else if ( tmpPath.StartsWith( "../" ) )
{
pIndex += 3;
}
else
{
break;
}
while ( ( pIndex < path.Length ) && ( path[pIndex] == '/' ) )
{
++pIndex;
}
}
if ( ( pIndex < path.Length ) && ( path[pIndex] == '.' ) )
{
++pIndex;
}
if ( ( pIndex < path.Length ) && ( path[pIndex] == '.' ) )
{
++pIndex;
}
 
// pIndex may be 1 past the end of "path".
 
return pIndex;
}
internal static int getPathType( string path )
// Path for which we find pathtype.
{
char c;
if ( path.Length < 1 )
{
return PATH_RELATIVE;
}
 
switch ( JACL.PLATFORM )
{
 
case JACL.PLATFORM_WINDOWS:
path = path.Replace( '\\', '/' );
 
// Windows absolute pathes start with '~' or [a-zA-Z]:/ or home
// path.
 
c = path[0];
if ( c == '~' )
{
return PATH_ABSOLUTE;
}
if ( c == '/' )
{
StringBuilder absBuf = new StringBuilder( 0 );
if ( getWinHomePath( path, true, absBuf ) > 0 )
{
return PATH_ABSOLUTE;
}
return PATH_VOLUME_RELATIVE;
}
int colonIndex = beginsWithLetterColon( path );
if ( colonIndex > 0 )
{
if ( colonIndex > 2 )
{
return PATH_ABSOLUTE;
}
return PATH_VOLUME_RELATIVE;
}
return PATH_RELATIVE;
 
 
case JACL.PLATFORM_MAC:
if ( path[0] == '~' )
{
return PATH_ABSOLUTE;
}
 
switch ( path.IndexOf( (System.Char)':' ) )
{
 
case -1:
 
if ( ( path[0] == '/' ) && ( getDegenerateUnixPath( path ) < path.Length ) )
{
return PATH_ABSOLUTE;
}
break;
 
case 0:
 
return PATH_RELATIVE;
 
default:
 
return PATH_ABSOLUTE;
 
}
return PATH_RELATIVE;
 
 
default:
 
c = path[0];
if ( ( c == '/' ) || ( c == '~' ) )
{
return PATH_ABSOLUTE;
}
break;
 
}
return PATH_RELATIVE;
}
internal static FileInfo getNewFileObj( Interp interp, string fileName )
{
fileName = translateFileName( interp, fileName );
System.Diagnostics.Debug.WriteLine( "File name is \"" + fileName + "\"" );
switch ( getPathType( fileName ) )
{
 
case PATH_RELATIVE:
if ( fileName == ":memory:" )
return null;
System.Diagnostics.Debug.WriteLine( "File name is PATH_RELATIVE" );
return new FileInfo( interp.getWorkingDir().FullName + "\\" + fileName );
 
case PATH_VOLUME_RELATIVE:
System.Diagnostics.Debug.WriteLine( "File name is PATH_VOLUME_RELATIVE" );
 
// Something is very wrong if interp.getWorkingDir()
// does not start with C: or another drive letter
string cwd = interp.getWorkingDir().ToString();
int index = beginsWithLetterColon( cwd );
if ( index == 0 )
{
throw new TclRuntimeError( "interp working directory \"" + cwd + "\" does not start with a drive letter" );
}
 
// We can not use the joinPath() method because joing("D:/", "/f.txt")
// returns "/f.txt" for some wacky reason. Just do it ourselves.
StringBuilder buff = new StringBuilder();
buff.Append( cwd.Substring( 0, ( 2 ) - ( 0 ) ) );
buff.Append( '\\' );
for ( int i = 0; i < fileName.Length; i++ )
{
if ( fileName[i] != '\\' )
{
// Once we skip all the \ characters at the front
// append the rest of the fileName onto the buffer
buff.Append( fileName.Substring( i ) );
break;
}
}
 
fileName = buff.ToString();
 
System.Diagnostics.Debug.WriteLine( "After PATH_VOLUME_RELATIVE join \"" + fileName + "\"" );
 
return new FileInfo( fileName );
 
case PATH_ABSOLUTE:
System.Diagnostics.Debug.WriteLine( "File name is PATH_ABSOLUTE" );
return new FileInfo( fileName );
 
default:
throw new TclRuntimeError( "type for fileName \"" + fileName + "\" not matched in case statement" );
 
}
}
private static void appendComponent( string component, int compIndex, int compSize, StringBuilder buf )
// Buffer to append the component.
{
for ( ; compIndex < component.Length; compIndex++ )
{
char c = component[compIndex];
if ( c == '/' )
{
// Eliminate duplicate slashes.
 
while ( ( compIndex < compSize ) && ( component[compIndex + 1] == '/' ) )
{
compIndex++;
}
 
// Only add a slash if following non-slash elements exist.
 
if ( compIndex < compSize )
{
buf.EnsureCapacity( buf.Length + 1 );
buf.Append( '/' );
}
}
else
{
buf.EnsureCapacity( buf.Length + 1 );
buf.Append( c );
}
}
}
internal static string joinPath( Interp interp, TclObject[] argv, int startIndex, int endIndex )
{
StringBuilder result = new StringBuilder( 10 );
 
switch ( JACL.PLATFORM )
{
 
case JACL.PLATFORM_WINDOWS:
 
for ( int i = startIndex; i < endIndex; i++ )
{
 
 
string p = argv[i].ToString().Replace( '\\', '/' );
int pIndex = 0;
int pLastIndex = p.Length - 1;
 
if ( p.Length == 0 )
{
continue;
}
 
StringBuilder absBuf = new StringBuilder( 0 );
pIndex = getWinAbsPath( p, absBuf );
if ( pIndex > 0 )
{
// If the path is absolute or volume relative (except those
// beginning with '~'), reset the result buffer to the absolute
// substring.
 
result = absBuf;
}
else if ( p[0] == '~' )
{
// If the path begins with '~', reset the result buffer to "".
 
result.Length = 0;
}
else
{
// This is a relative path. Remove the ./ from tilde prefixed
// elements unless it is the first component.
 
if ( ( result.Length != 0 ) && ( String.Compare( p, pIndex, "./~", 0, 3 ) == 0 ) )
{
pIndex = 2;
}
 
// Check to see if we need to append a separator before adding
// this relative component.
 
if ( result.Length != 0 )
{
char c = result[result.Length - 1];
if ( ( c != '/' ) && ( c != ':' ) )
{
result.EnsureCapacity( result.Length + 1 );
result.Append( '/' );
}
}
}
 
// Append the element.
 
appendComponent( p, pIndex, pLastIndex, result );
pIndex = p.Length;
}
return result.ToString();
 
 
case JACL.PLATFORM_MAC:
 
 
bool needsSep = true;
for ( int i = startIndex; i < endIndex; i++ )
{
 
 
TclObject[] splitArrayObj = TclList.getElements( interp, splitPath( interp, argv[i].ToString() ) );
 
if ( splitArrayObj.Length == 0 )
{
continue;
}
 
// If 1st path element is absolute, reset the result to "" and
// append the 1st path element to it.
 
int start = 0;
 
string p = splitArrayObj[0].ToString();
if ( ( p[0] != ':' ) && ( p.IndexOf( (System.Char)':' ) != -1 ) )
{
result.Length = 0;
result.Append( p );
start++;
needsSep = false;
}
 
// Now append the rest of the path elements, skipping
// : unless it is the first element of the path, and
// watching out for :: et al. so we don't end up with
// too many colons in the result.
 
for ( int j = start; j < splitArrayObj.Length; j++ )
{
 
 
p = splitArrayObj[j].ToString();
 
if ( p.Equals( ":" ) )
{
if ( result.Length != 0 )
{
continue;
}
else
{
needsSep = false;
}
}
else
{
char c = 'o';
if ( p.Length > 1 )
{
c = p[1];
}
if ( p[0] == ':' )
{
if ( !needsSep )
{
p = p.Substring( 1 );
}
}
else
{
if ( needsSep )
{
result.Append( ':' );
}
}
if ( c == ':' )
{
needsSep = false;
}
else
{
needsSep = true;
}
}
result.Append( p );
}
}
return result.ToString();
 
 
default:
 
for ( int i = startIndex; i < endIndex; i++ )
{
 
 
string p = argv[i].ToString();
int pIndex = 0;
int pLastIndex = p.Length - 1;
 
if ( p.Length == 0 )
{
continue;
}
 
if ( p[pIndex] == '/' )
{
// If the path is absolute (except those beginning with '~'),
// reset the result buffer to the absolute substring.
 
while ( ( pIndex <= pLastIndex ) && ( p[pIndex] == '/' ) )
{
pIndex++;
}
result.Length = 0;
result.Append( '/' );
}
else if ( p[pIndex] == '~' )
{
// If the path begins with '~', reset the result buffer to "".
 
result.Length = 0;
}
else
{
// This is a relative path. Remove the ./ from tilde prefixed
// elements unless it is the first component.
 
if ( ( result.Length != 0 ) && ( String.Compare( p, pIndex, "./~", 0, 3 ) == 0 ) )
{
pIndex += 2;
}
 
// Append a separator if needed.
 
if ( ( result.Length != 0 ) && ( result[result.Length - 1] != '/' ) )
{
result.EnsureCapacity( result.Length + 1 );
result.Append( '/' );
}
}
 
// Append the element.
 
appendComponent( p, pIndex, pLastIndex, result );
pIndex = p.Length;
}
break;
 
}
return result.ToString();
}
internal static TclObject splitPath( Interp interp, string path )
{
TclObject resultListObj = TclList.newInstance();
TclObject componentObj;
string component = "";
string tmpPath;
bool foundComponent = false;
bool convertDotToColon = false;
bool isColonSeparator = false;
bool appendColon = false;
bool prependColon = false;
string thisDir = "./";
 
// If the path is the empty string, returnan empty result list.
 
if ( path.Length == 0 )
{
return resultListObj;
}
 
// Handling the 1st component is file system dependent.
 
switch ( JACL.PLATFORM )
{
 
case JACL.PLATFORM_WINDOWS:
tmpPath = path.Replace( '\\', '/' );
 
StringBuilder absBuf = new StringBuilder( 0 );
int absIndex = getWinAbsPath( tmpPath, absBuf );
if ( absIndex > 0 )
{
componentObj = TclString.newInstance( absBuf.ToString() );
TclList.append( interp, resultListObj, componentObj );
tmpPath = tmpPath.Substring( absIndex );
foundComponent = true;
}
break;
 
 
case JACL.PLATFORM_MAC:
 
tmpPath = "";
thisDir = ":";
 
switch ( path.IndexOf( (System.Char)':' ) )
{
 
case -1:
 
if ( path[0] != '/' )
{
tmpPath = path;
convertDotToColon = true;
if ( path[0] == '~' )
{
// If '~' is the first char, then append a colon to end
// of the 1st component.
 
appendColon = true;
}
break;
}
int degenIndex = getDegenerateUnixPath( path );
if ( degenIndex < path.Length )
{
// First component of absolute unix path is followed by a ':',
// instead of being preceded by a degenerate unix-style
// pattern.
 
 
tmpPath = path.Substring( degenIndex );
convertDotToColon = true;
appendColon = true;
break;
}
 
// Degenerate unix path can't be split. Return a list with one
// element: ":" prepended to "path".
 
componentObj = TclString.newInstance( ":" + path );
TclList.append( interp, resultListObj, componentObj );
return resultListObj;
 
case 0:
 
if ( path.Length == 1 )
{
// If path == ":", then return a list with ":" as its only
// element.
 
componentObj = TclString.newInstance( ":" );
TclList.append( interp, resultListObj, componentObj );
return resultListObj;
}
 
 
// For each component, if slashes exist in the remaining filename,
// prepend a colon to the component. Since this path is relative,
// pretend that we have already processed 1 components so a
// tilde-prefixed 1st component will have ":" prepended to it.
 
 
tmpPath = path.Substring( 1 );
foundComponent = true;
prependColon = true;
isColonSeparator = true;
break;
 
 
default:
 
tmpPath = path;
appendColon = true;
prependColon = true;
isColonSeparator = true;
break;
 
}
break;
 
 
default:
 
if ( path[0] == '/' )
{
componentObj = TclString.newInstance( "/" );
TclList.append( interp, resultListObj, componentObj );
tmpPath = path.Substring( 1 );
foundComponent = true;
}
else
{
tmpPath = path;
}
break;
 
}
 
// Iterate over all of the components of the path.
 
int sIndex = 0;
while ( sIndex != -1 )
{
if ( isColonSeparator )
{
sIndex = tmpPath.IndexOf( ":" );
// process adjacent ':'
 
if ( sIndex == 0 )
{
componentObj = TclString.newInstance( "::" );
TclList.append( interp, resultListObj, componentObj );
foundComponent = true;
tmpPath = tmpPath.Substring( sIndex + 1 );
continue;
}
}
else
{
sIndex = tmpPath.IndexOf( "/" );
// Ignore a redundant '/'
 
if ( sIndex == 0 )
{
tmpPath = tmpPath.Substring( sIndex + 1 );
continue;
}
}
if ( sIndex == -1 )
{
// Processing the last component. If it is empty, exit loop.
 
if ( tmpPath.Length == 0 )
{
break;
}
component = tmpPath;
}
else
{
component = tmpPath.Substring( 0, ( sIndex ) - ( 0 ) );
}
 
if ( convertDotToColon && ( component.Equals( "." ) || component.Equals( ".." ) ) )
{
// If platform = MAC, convert .. to :: or . to :
 
component = component.Replace( '.', ':' );
}
if ( foundComponent )
{
if ( component[0] == '~' )
{
// If a '~' preceeds a component (other than the 1st one), then
// prepend "./" or ":" to the component.
 
component = thisDir + component;
}
else if ( prependColon )
{
// If the prependColon flag is set, either unset it or prepend
// ":" to the component, depending on whether any '/'s remain
// in tmpPath.
 
if ( tmpPath.IndexOf( (System.Char)'/' ) == -1 )
{
prependColon = false;
}
else
{
component = ":" + component;
}
}
}
else if ( appendColon )
{
//If platform = MAC, append a ':' to the first component.
 
component = component + ":";
}
componentObj = TclString.newInstance( component );
TclList.append( interp, resultListObj, componentObj );
foundComponent = true;
tmpPath = tmpPath.Substring( sIndex + 1 );
}
return resultListObj;
}
internal static string doTildeSubst( Interp interp, string user )
{
string dir;
 
if ( user.Length == 0 )
{
try
{
 
dir = interp.getVar( "env", "HOME", TCL.VarFlag.GLOBAL_ONLY ).ToString();
}
catch ( System.Exception e )
{
throw new TclException( interp, "couldn't find HOME environment variable to expand path" );
}
return dir;
}
 
// WARNING: Java does not support other users. "dir" is always null,
// but it should be the home directory (corresponding to the user name), as
// specified in the password file.
 
dir = null;
if ( (System.Object)dir == null )
{
throw new TclException( interp, "user \"" + user + "\" doesn't exist" );
}
return dir;
}
public static string translateFileName( Interp interp, string path )
{
string fileName = "";
 
if ( ( path.Length == 0 ) || ( path[0] != '~' ) )
{
// fileName = path;
TclObject[] joinArrayObj = new TclObject[1];
joinArrayObj[0] = TclString.newInstance( path );
fileName = joinPath( interp, joinArrayObj, 0, 1 );
}
else
{
TclObject[] splitArrayObj = TclList.getElements( interp, splitPath( interp, path ) );
 
 
string user = splitArrayObj[0].ToString().Substring( 1 );
 
 
// Strip the trailing ':' off of a Mac path
// before passing the user name to DoTildeSubst.
 
if ( ( JACL.PLATFORM == JACL.PLATFORM_MAC ) && ( user.EndsWith( ":" ) ) )
{
user = user.Substring( 0, ( user.Length - 1 ) - ( 0 ) );
}
 
user = doTildeSubst( interp, user );
 
// if (splitArrayObj.length < 2) {
// fileName = user;
// } else {
splitArrayObj[0] = TclString.newInstance( user );
fileName = joinPath( interp, splitArrayObj, 0, splitArrayObj.Length );
// }
}
 
 
// Convert forward slashes to backslashes in Windows paths because
// some system interfaces don't accept forward slashes.
 
if ( JACL.PLATFORM == JACL.PLATFORM_WINDOWS )
{
fileName = fileName.Replace( '/', '\\' );
}
return fileName;
}
internal static TclObject splitAndTranslate( Interp interp, string path )
{
TclObject splitResult = splitPath( interp, path );
 
int len = TclList.getLength( interp, splitResult );
if ( len == 1 )
{
 
string fileName = TclList.index( interp, splitResult, 0 ).ToString();
if ( fileName[0] == '~' )
{
string user = translateFileName( interp, fileName );
splitResult = splitPath( interp, user );
}
}
return splitResult;
}
} // end FileUtil class
}
/trunk/TCL/src/io/TclIO.cs
@@ -0,0 +1,294 @@
/*
* TclIO.java --
*
* Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclIO.java,v 1.9 2003/03/06 22:53:07 mdejong Exp $
*
*/
using System;
using System.Collections;
using System.IO;
 
namespace tcl.lang
{
 
public class TclIO
{
 
public const int READ_ALL = 1;
public const int READ_LINE = 2;
public const int READ_N_BYTES = 3;
 
public const int SEEK_SET = 1;
public const int SEEK_CUR = 2;
public const int SEEK_END = 3;
 
public const int RDONLY = 1;
public const int WRONLY = 2;
public const int RDWR = 4;
public const int APPEND = 8;
public const int CREAT = 16;
public const int EXCL = 32;
public const int TRUNC = 64;
 
public const int BUFF_FULL = 0;
public const int BUFF_LINE = 1;
public const int BUFF_NONE = 2;
 
public const int TRANS_AUTO = 0;
public const int TRANS_BINARY = 1;
public const int TRANS_LF = 2;
public const int TRANS_CR = 3;
public const int TRANS_CRLF = 4;
 
public static int TRANS_PLATFORM;
 
/// <summary> Table of channels currently registered for all interps. The
/// interpChanTable has "" references into this table that
/// stores the registered channels for the individual interp.
/// </summary>
 
private static StdChannel stdinChan = null;
private static StdChannel stdoutChan = null;
private static StdChannel stderrChan = null;
 
public static Channel getChannel( Interp interp, string chanName )
{
return ( (Channel)getInterpChanTable( interp )[chanName] );
}
 
 
internal static void registerChannel( Interp interp, Channel chan )
{
 
if ( interp != null )
{
Hashtable chanTable = getInterpChanTable( interp );
SupportClass.PutElement( chanTable, chan.ChanName, chan );
chan.refCount++;
}
}
 
 
internal static void unregisterChannel( Interp interp, Channel chan )
{
 
Hashtable chanTable = getInterpChanTable( interp );
SupportClass.HashtableRemove( chanTable, chan.ChanName );
 
if ( --chan.refCount <= 0 )
{
try
{
chan.close();
}
catch ( IOException e )
{
throw new TclRuntimeError( "TclIO.unregisterChannel() Error: IOException when closing " + chan.ChanName + ": " + e.Message, e );
}
}
}
 
 
public static Hashtable getInterpChanTable( Interp interp )
{
Channel chan;
 
if ( interp.interpChanTable == null )
{
 
interp.interpChanTable = new Hashtable();
 
chan = getStdChannel( StdChannel.STDIN );
registerChannel( interp, chan );
 
chan = getStdChannel( StdChannel.STDOUT );
registerChannel( interp, chan );
 
chan = getStdChannel( StdChannel.STDERR );
registerChannel( interp, chan );
}
 
return interp.interpChanTable;
}
 
 
public static Channel getStdChannel( int type )
{
Channel chan = null;
 
switch ( type )
{
 
case StdChannel.STDIN:
if ( stdinChan == null )
{
stdinChan = new StdChannel( StdChannel.STDIN );
}
chan = stdinChan;
break;
 
case StdChannel.STDOUT:
if ( stdoutChan == null )
{
stdoutChan = new StdChannel( StdChannel.STDOUT );
}
chan = stdoutChan;
break;
 
case StdChannel.STDERR:
if ( stderrChan == null )
{
stderrChan = new StdChannel( StdChannel.STDERR );
}
chan = stderrChan;
break;
 
default:
throw new TclRuntimeError( "Invalid type for StdChannel" );
 
}
 
return ( chan );
}
 
/// <summary> Really ugly function that attempts to get the next available
/// channelId name. In C the FD returned in the native open call
/// returns this value, but we don't have that so we need to do
/// this funky iteration over the Hashtable.
///
/// </summary>
/// <param name="interp">currrent interpreter.
/// </param>
/// <returns> the next integer to use in the channelId name.
/// </returns>
 
internal static string getNextDescriptor( Interp interp, string prefix )
{
int i;
Hashtable htbl = getInterpChanTable( interp );
 
// The first available file identifier in Tcl is "file3"
if ( prefix.Equals( "file" ) )
i = 3;
else
i = 0;
 
for ( ; ( htbl[prefix + i] ) != null; i++ )
{
// Do nothing...
}
return prefix + i;
}
 
/*
* Return a string description for a translation id defined above.
*/
 
internal static string getTranslationString( int translation )
{
switch ( translation )
{
 
case TRANS_AUTO:
return "auto";
 
case TRANS_CR:
return "cr";
 
case TRANS_CRLF:
return "crlf";
 
case TRANS_LF:
return "lf";
 
case TRANS_BINARY:
return "lf";
 
default:
throw new TclRuntimeError( "bad translation id" );
 
}
}
 
/*
* Return a numerical identifier for the given -translation string.
*/
 
internal static int getTranslationID( string translation )
{
if ( translation.Equals( "auto" ) )
return TRANS_AUTO;
else if ( translation.Equals( "cr" ) )
return TRANS_CR;
else if ( translation.Equals( "crlf" ) )
return TRANS_CRLF;
else if ( translation.Equals( "lf" ) )
return TRANS_LF;
else if ( translation.Equals( "binary" ) )
return TRANS_LF;
else if ( translation.Equals( "platform" ) )
return TRANS_PLATFORM;
else
return -1;
}
 
/*
* Return a string description for a -buffering id defined above.
*/
 
internal static string getBufferingString( int buffering )
{
switch ( buffering )
{
 
case BUFF_FULL:
return "full";
 
case BUFF_LINE:
return "line";
 
case BUFF_NONE:
return "none";
 
default:
throw new TclRuntimeError( "bad buffering id" );
 
}
}
 
/*
* Return a numerical identifier for the given -buffering string.
*/
 
internal static int getBufferingID( string buffering )
{
if ( buffering.Equals( "full" ) )
return BUFF_FULL;
else if ( buffering.Equals( "line" ) )
return BUFF_LINE;
else if ( buffering.Equals( "none" ) )
return BUFF_NONE;
else
return -1;
}
static TclIO()
{
{
if ( Util.Windows )
TRANS_PLATFORM = TRANS_CRLF;
else if ( Util.Mac )
TRANS_PLATFORM = TRANS_CR;
else
TRANS_PLATFORM = TRANS_LF;
}
}
}
}
/trunk/TCL/src/io/TclInputStream.cs
@@ -0,0 +1,2162 @@
#undef DEBUG
/*
* TclInputStream.java
*
* Copyright (c) 2003 Mo DeJong
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclInputStream.java,v 1.1 2003/03/08 03:42:44 mdejong Exp $
*/
 
// A TclInputStream is a cross between a Java InputStream and
// a Reader. The class supports reading raw bytes as well as
// encoded characters. It manages buffering and supports
// line oriented reading of data. It also supports a user
// configurable EOF marker and line ending translations.
using System;
using System.Text;
using System.IO;
 
namespace tcl.lang
{
 
public class TclInputStream
{
internal System.Text.Encoding Encoding
{
set
{
encoding = value;
}
 
}
internal char EofChar
{
set
{
eofChar = value;
}
 
}
internal int Translation
{
set
{
translation = value;
}
 
}
internal int Buffering
{
set
{
buffering = value;
}
 
}
internal int BufferSize
{
set
{
bufSize = value;
}
 
}
internal bool Blocking
{
set
{
blocking = value;
}
 
}
internal bool Blocked
{
get
{
return blocked;
}
 
}
/// <summary> GetInput -> getInput
///
/// Reads input data from a device into a channel buffer.
///
/// The return value is the Posix error code if an error occurred while
/// reading from the file, or 0 otherwise.
/// </summary>
private int Input
{
 
 
get
{
int toRead;
int result;
int nread;
 
// if (checkForDeadChannel()) return EINVAL;
 
// Skipped pushback processing code for stacked Channels
 
 
// See if we can fill an existing buffer. If we can, read only
// as much as will fit in it. Otherwise allocate a new buffer,
// add it to the input queue and attempt to fill it to the max.
 
ChannelBuffer buf = inQueueTail;
 
if ( ( buf != null ) && ( buf.nextAdded < buf.bufLength ) )
{
System.Diagnostics.Debug.WriteLine( "smaller than buffer" );
toRead = buf.bufLength - buf.nextAdded;
}
else
{
System.Diagnostics.Debug.WriteLine( "fits in existing buffer" );
 
buf = saveInBuf;
saveInBuf = null;
 
// Check the actual buffersize against the requested
// buffersize. Buffers which are smaller than requested are
// squashed. This is done to honor dynamic changes of the
// buffersize made by the user.
 
if ( ( buf != null ) && ( ( buf.bufLength - tcl.lang.ChannelBuffer.BUFFER_PADDING ) < bufSize ) )
{
buf = null;
}
if ( buf == null )
{
System.Diagnostics.Debug.WriteLine( "allocated ChannelBuffer of size " + bufSize );
buf = new ChannelBuffer( bufSize );
}
buf.next = null;
 
// Use the actual size of the buffer to determine
// the number of bytes to read from the channel and not the
// size for new buffers. They can be different if the
// buffersize was changed between reads.
 
toRead = buf.bufLength - buf.nextAdded;
System.Diagnostics.Debug.WriteLine( "toRead set to " + toRead );
 
if ( inQueueTail == null )
inQueueHead = buf;
else
inQueueTail.next = buf;
 
inQueueTail = buf;
}
 
// If EOF is set, we should avoid calling the driver because on some
// platforms it is impossible to read from a device after EOF.
 
if ( eofCond )
{
System.Diagnostics.Debug.WriteLine( "eofCond was true, no error return" );
return 0;
}
 
// FIXME: We do not handle non-blocking or this CHANNEL_TIMER_FEV flag yet
 
if ( !blocking )
{
return TclPosixException.EWOULDBLOCK;
}
else
{
result = 0;
 
// Can we even use this for a brain-dead nonblocking IO check?
int numAvailable = 0;
 
if ( !blocking && ( numAvailable < toRead ) )
{
result = TclPosixException.EWOULDBLOCK;
nread = -1;
}
else
{
try
{
System.Diagnostics.Debug.WriteLine( "now to read " + toRead + " bytes" );
if ( input == null )
input = System.Console.OpenStandardInput();
nread = SupportClass.ReadInput( input, ref buf.buf, buf.nextAdded, toRead );
 
// read() returns -1 on EOF
if ( nread == -1 )
{
System.Diagnostics.Debug.WriteLine( "got EOF from read() call" );
nread = 0;
}
}
catch ( IOException ex )
{
// FIXME: How do we recover from IO errors here?
// I think we need to set result to a POSIX error
SupportClass.WriteStackTrace( ex, System.Console.Error );
nread = -1;
}
}
}
 
if ( nread > 0 )
{
System.Diagnostics.Debug.WriteLine( "nread is " + nread );
buf.nextAdded += nread;
 
// should avoid calling the driver because on some platforms we
// will block in the low level reading code even though the
// channel is set into nonblocking mode.
 
if ( nread < toRead )
{
blocked = true;
}
}
else if ( nread == 0 )
{
System.Diagnostics.Debug.WriteLine( "nread is zero" );
eofCond = true;
encodingEnd = true;
}
else if ( nread < 0 )
{
System.Diagnostics.Debug.WriteLine( "nread is " + nread );
if ( ( result == TclPosixException.EWOULDBLOCK ) || ( result == TclPosixException.EAGAIN ) )
{
blocked = true;
result = TclPosixException.EAGAIN;
}
// FIXME: Called needs to raise a TclException
//Tcl_SetErrno(result);
return result;
}
System.Diagnostics.Debug.WriteLine( "no error return" );
return 0;
}
 
}
/// <summary> Tcl_InputBuffered -> getNumBufferedBytes
///
/// Return the number of bytes that are current buffered.
/// </summary>
internal int NumBufferedBytes
{
 
 
get
{
ChannelBuffer buf;
int IOQueued;
for ( IOQueued = 0, buf = inQueueHead; buf != null; buf = buf.next )
{
IOQueued += buf.nextAdded - buf.nextRemoved;
}
return IOQueued;
}
 
}
 
/// <summary> The Java byte stream object we pull data in from.</summary>
 
private Stream input;
 
/// <summary> If nonzero, use this character as EOF marker.</summary>
 
private char eofChar;
 
/// <summary> Flag that is set on each read. If the read encountered EOF
/// or a custom eofChar is found, the it is set to true.
/// </summary>
 
private bool eofCond = false;
private bool stickyEofCond = false;
 
/// <summary> Translation mode for end-of-line character</summary>
 
protected internal int translation;
 
/// <summary> Name of Java encoding for this Channel.
/// A null value means use no encoding (binary).
/// </summary>
 
protected internal System.Text.Encoding encoding;
 
/// <summary> Current converter object. A null value means
/// that no conversions have been done yet.
/// </summary>
 
protected internal Decoder btc = null;
 
/// <summary> Buffering</summary>
 
protected internal int buffering;
 
/// <summary> Blocking</summary>
 
protected internal bool blocking;
 
/// <summary> Blocked</summary>
 
protected internal bool blocked = false;
 
/// <summary> Buffer size in bytes</summary>
 
protected internal int bufSize;
 
/// <summary> Used to track EOL state</summary>
 
protected internal bool needNL = false;
protected internal bool sawCR_Renamed_Field = false;
 
protected internal bool needMoreData = false;
 
/// <summary> Flags used to track encoding states.
/// The encodingState member of called inputEncodingState
/// in the C ChannelState type. The encodingStart and encodingEnd
/// members combined are called inputEncodingFlags
/// and have the bit values TCL_ENCODING_END and TCL_ENCODING_START.
/// </summary>
 
internal Object encodingState = null;
internal bool encodingStart = true;
internal bool encodingEnd = false;
 
/// <summary> First and last buffers in the input queue.</summary>
 
internal ChannelBuffer inQueueHead = null;
internal ChannelBuffer inQueueTail = null;
internal ChannelBuffer saveInBuf = null;
 
/// <summary> Constructor for Tcl input stream class. We require
/// a byte stream source at init time, the stram can't
/// be changed after the TclInputStream is created.
/// </summary>
 
internal TclInputStream( Stream inInput )
{
input = inInput;
}
 
// Helper used by getsObj and filterBytes
 
internal class GetsState
{
public GetsState( TclInputStream enclosingInstance )
{
InitBlock( enclosingInstance );
}
private void InitBlock( TclInputStream enclosingInstance )
{
this.enclosingInstance = enclosingInstance;
rawRead = new IntPtr();
charsWrote = new IntPtr();
}
private TclInputStream enclosingInstance;
public TclInputStream Enclosing_Instance
{
get
{
return enclosingInstance;
}
 
}
internal TclObject obj;
//int dst;
internal System.Text.Encoding encoding;
internal ChannelBuffer buf;
internal Object state;
internal IntPtr rawRead;
IntPtr bytesWrote = new IntPtr();
internal IntPtr charsWrote;
internal int totalChars;
}
 
/// <summary> Tcl_GetsObj -> getsObj
///
/// Accumulate input from the input channel until end-of-line or
/// end-of-file has been seen. Bytes read from the input channel
/// are converted to Unicode using the encoding specified by the
/// channel.
///
/// Returns the number of characters accumulated in the object
/// or -1 if error, blocked, or EOF. If -1, use Tcl_GetErrno()
/// to retrieve the POSIX error code for the error or condition
/// that occurred.
///
/// FIXME: Above setting of error code is not fully implemented.
///
/// Will consume input from the channel.
/// On reading EOF, leave channel at EOF char.
/// On reading EOL, leave channel after EOL, but don't
/// return EOL in dst buffer.
/// </summary>
 
internal int getsObj( TclObject obj )
{
GetsState gs;
ChannelBuffer buf;
bool oldEncodingStart, oldEncodingEnd;
int oldRemoved, skip, inEofChar;
int copiedTotal, oldLength;
bool in_binary_encoding = false;
int dst, dstEnd, eol, eof;
Object oldState;
 
buf = inQueueHead;
//encoding = this.encoding;
 
// Preserved so we can restore the channel's state in case we don't
// find a newline in the available input.
 
oldLength = 0;
oldEncodingStart = encodingStart;
oldEncodingEnd = encodingEnd;
oldState = encodingState;
oldRemoved = tcl.lang.ChannelBuffer.BUFFER_PADDING;
if ( buf != null )
{
oldRemoved = buf.nextRemoved;
}
 
// If there is no encoding, use "iso8859-1" -- readLine() doesn't
// produce ByteArray objects.
 
if ( (System.Object)encoding == null )
{
in_binary_encoding = true;
encoding = EncodingCmd.getJavaName( "utf-8" );
}
 
System.Diagnostics.Debug.WriteLine( "getsObj encoding is " + encoding );
 
// Object used by filterBytes to keep track of how much data has
// been consumed from the channel buffers.
 
gs = new GetsState( this );
gs.obj = obj;
//gs.dst = &dst;
gs.encoding = encoding;
gs.buf = buf;
gs.state = oldState;
gs.rawRead.i = 0;
//gs.bytesWrote.i = 0;
gs.charsWrote.i = 0;
gs.totalChars = 0;
 
// Ensure that tobj is an empty TclString object.
// Cheat a bit and grab the StringBuffer out of
// the TclString so we can query the data that
// was just added to the buffer.
TclString.empty( obj );
StringBuilder obj_sbuf = ( (TclString)obj.InternalRep ).sbuf;
 
dst = 0;
dstEnd = dst;
 
skip = 0;
eof = -1;
inEofChar = eofChar;
 
// Used to implement goto like functionality for restore
// and goteol loop terminaltion blocks.
 
bool restore = false;
bool goteol = false;
 
// This is just here so that eol and copiedTotal are
// definitely assigned before the try block.
eol = -1;
copiedTotal = -1;
 
{
while ( true )
{
if ( dst >= dstEnd )
{
if ( filterBytes( gs ) != 0 )
{
restore = true;
goto restore_or_goteol_brk; //goto restore
}
dstEnd += gs.charsWrote.i; // dstEnd = dst + gs.bytesWrote;
}
 
// Remember if EOF char is seen, then look for EOL anyhow, because
// the EOL might be before the EOF char.
 
if ( inEofChar != '\x0000' )
{
for ( eol = dst; eol < dstEnd; eol++ )
{
if ( obj_sbuf[eol] == inEofChar )
{
dstEnd = eol;
eof = eol;
break;
}
}
}
 
// On EOL, leave current file position pointing after the EOL, but
// don't store the EOL in the output string.
 
switch ( translation )
{
 
case TclIO.TRANS_LF:
{
for ( eol = dst; eol < dstEnd; eol++ )
{
if ( obj_sbuf[eol] == '\n' )
{
skip = 1;
goteol = true;
goto restore_or_goteol_brk; //goto goteol
}
}
break;
}
 
case TclIO.TRANS_CR:
{
for ( eol = dst; eol < dstEnd; eol++ )
{
if ( obj_sbuf[eol] == '\r' )
{
skip = 1;
goteol = true;
goto restore_or_goteol_brk; //goto goteol
}
}
break;
}
 
case TclIO.TRANS_CRLF:
{
for ( eol = dst; eol < dstEnd; eol++ )
{
if ( obj_sbuf[eol] == '\r' )
{
eol++;
 
// If a CR is at the end of the buffer,
// then check for a LF at the begining
// of the next buffer.
 
if ( eol >= dstEnd )
{
//int offset;
 
//offset = eol - objPtr->bytes;
dst = dstEnd;
if ( filterBytes( gs ) != 0 )
{
restore = true;
goto restore_or_goteol_brk; //goto restore
}
dstEnd += gs.charsWrote.i; // dstEnd = dst + gs.bytesWrote
//eol = objPtr->bytes + offset;
if ( eol >= dstEnd )
{
skip = 0;
goteol = true;
goto restore_or_goteol_brk; //goto goteol
}
}
if ( obj_sbuf[eol] == '\n' )
{
eol--;
skip = 2;
goteol = true;
goto restore_or_goteol_brk; //goto goteol
}
}
}
break;
}
 
case TclIO.TRANS_AUTO:
{
eol = dst;
skip = 1;
if ( sawCR_Renamed_Field )
{
sawCR_Renamed_Field = false;
if ( ( eol < dstEnd ) && ( obj_sbuf[eol] == '\n' ) )
{
// Skip the raw bytes that make up the '\n'.
 
char[] tmp = new char[1];
IntPtr rawRead = new IntPtr( this );
 
buf = gs.buf;
// FIXME: We don't actually pass gs.state here, should we?
//if (btc != null) btc.reset();
externalToUnicode( buf.buf, buf.nextRemoved, gs.rawRead.i, tmp, 0, 1, rawRead, null, null );
buf.nextRemoved += rawRead.i;
gs.rawRead.i -= rawRead.i;
//gs.bytesWrote.i--;
gs.charsWrote.i--;
obj_sbuf.Remove( dst, 1 );
dstEnd--;
}
}
for ( eol = dst; eol < dstEnd; eol++ )
{
if ( obj_sbuf[eol] == '\r' )
{
eol++;
if ( eol == dstEnd )
{
// If buffer ended on \r, peek ahead to see if a
// \n is available.
 
//int offset;
IntPtr dstEndPtr = new IntPtr();
 
//offset = eol /* - objPtr->bytes*/;
dst = dstEnd;
 
// FIXME: Why does this peek in AUTO mode
// but filter in CRLF mode?
peekAhead( gs );
//dstEnd = dstEndPtr.i;
dstEnd += gs.charsWrote.i;
//eol = /*objPtr->bytes + */ offset;
if ( eol >= dstEnd )
{
eol--;
sawCR_Renamed_Field = true;
goteol = true;
goto restore_or_goteol_brk; //goto goteol
}
}
if ( obj_sbuf[eol] == '\n' )
{
skip++;
}
eol--;
goteol = true; //goto goteol
goto restore_or_goteol_brk;
}
else if ( obj_sbuf[eol] == '\n' )
{
goteol = true;
goto restore_or_goteol_brk; //goto goteol
}
}
}
break;
}
if ( eof != -1 )
{
// EOF character was seen. On EOF, leave current file position
// pointing at the EOF character, but don't store the EOF
// character in the output string.
 
dstEnd = eof;
eofCond = true;
stickyEofCond = true;
encodingEnd = true;
}
if ( eofCond )
{
skip = 0;
eol = dstEnd;
if ( eol == oldLength )
{
// If we didn't append any bytes before encountering EOF,
// caller needs to see -1.
 
obj_sbuf.Length = oldLength;
commonGetsCleanup();
copiedTotal = -1;
goto restore_or_goteol_brk; //goto done
}
goteol = true;
goto restore_or_goteol_brk; //goto goteol
}
dst = dstEnd;
}
}
 
restore_or_goteol_brk:
;
// end restore_or_goteol: block
 
if ( goteol )
{
// Found EOL or EOF, but the output buffer may now contain too many
// characters. We need to know how many raw bytes correspond to
// the number of characters we want, plus how many raw bytes
// correspond to the character(s) making up EOL (if any), so we can
// remove the correct number of bytes from the channel buffer.
 
int linelen = eol - dst + skip;
char[] tmp = new char[linelen];
 
buf = gs.buf;
encodingState = gs.state;
if ( btc != null )
{
btc = this.encoding.GetDecoder();
}
externalToUnicode( buf.buf, buf.nextRemoved, gs.rawRead.i, tmp, 0, linelen, gs.rawRead, null, gs.charsWrote );
buf.nextRemoved += gs.rawRead.i;
 
// Recycle all the emptied buffers.
 
obj_sbuf.Length = eol;
commonGetsCleanup();
blocked = false;
copiedTotal = gs.totalChars + gs.charsWrote.i - skip;
}
if ( restore )
{
// Couldn't get a complete line. This only happens if we get a error
// reading from the channel or we are non-blocking and there wasn't
// an EOL or EOF in the data available.
 
buf = inQueueHead;
buf.nextRemoved = oldRemoved;
 
for ( buf = buf.next; buf != null; buf = buf.next )
{
buf.nextRemoved = tcl.lang.ChannelBuffer.BUFFER_PADDING;
}
commonGetsCleanup();
 
encodingState = oldState;
//if (btc != null) btc.reset(); // Not sure we want to reset encoder state here
encodingStart = oldEncodingStart;
encodingEnd = oldEncodingEnd;
obj_sbuf.Length = oldLength;
 
// We didn't get a complete line so we need to indicate to UpdateInterest
// that the gets blocked. It will wait for more data instead of firing
// a timer, avoiding a busy wait. This is where we are assuming that the
// next operation is a gets. No more file events will be delivered on
// this channel until new data arrives or some operation is performed
// on the channel (e.g. gets, read, fconfigure) that changes the blocking
// state. Note that this means a file event will not be delivered even
// though a read would be able to consume the buffered data.
 
needMoreData = true;
copiedTotal = -1;
}
 
// Update the notifier state so we don't block while there is still
// data in the buffers.
 
//done:
// Reset original encoding in case it was set to binary
if ( in_binary_encoding )
encoding = null;
 
updateInterest();
 
// FIXME: copiedTotal seems to be returning incorrect values
// for some tests, need to make caller code use the return
// value instead of the length of the returned object before
// these errors can be detected by the test suite.
return copiedTotal;
}
 
/// <summary> FilterInputBytes -> filterBytes
///
/// Helper function for getsObj. Appends Unicode characters
/// onto the TclObject associated with the GetsState after
/// converting them from raw bytes encoded in the Channel.
///
/// Consumes available bytes from channel buffers. When channel
/// buffers are exhausted, reads more bytes from channel device into
/// a new channel buffer. It is the caller's responsibility to
/// free the channel buffers that have been exhausted.
///
/// The return value is -1 if there was an error reading from the
/// channel, 0 otherwise.
///
/// FIXME: Doc modification of object's StringBuffer
///
/// Status object keeps track of how much data from channel buffers
/// has been consumed and where characters should be stored.
/// </summary>
 
internal int filterBytes( GetsState gs )
{
ChannelBuffer buf;
byte[] raw;
int rawStart, rawEnd;
char[] dst;
int offset, toRead, spaceLeft, result, rawLen, length;
TclObject obj;
int ENCODING_LINESIZE = 20; // Lower bound on how many bytes
// to convert at a time. Since we
// don't know a priori how many
// bytes of storage this many
// source bytes will use, we
// actually need at least
// ENCODING_LINESIZE bytes of room.
 
bool goto_read = false; // Set to true when jumping to the read
// label, used to simulate a goto.
 
obj = gs.obj;
 
// Subtract the number of bytes that were removed from channel buffer
// during last call.
 
buf = gs.buf;
if ( buf != null )
{
buf.nextRemoved += gs.rawRead.i;
if ( buf.nextRemoved >= buf.nextAdded )
{
buf = buf.next;
}
}
gs.totalChars += gs.charsWrote.i;
 
while ( true )
{
if ( goto_read || ( buf == null ) || ( buf.nextAdded == tcl.lang.ChannelBuffer.BUFFER_PADDING ) )
{
// All channel buffers were exhausted and the caller still hasn't
// seen EOL. Need to read more bytes from the channel device.
// Side effect is to allocate another channel buffer.
 
//read:
if ( blocked )
{
if ( !blocking )
{
gs.charsWrote.i = 0;
gs.rawRead.i = 0;
return -1;
}
blocked = false;
}
if ( Input != 0 )
{
gs.charsWrote.i = 0;
gs.rawRead.i = 0;
return -1;
}
buf = inQueueTail;
gs.buf = buf;
}
 
// Convert some of the bytes from the channel buffer to characters.
// Space in obj's string rep is used to hold the characters.
 
rawStart = buf.nextRemoved;
raw = buf.buf;
rawEnd = buf.nextAdded;
rawLen = rawEnd - rawStart;
 
//dst = *gsPtr->dstPtr;
//offset = dst - objPtr->bytes;
toRead = ENCODING_LINESIZE;
if ( toRead > rawLen )
{
toRead = rawLen;
}
//dstNeeded = toRead * TCL_UTF_MAX + 1;
//spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
//if (dstNeeded > spaceLeft) {
// length = offset * 2;
// if (offset < dstNeeded) {
// length = offset + dstNeeded;
// }
// length += TCL_UTF_MAX + 1;
// Tcl_SetObjLength(objPtr, length);
// spaceLeft = length - offset;
// dst = objPtr->bytes + offset;
// *gsPtr->dstPtr = dst;
//}
dst = new char[toRead];
gs.state = encodingState;
result = externalToUnicode( raw, rawStart, rawLen, dst, 0, toRead, gs.rawRead, null, gs.charsWrote );
TclString.append( gs.obj, dst, 0, gs.charsWrote.i );
 
// Make sure that if we go through 'gets', that we reset the
// TCL_ENCODING_START flag still.
 
encodingStart = false;
 
if ( result == TCL_CONVERT_MULTIBYTE )
{
// The last few bytes in this channel buffer were the start of a
// multibyte sequence. If this buffer was full, then move them to
// the next buffer so the bytes will be contiguous.
 
ChannelBuffer next;
int extra;
 
next = buf.next;
if ( buf.nextAdded < buf.bufLength )
{
if ( gs.rawRead.i > 0 )
{
// Some raw bytes were converted to UTF-8. Fall through,
// returning those UTF-8 characters because a EOL might be
// present in them.
}
else if ( eofCond )
{
// There was a partial character followed by EOF on the
// device. Fall through, returning that nothing was found.
 
buf.nextRemoved = buf.nextAdded;
}
else
{
// There are no more cached raw bytes left. See if we can
// get some more.
 
goto_read = true;
goto read; //goto read;
}
}
else
{
if ( next == null )
{
next = new ChannelBuffer( bufSize );
buf.next = next;
inQueueTail = next;
}
extra = rawLen - gs.rawRead.i;
Array.Copy( raw, gs.rawRead.i, next.buf, tcl.lang.ChannelBuffer.BUFFER_PADDING - extra, extra );
next.nextRemoved -= extra;
buf.nextAdded -= extra;
}
}
 
goto read_brk; // End loop in the normal case
 
read:
;
}
 
read_brk:
;
 
 
gs.buf = buf;
return 0;
}
 
/// <summary> PeekAhead -> peekAhead
///
/// Helper function used by getsObj. Called when we've seen a
/// \r at the end of the string and want to look ahead one
/// character to see if it is a \n.
///
/// Characters read from the channel are appended to gs.obj
/// via the filterBytes method.
/// </summary>
 
internal void peekAhead( GetsState gs )
{
ChannelBuffer buf;
//Tcl_DriverBlockModeProc *blockModeProc;
int bytesLeft;
bool goto_cleanup = false; // Set to true when jumping to the
// cleanup label, used to simulate a goto.
 
buf = gs.buf;
 
// If there's any more raw input that's still buffered, we'll peek into
// that. Otherwise, only get more data from the channel driver if it
// looks like there might actually be more data. The assumption is that
// if the channel buffer is filled right up to the end, then there
// might be more data to read.
 
{
//blockModeProc = NULL;
if ( buf.next == null )
{
bytesLeft = buf.nextAdded - ( buf.nextRemoved + gs.rawRead.i );
if ( bytesLeft == 0 )
{
if ( buf.nextAdded < buf.bufLength )
{
// Don't peek ahead if last read was short read.
goto_cleanup = true;
goto cleanup_brk;
}
// FIXME: This non-blocking check is currently disabled, non-blocking
// is not currently supported and it is not clean why we would
// need to depend on non-blocking IO when peeking anyway.
if ( blocking )
{
//blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
//if (false)
//{
// // Don't peek ahead if cannot set non-blocking mode.
// goto_cleanup = true;
// goto cleanup_brk;
//}
//StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
}
}
}
//if (filterBytes(gs) == 0) {
// dstEndPtr.i = gs.charsWrote.i; *gsPtr->dstPtr + gs.bytesWrote.i
//}
filterBytes( gs );
//if (blockModeProc != NULL) {
// StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
//}
}
 
cleanup_brk:
;
 
 
if ( goto_cleanup )
{
buf.nextRemoved += gs.rawRead.i;
gs.rawRead.i = 0;
gs.totalChars += gs.charsWrote.i;
//gs.bytesWrote.i = 0;
gs.charsWrote.i = 0;
}
}
 
/// <summary> CommonGetsCleanup -> commonGetsCleanup
///
/// Helper function used by getsObj to restore the channel after
/// a "gets" operation.
///
/// </summary>
 
internal void commonGetsCleanup()
{
ChannelBuffer buf, next;
 
buf = inQueueHead;
for ( ; buf != null; buf = next )
{
next = buf.next;
if ( buf.nextRemoved < buf.nextAdded )
{
break;
}
recycleBuffer( buf, false );
}
inQueueHead = buf;
if ( buf == null )
{
inQueueTail = null;
}
else
{
// If any multi-byte characters were split across channel buffer
// boundaries, the split-up bytes were moved to the next channel
// buffer by filterBytes(). Move the bytes back to their
// original buffer because the caller could change the channel's
// encoding which could change the interpretation of whether those
// bytes really made up multi-byte characters after all.
 
next = buf.next;
for ( ; next != null; next = buf.next )
{
int extra;
 
extra = buf.bufLength - buf.nextAdded;
if ( extra > 0 )
{
Array.Copy( next.buf, tcl.lang.ChannelBuffer.BUFFER_PADDING - extra, buf.buf, buf.nextAdded, extra );
buf.nextAdded += extra;
next.nextRemoved = tcl.lang.ChannelBuffer.BUFFER_PADDING;
}
buf = next;
}
}
if ( (System.Object)encoding != null )
{
//Tcl_FreeEncoding(encoding);
}
}
 
// CloseChannel -> close
 
internal void close()
{
discardQueued( true );
// FIXME: More close logic in CloseChannel
}
 
internal bool eof()
{
return eofCond;
}
 
internal bool sawCR()
{
return sawCR_Renamed_Field;
}
 
// Helper class to implement integer pass by reference
// for methods like doReadChars, readBytes and so on.
 
internal class IntPtr
{
private void InitBlock( TclInputStream enclosingInstance )
{
this.enclosingInstance = enclosingInstance;
}
private TclInputStream enclosingInstance;
public TclInputStream Enclosing_Instance
{
get
{
return enclosingInstance;
}
 
}
internal int i;
 
internal IntPtr()
{
}
internal IntPtr( TclInputStream enclosingInstance )
{
InitBlock( enclosingInstance );
}
 
internal IntPtr( TclInputStream enclosingInstance, int value )
{
InitBlock( enclosingInstance );
i = value;
}
}
 
/// <summary> DoReadChars -> doReadChars
///
/// Reads from the channel until the requested number of characters
/// have been seen, EOF is seen, or the channel would block. EOL
/// and EOF translation is done. If reading binary data, the raw
/// bytes are wrapped in a Tcl byte array object. Otherwise, the raw
/// bytes are converted to characters using the channel's current
/// encoding and stored in a Tcl string object.
///
/// </summary>
/// <param name="obj">Input data is stored in this object.
/// </param>
/// <param name="toRead">Maximum number of characters to store,
/// or -1 to read all available data (up to EOF
/// or when channel blocks).
/// </param>
 
internal int doReadChars( TclObject obj, int toRead )
{
ChannelBuffer buf;
int copied, copiedNow, result;
IntPtr offset = new IntPtr( this );
 
if ( (System.Object)encoding == null )
{
TclByteArray.setLength( null, obj, 0 );
}
else
{
TclString.empty( obj );
}
offset.i = 0;
 
// if toRead is negative, read until EOF
if ( toRead < 0 )
{
toRead = System.Int32.MaxValue;
}
 
{
for ( copied = 0; toRead > 0; )
{
copiedNow = -1;
if ( inQueueHead != null )
{
if ( (System.Object)encoding == null )
{
System.Diagnostics.Debug.WriteLine( "calling readBytes " + toRead );
copiedNow = readBytes( obj, toRead, offset );
}
else
{
System.Diagnostics.Debug.WriteLine( "calling readChars " + toRead );
copiedNow = readChars( obj, toRead );
}
 
// If the current buffer is empty recycle it.
 
buf = inQueueHead;
System.Diagnostics.Debug.WriteLine( "after read* buf.nextRemoved is " + buf.nextRemoved );
System.Diagnostics.Debug.WriteLine( "after read* buf.nextAdded is " + buf.nextAdded );
 
if ( buf.nextRemoved == buf.nextAdded )
{
System.Diagnostics.Debug.WriteLine( "recycling empty buffer" );
ChannelBuffer next;
 
next = buf.next;
recycleBuffer( buf, false );
inQueueHead = next;
if ( next == null )
{
System.Diagnostics.Debug.WriteLine( "inQueueTail set to null" );
inQueueTail = null;
}
else
{
System.Diagnostics.Debug.WriteLine( "inQueueTail is not null" );
}
}
}
if ( copiedNow < 0 )
{
System.Diagnostics.Debug.WriteLine( "copiedNow < 0" );
if ( eofCond )
{
System.Diagnostics.Debug.WriteLine( "eofCond" );
break;
}
if ( blocked )
{
System.Diagnostics.Debug.WriteLine( "blocked" );
if ( !blocking )
{
break;
}
blocked = false;
}
result = Input;
if ( result != 0 )
{
System.Diagnostics.Debug.WriteLine( "non-zero result" );
if ( result == TclPosixException.EAGAIN )
{
break;
}
copied = -1;
goto done_brk; //goto done
}
}
else
{
copied += copiedNow;
System.Diagnostics.Debug.WriteLine( "copied incremented to " + copied );
toRead -= copiedNow;
System.Diagnostics.Debug.WriteLine( "toRead decremented to " + toRead );
}
}
 
blocked = false;
 
if ( (System.Object)encoding == null )
{
TclByteArray.setLength( null, obj, offset.i );
System.Diagnostics.Debug.WriteLine( "set byte array length to " + offset.i );
}
}
 
done_brk:
;
// end done: block
 
//done:
updateInterest();
 
#if DEBUG
System.Diagnostics.Debug.WriteLine("returning copied = " + copied);
System.Diagnostics.Debug.WriteLine("returning string \"" + obj + "\"");
obj.invalidateStringRep();
System.Diagnostics.Debug.WriteLine("returning string \"" + obj + "\"");
#endif
 
return copied;
}
 
/// <summary> ReadBytes -> readBytes
///
/// Reads from the channel until the requested number of
/// bytes have been seen, EOF is seen, or the channel would
/// block. Bytes from the channel are stored in obj as a
/// ByteArray object. EOL and EOF translation are done.
///
/// 'bytesToRead' can safely be a very large number because
/// space is only allocated to hold data read from the channel
/// as needed.
///
/// The return value is the number of bytes appended to
/// the object.
///
/// </summary>
/// <param name="obj,">the TclByteArrayObject we are operating on
/// </param>
/// <param name="bytesToRead,">Maximum number of bytes to store.
/// Bytes are obtained from the first
/// buffer in the queue -- even if this number
/// is larger than the number of bytes only
/// the bytes from the first buffer are returned.
/// </param>
/// <param name="offsetPtr"> On input, contains how many bytes of
/// obj have been used to hold data. On
/// output, how many bytes are now being used.
/// </param>
 
internal int readBytes( TclObject obj, int bytesToRead, IntPtr offsetPtr )
{
int toRead, srcOff, srcLen, offset, length;
ChannelBuffer buf;
IntPtr srcRead, dstWrote;
byte[] src, dst;
 
offset = offsetPtr.i;
 
buf = inQueueHead;
src = buf.buf;
srcOff = buf.nextRemoved;
srcLen = buf.nextAdded - buf.nextRemoved;
 
System.Diagnostics.Debug.WriteLine( "readBytes() : src buffer len is " + buf.buf.Length );
System.Diagnostics.Debug.WriteLine( "readBytes() : buf.nextRemoved is " + buf.nextRemoved );
System.Diagnostics.Debug.WriteLine( "readBytes() : buf.nextAdded is " + buf.nextAdded );
 
toRead = bytesToRead;
if ( toRead > srcLen )
{
toRead = srcLen;
System.Diagnostics.Debug.WriteLine( "readBytes() : toRead set to " + toRead );
}
 
length = TclByteArray.getLength( null, obj );
dst = TclByteArray.getBytes( null, obj );
System.Diagnostics.Debug.WriteLine( "readBytes() : toRead is " + toRead );
System.Diagnostics.Debug.WriteLine( "readBytes() : length is " + length );
System.Diagnostics.Debug.WriteLine( "readBytes() : array length is " + dst.Length );
 
if ( toRead > length - offset - 1 )
{
System.Diagnostics.Debug.WriteLine( "readBytes() : TclObject too small" );
 
// Double the existing size of the object or make enough room to
// hold all the characters we may get from the source buffer,
// whichever is larger.
 
length = offset * 2;
if ( offset < toRead )
{
length = offset + toRead + 1;
}
dst = TclByteArray.setLength( null, obj, length );
}
 
if ( needNL )
{
needNL = false;
if ( ( srcLen == 0 ) || ( src[srcOff] != '\n' ) )
{
dst[offset] = (byte)SupportClass.Identity( '\r' );
offsetPtr.i += 1;
return 1;
}
dst[offset++] = (byte)SupportClass.Identity( '\n' );
srcOff++;
srcLen--;
toRead--;
}
 
srcRead = new IntPtr( this, srcLen );
dstWrote = new IntPtr( this, toRead );
 
if ( translateEOL( dst, offset, src, srcOff, dstWrote, srcRead ) != 0 )
{
if ( dstWrote.i == 0 )
{
return -1;
}
}
 
buf.nextRemoved += srcRead.i;
offsetPtr.i += dstWrote.i;
return dstWrote.i;
}
 
/// <summary> ReadChars -> readChars
///
/// Reads from the channel until the requested number of
/// characters have been seen, EOF is seen, or the channel would
/// block. Raw bytes from the channel are converted to characters
/// and stored in obj. EOL and EOF translation is done.
///
/// 'charsToRead' can safely be a very large number because
/// space is only allocated to hold data read from the channel
/// as needed.
///
/// The return value is the number of characters appended to
/// the object.
///
/// </summary>
/// <param name="obj,">the TclByteArrayObject we are operating on
/// </param>
/// <param name="charsToRead,">Maximum number of chars to store.
/// Chars are obtained from the first
/// buffer in the queue -- even if this number
/// is larger than the number of chars only
/// the chars from the first buffer are returned.
/// </param>
 
internal int readChars( TclObject obj, int charsToRead )
{
int toRead, factor, spaceLeft, length, srcLen, dstNeeded;
int srcOff, dstOff;
IntPtr srcRead, numChars, dstRead, dstWrote;
ChannelBuffer buf;
byte[] src;
char[] dst;
 
Object oldState;
 
srcRead = new IntPtr( this );
numChars = new IntPtr( this );
dstRead = new IntPtr( this );
dstWrote = new IntPtr( this );
 
buf = inQueueHead;
src = buf.buf;
srcOff = buf.nextRemoved;
srcLen = buf.nextAdded - buf.nextRemoved;
 
/* FIXME: Include final Tcl patch for srcLen == 0 case */
 
if ( srcLen == 0 )
{
if ( needNL )
{
TclString.append( obj, "\r" );
return 1;
}
return -1;
}
 
toRead = charsToRead;
if ( toRead > srcLen )
{
toRead = srcLen;
}
 
// FIXME : Do something to cache conversion buffer, or it might also
// to pass the TclObject directly into the externalToUnicode method
// so as to avoid the need for this extra buffer.
dstNeeded = toRead;
dst = new char[dstNeeded];
dstOff = 0;
 
oldState = encodingState;
if ( needNL )
{
// We want a '\n' because the last character we saw was '\r'.
needNL = false;
 
externalToUnicode( src, srcOff, srcLen, dst, dstOff, 1, srcRead, dstWrote, numChars );
if ( ( numChars.i > 0 ) && ( dst[dstOff] == '\n' ) )
{
// The next char was a '\n'. Consume it and produce a '\n'.
buf.nextRemoved += srcRead.i;
}
else
{
// The next char was not a '\n'. Produce a '\r'.
dst[dstOff] = '\r';
}
encodingStart = false;
TclString.append( obj, dst, dstOff, 1 );
return 1;
}
 
externalToUnicode( src, srcOff, srcLen, dst, dstOff, dstNeeded, srcRead, dstWrote, numChars );
 
// This block is disabled since the char converter does
// not inform us about partial chars, instead it silently
// stores the partial character internally.
 
//if (false && srcRead.i == 0)
//{
// // Not enough bytes in src buffer to make a complete char. Copy
// // the bytes to the next buffer to make a new contiguous string,
// // then tell the caller to fill the buffer with more bytes.
 
// ChannelBuffer next;
 
// next = buf.next;
// if (next == null)
// {
// if (srcLen > 0)
// {
// // There isn't enough data in the buffers to complete the next
// // character, so we need to wait for more data before the next
// // file event can be delivered.
// //
// // The exception to this is if the input buffer was
// // completely empty before we tried to convert its
// // contents. Nothing in, nothing out, and no incomplete
// // character data. The conversion before the current one
// // was complete.
 
// needMoreData = true;
// }
// return - 1;
// }
// next.nextRemoved -= srcLen;
// Array.Copy(src, srcOff, next.buf, next.nextRemoved, srcLen);
// recycleBuffer(buf, false);
// inQueueHead = next;
// return readChars(obj, charsToRead);
//}
 
dstRead.i = dstWrote.i;
if ( translateEOL( dst, dstOff, dst, dstOff, dstWrote, dstRead ) != 0 )
{
// Hit EOF char. How many bytes of src correspond to where the
// EOF was located in dst? Run the conversion again with an
// output buffer just big enough to hold the data so we can
// get the correct value for srcRead.
 
if ( dstWrote.i == 0 )
{
return -1;
}
encodingState = oldState;
if ( btc != null )
{
btc = this.encoding.GetDecoder();
}
externalToUnicode( src, srcOff, srcLen, dst, dstOff, dstRead.i, srcRead, dstWrote, numChars );
translateEOL( dst, dstOff, dst, dstOff, dstWrote, dstRead );
}
 
// The number of characters that we got may be less than the number
// that we started with because "\r\n" sequences may have been
// turned into just '\n' in dst.
 
numChars.i -= ( dstRead.i - dstWrote.i );
 
if ( numChars.i > toRead )
{
// Got too many chars.
 
int eof;
eof = toRead;
encodingState = oldState;
if ( btc != null )
{
btc = this.encoding.GetDecoder();
}
externalToUnicode( src, srcOff, srcLen, dst, dstOff, ( eof - dstOff ), srcRead, dstWrote, numChars );
dstRead.i = dstWrote.i;
translateEOL( dst, dstOff, dst, dstOff, dstWrote, dstRead );
numChars.i -= ( dstRead.i - dstWrote.i );
}
encodingStart = false;
 
buf.nextRemoved += srcRead.i;
 
TclString.append( obj, dst, dstOff, numChars.i );
 
return numChars.i;
}
 
// FIXME: Only define the ones that we actually need/use.
 
// The following definitions are the error codes returned by externalToUnicode
//
// TCL_OK: All characters were converted.
//
// TCL_CONVERT_NOSPACE: The output buffer would not have been large
// enough for all of the converted data; as many
// characters as could fit were converted though.
//
// TCL_CONVERT_MULTIBYTE: The last few bytes in the source string were
// the beginning of a multibyte sequence, but
// more bytes were needed to complete this
// sequence. A subsequent call to the conversion
// routine should pass the beginning of this
// unconverted sequence plus additional bytes
// from the source stream to properly convert
// the formerly split-up multibyte sequence.
//
// TCL_CONVERT_SYNTAX: The source stream contained an invalid
// character sequence. This may occur if the
// input stream has been damaged or if the input
// encoding method was misidentified. This error
// is reported only if TCL_ENCODING_STOPONERROR
// was specified.
//
// TCL_CONVERT_UNKNOWN: The source string contained a character
// that could not be represented in the target
// encoding. This error is reported only if
// TCL_ENCODING_STOPONERROR was specified.
 
private int TCL_CONVERT_MULTIBYTE = -1;
private int TCL_CONVERT_SYNTAX = -2;
private int TCL_CONVERT_UNKNOWN = -3;
private int TCL_CONVERT_NOSPACE = -4;
 
/// <summary> Tcl_ExternalToUtf -> externalToUnicode
///
/// Convert a source buffer from the specified encoding into Unicode.
///
/// FIXME: Add doc for return values
///
/// </summary>
/// <param name="src,"> Source bytes in specified encoding.
/// </param>
/// <param name="srcOff,"> First index in src input array.
/// </param>
/// <param name="srcLen,"> Number of bytes in src buffer.
/// </param>
/// <param name="dst,"> Array to store unicode characters in.
/// </param>
/// <param name="dstOff,"> First available index in dst array.
/// </param>
/// <param name="dstLen,"> Length of dst array.
/// </param>
/// <param name="srcReadPtr,"> Filled with the number of bytes from
/// the source string that were converted.
/// This may be less than the original source
/// length if there was a problem converting
/// some source characters.
/// </param>
/// <param name="dstWrotePtr,">Filled with the number of chars that were
/// stored in the output buffer as a result of
/// the conversion
/// </param>
/// <param name="dstCharsPtr,">Filled with the number of characters that
/// correspond to the bytes stored in the
/// output buffer.
/// </param>
 
internal int externalToUnicode( byte[] src, int srcOff, int srcLen, char[] dst, int dstOff, int dstLen, IntPtr srcReadPtr, IntPtr dstWrotePtr, IntPtr dstCharsPtr )
{
System.Text.Encoding encoding = this.encoding;
int result;
//Object state;
//String encoded_string;
 
if ( (System.Object)encoding == null )
{
// This should never happen
//encoding = Encoding.getJavaName("identity");
throw new TclRuntimeError( "externalToUnicode called with null encoding" );
}
 
// FIXME: This may no longer be needed after Tcl srcLen == 0 patch
 
if ( srcLen == 0 )
{
srcReadPtr.i = 0;
if ( dstWrotePtr != null )
dstWrotePtr.i = 0;
if ( dstCharsPtr != null )
dstCharsPtr.i = 0;
return 0;
}
 
// Convert bytes from src into unicode chars and store them in dst.
 
// FIXME: This allocated a buffer for the String and then copies the
// encoded data into a second buffer. Need to decode the data directly
// into the dst array since this is performance critical.
 
#if DEBUG
System.Diagnostics.Debug.WriteLine("now to decode byte array of length " + srcLen);
System.Diagnostics.Debug.WriteLine("srcOff is " + srcOff);
for (int i = srcOff; i < (srcOff + srcLen); i++)
{
System.Diagnostics.Debug.WriteLine("(byte) '" + ((char) src[i]) + "'");
}
System.Diagnostics.Debug.WriteLine("encoded as " + encoding);
#endif
 
// FIXME: In the cases where we know that we don't actually want
// to copy the data, we could pass a flag so that we could
// take advantage of encodings that had a one to one mapping
// from bytes to chars (now need to copy then to find bytes used).
 
if ( btc == null )
{
try
{
btc = this.encoding.GetDecoder();
}
catch ( IOException ex )
{
// Valid encodings should be checked already
throw new TclRuntimeError( "unsupported encoding \"" + encoding + "\"" );
}
}
 
int bytes_read, chars_written;
 
int required_chars = btc.GetCharCount( src, srcOff, srcLen );
if ( required_chars > dstLen )
{
srcLen = dstLen;
}
chars_written = btc.GetChars( src, srcOff, srcLen, dst, dstOff );
bytes_read = srcLen;
 
srcReadPtr.i = bytes_read;
if ( dstWrotePtr != null )
dstWrotePtr.i = chars_written;
if ( dstCharsPtr != null )
dstCharsPtr.i = chars_written;
 
// FIXME: When do we return error codes?
result = 0;
 
return result;
}
 
/// <summary> RecycleBuffer -> recycleBuffer
///
/// Helper function to recycle input buffers. Ensures that
/// two input buffers are saved (one in the input queue and
/// another in the saveInBuf field). Only if these conditions
/// are met is the buffer released so that it can be
/// garbage collected.
/// </summary>
 
private void recycleBuffer( ChannelBuffer buf, bool mustDiscard )
{
 
if ( mustDiscard )
return;
 
// Only save buffers which are at least as big as the requested
// buffersize for the channel. This is to honor dynamic changes
// of the buffersize made by the user.
 
if ( ( buf.bufLength - tcl.lang.ChannelBuffer.BUFFER_PADDING ) < bufSize )
{
return;
}
 
if ( inQueueHead == null )
{
inQueueHead = buf;
inQueueTail = buf;
 
buf.nextRemoved = tcl.lang.ChannelBuffer.BUFFER_PADDING;
buf.nextAdded = tcl.lang.ChannelBuffer.BUFFER_PADDING;
buf.next = null;
return;
}
if ( saveInBuf == null )
{
saveInBuf = buf;
 
buf.nextRemoved = tcl.lang.ChannelBuffer.BUFFER_PADDING;
buf.nextAdded = tcl.lang.ChannelBuffer.BUFFER_PADDING;
buf.next = null;
return;
}
}
 
/// <summary> DiscardInputQueued -> discardQueued
///
/// Discards any input read from the channel but not yet consumed
/// by Tcl reading commands.
/// </summary>
 
private void discardQueued( bool discardSavedBuffers )
{
ChannelBuffer buf, nxt;
 
buf = inQueueHead;
inQueueHead = null;
inQueueTail = null;
for ( ; buf != null; buf = nxt )
{
nxt = buf.next;
recycleBuffer( buf, discardSavedBuffers );
}
 
// If discardSavedBuffers is true, must also discard any previously
// saved buffer in the saveInBuf field.
 
if ( discardSavedBuffers )
{
if ( saveInBuf != null )
{
saveInBuf = null;
}
}
}
 
/// <summary> TranslateInputEOL -> translateEOL
///
/// Perform input EOL and EOF translation on the source buffer,
/// leaving the translated result in the destination buffer.
///
/// Results:
/// The return value is 1 if the EOF character was found when
/// copying bytes to the destination buffer, 0 otherwise.
///
/// </summary>
/// <param name="dstArray,">Output buffer to fill with translated bytes or chars.
/// </param>
/// <param name="dstStart,">First unused index in the dst output array.
/// </param>
/// <param name="srcArray,">Input buffer that holds the bytes or chars to translate
/// </param>
/// <param name="srcStart,">Index of first available byte in src array.
/// </param>
/// <param name="dstLenPtr,">On entry, the maximum length of output
/// buffer in bytes or chars; must be <= srcLenPtr.i. On
/// exit, the number of bytes or chars actually used in
/// output buffer.
/// </param>
/// <param name="srcLenPtr,">On entry, the length of source buffer.
/// On exit, the number of bytes or chars read from
/// the source buffer.
/// </param>
 
internal int translateEOL( System.Object dstArray, int dstStart, Object srcArray, int srcStart, IntPtr dstLenPtr, IntPtr srcLenPtr )
{
 
// Figure out if the srcArray and dstArray buffers
// are byte or char arrays.
bool isCharType;
char[] srcArrayChar, dstArrayChar;
byte[] srcArrayByte, dstArrayByte;
 
if ( ( srcArray is char[] ) && ( dstArray is char[] ) )
{
isCharType = true;
srcArrayChar = (char[])srcArray;
dstArrayChar = (char[])dstArray;
srcArrayByte = null;
dstArrayByte = null;
}
else if ( ( srcArray is byte[] ) && ( dstArray is byte[] ) )
{
isCharType = false;
srcArrayChar = null;
dstArrayChar = null;
srcArrayByte = (byte[])srcArray;
dstArrayByte = (byte[])dstArray;
}
else
{
throw new TclRuntimeError( "unknown array argument types" );
}
 
int dstLen, srcLen, inEofChar, index;
int eof;
 
dstLen = dstLenPtr.i;
 
eof = -1;
inEofChar = eofChar;
if ( inEofChar != '\x0000' )
{
// Find EOF in translated buffer then compress out the EOL. The
// source buffer may be much longer than the destination buffer --
// we only want to return EOF if the EOF has been copied to the
// destination buffer.
 
int src, srcMax;
 
srcMax = srcStart + srcLenPtr.i;
for ( src = srcStart; src < srcMax; src++ )
{
if ( isCharType )
{
index = srcArrayChar[src];
}
else
{
index = srcArrayByte[src];
}
if ( index == inEofChar )
{
eof = src;
srcLen = src - srcStart;
if ( srcLen < dstLen )
{
dstLen = srcLen;
}
srcLenPtr.i = srcLen;
break;
}
}
}
switch ( translation )
{
 
case TclIO.TRANS_LF:
{
if ( ( dstArray != srcArray ) || ( ( dstArray == srcArray ) && ( dstStart != srcStart ) ) )
{
Array.Copy( (System.Array)srcArray, srcStart, (System.Array)dstArray, dstStart, dstLen );
}
srcLen = dstLen;
break;
}
 
case TclIO.TRANS_CR:
{
int dst, dstEnd;
 
if ( ( dstArray != srcArray ) || ( ( dstArray == srcArray ) && ( dstStart != srcStart ) ) )
{
Array.Copy( (System.Array)srcArray, srcStart, (System.Array)dstArray, dstStart, dstLen );
}
dstEnd = dstStart + dstLen;
if ( isCharType )
{
for ( dst = dstStart; dst < dstEnd; dst++ )
{
if ( dstArrayChar[dst] == '\r' )
{
dstArrayChar[dst] = '\n';
}
}
}
else
{
for ( dst = dstStart; dst < dstEnd; dst++ )
{
if ( dstArrayByte[dst] == '\r' )
{
dstArrayByte[dst] = (byte)SupportClass.Identity( '\n' );
}
}
}
srcLen = dstLen;
break;
}
 
case TclIO.TRANS_CRLF:
{
int dst;
int src, srcEnd, srcMax;
 
dst = dstStart;
src = srcStart;
srcEnd = srcStart + dstLen;
srcMax = srcStart + srcLenPtr.i;
 
if ( isCharType )
{
for ( ; src < srcEnd; )
{
if ( srcArrayChar[src] == '\r' )
{
src++;
if ( src >= srcMax )
{
needNL = true;
}
else if ( srcArrayChar[src] == '\n' )
{
dstArrayChar[dst++] = srcArrayChar[src++];
}
else
{
dstArrayChar[dst++] = '\r';
}
}
else
{
dstArrayChar[dst++] = srcArrayChar[src++];
}
}
}
else
{
for ( ; src < srcEnd; )
{
if ( srcArrayByte[src] == '\r' )
{
src++;
if ( src >= srcMax )
{
needNL = true;
}
else if ( srcArrayByte[src] == '\n' )
{
dstArrayByte[dst++] = srcArrayByte[src++];
}
else
{
dstArrayByte[dst++] = (byte)SupportClass.Identity( '\r' );
}
}
else
{
dstArrayByte[dst++] = srcArrayByte[src++];
}
}
}
 
srcLen = src - srcStart;
dstLen = dst - dstStart;
break;
}
 
case TclIO.TRANS_AUTO:
{
int dst;
int src, srcEnd, srcMax;
 
dst = dstStart;
src = srcStart;
srcEnd = srcStart + dstLen;
srcMax = srcStart + srcLenPtr.i;
 
if ( sawCR_Renamed_Field && ( src < srcMax ) )
{
if ( isCharType )
{
index = srcArrayChar[src];
}
else
{
index = srcArrayByte[src];
}
if ( index == '\n' )
{
src++;
}
sawCR_Renamed_Field = false;
}
if ( isCharType )
{
for ( ; src < srcEnd; )
{
if ( srcArrayChar[src] == '\r' )
{
src++;
if ( src >= srcMax )
{
sawCR_Renamed_Field = true;
}
else if ( srcArrayChar[src] == '\n' )
{
if ( srcEnd < srcMax )
{
srcEnd++;
}
src++;
}
dstArrayChar[dst++] = '\n';
}
else
{
dstArrayChar[dst++] = srcArrayChar[src++];
}
}
}
else
{
for ( ; src < srcEnd; )
{
if ( srcArrayByte[src] == '\r' )
{
src++;
if ( src >= srcMax )
{
sawCR_Renamed_Field = true;
}
else if ( srcArrayByte[src] == '\n' )
{
if ( srcEnd < srcMax )
{
srcEnd++;
}
src++;
}
dstArrayByte[dst++] = (byte)SupportClass.Identity( '\n' );
}
else
{
dstArrayByte[dst++] = srcArrayByte[src++];
}
}
}
srcLen = src - srcStart;
dstLen = dst - dstStart;
break;
}
 
default:
{
throw new TclRuntimeError( "invalid translation" );
}
 
}
dstLenPtr.i = dstLen;
 
if ( ( eof != -1 ) && ( srcStart + srcLen >= eof ) )
{
// EOF character was seen in EOL translated range. Leave current
// file position pointing at the EOF character, but don't store the
// EOF character in the output string.
 
eofCond = true;
stickyEofCond = true;
encodingEnd = true;
sawCR_Renamed_Field = false;
needNL = false;
return 1;
}
 
srcLenPtr.i = srcLen;
return 0;
}
 
/// <summary> UpdateInterest -> updateInterest
///
/// Arrange for the notifier to call us back at appropriate times
/// based on the current state of the channel.
/// </summary>
 
internal void updateInterest()
{
// FIXME: Currently unimplemented
}
 
/// <summary> seekReset
///
/// Helper method used to reset state info when doing a seek.
/// </summary>
 
internal void seekReset()
{
discardQueued( false );
eofCond = false;
stickyEofCond = false;
blocked = false;
sawCR_Renamed_Field = false;
// FIXME: Change needed in Tcl
//needNL = false;
}
}
}
/trunk/TCL/src/io/TclOutputStream.cs
@@ -0,0 +1,1537 @@
#undef DEBUG
/*
* TclOutputStream.java
*
* Copyright (c) 2003 Mo DeJong
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: TclOutputStream.java,v 1.1 2003/03/08 03:42:44 mdejong Exp $
*/
 
// A TclOutputStream is a cross between a Java OutputStream and
// a Writer. The class supports writing raw bytes as well as
// encoded characters.
using System;
using System.IO;
using System.Text;
 
namespace tcl.lang
{
 
public class TclOutputStream
{
internal System.Text.Encoding Encoding
{
set
{
encoding = value;
}
 
}
internal char EofChar
{
set
{
eofChar = value;
}
 
}
internal int Translation
{
set
{
translation = value;
}
 
}
public int Buffering
{
set
{
buffering = value;
}
 
}
public int BufferSize
{
set
{
bufSize = value;
outputStage = null;
}
 
}
public bool Blocking
{
set
{
blocking = value;
}
 
}
public bool Blocked
{
get
{
return blocked;
}
 
}
/// <summary> Tcl_OutputBuffered -> getNumBufferedBytes
///
/// Return the number of bytes that are current buffered.
/// </summary>
internal int NumBufferedBytes
{
 
 
get
{
ChannelBuffer buf;
int IOQueued = 0;
for ( buf = outQueueHead; buf != null; buf = buf.next )
{
IOQueued += buf.nextAdded - buf.nextRemoved;
}
if ( ( curOut != null ) && ( curOut.nextAdded > curOut.nextRemoved ) )
{
//bufferReady = true;
IOQueued += curOut.nextAdded - curOut.nextRemoved;
}
return IOQueued;
}
 
}
 
/// <summary> The Java byte stream object data will be written to.</summary>
 
private Stream output;
 
/// <summary> If nonzero, use this character as EOF marker.</summary>
 
private char eofChar;
 
/// <summary> Translation mode for end-of-line character</summary>
 
protected internal int translation;
 
/// <summary> Name of Java encoding for this Channel.
/// A null value means use no encoding (binary).
/// </summary>
 
protected internal System.Text.Encoding encoding;
 
/// <summary> Current converter object. A null value means
/// that no conversions have been done yet.
/// </summary>
 
protected internal Encoder ctb = null;
 
/// <summary> Buffering</summary>
 
protected internal int buffering;
 
/// <summary> Blocking</summary>
 
protected internal bool blocking;
 
/// <summary> Blocked</summary>
 
protected internal bool blocked = false;
 
/// <summary> Buffer size in bytes</summary>
 
protected internal int bufSize;
 
/// <summary> Staging area used to store chars before conversion into
/// buffered bytes.
/// </summary>
 
protected internal char[] outputStage = null;
 
/// <summary> Flags used to track encoding states.
/// The encodingState member of called outputEncodingState
/// in the C ChannelState type. The encodingStart and encodingEnd
/// members combined are called outputEncodingFlags
/// and have the bit values TCL_ENCODING_END and TCL_ENCODING_START.
/// </summary>
 
internal Object encodingState = null;
internal bool encodingStart = true;
internal bool encodingEnd = false;
 
/// <summary> First and last buffers in the output queue and
/// the current buffer being filled.
/// </summary>
 
internal ChannelBuffer outQueueHead = null;
internal ChannelBuffer outQueueTail = null;
internal ChannelBuffer curOut = null;
 
 
/// <summary> Used to track buffer state, these are bit flags stored
/// in the flags filed in the C impl.
/// </summary>
 
protected internal bool bufferReady = false;
protected internal bool bgFlushScheduled = false;
protected internal bool closed = false;
 
/// <summary> Posix error code of deferred error.</summary>
protected internal int unreportedError = 0;
 
/// <summary> FIXME: add desc</summary>
 
protected internal int refCount = 0;
 
/// <summary> Constructor for Tcl input stream class. We require
/// a byte stream source at init time, the stram can't
/// be changed after the TclInputStream is created.
/// </summary>
 
internal TclOutputStream( Stream inOutput )
{
output = inOutput;
}
 
/// <summary> Tcl_Close -> close
///
/// Closes a channel.
///
/// Closes the channel if this is the last reference.
///
/// close removes the channel as far as the user is concerned.
/// However, it may continue to exist for a while longer if it has
/// a background flush scheduled. The device itself is eventually
/// closed and the channel record removed, in closeChannel.
/// </summary>
 
internal void close()
{
//CloseCallback *cbPtr;
//Channel *chanPtr;
//ChannelState *statePtr;
int result;
 
// Perform special handling for standard channels being closed. If the
// refCount is now 1 it means that the last reference to the standard
// channel is being explicitly closed, so bump the refCount down
// artificially to 0. This will ensure that the channel is actually
// closed, below. Also set the static pointer to NULL for the channel.
 
//CheckForStdChannelsBeingClosed();
 
// This operation should occur at the top of a channel stack.
 
//chanPtr = (Channel *) chan;
//statePtr = chanPtr->state;
//chanPtr = statePtr->topChanPtr;
 
if ( refCount > 0 )
{
throw new TclRuntimeError( "called Tcl_Close on channel with refCount > 0" );
}
 
// When the channel has an escape sequence driven encoding such as
// iso2022, the terminated escape sequence must write to the buffer.
 
if ( ( (System.Object)encoding != null ) && ( curOut != null ) )
{
encodingEnd = true;
// FIXME : Make sure this flushes the CharToByteConverter
char[] empty = new char[0];
writeChars( empty, 0, 0 );
}
 
// FIXME: Impl channel close callbacks ???
//Tcl_ClearChannelHandlers(chan);
 
// Invoke the registered close callbacks and delete their records.
 
//while (statePtr->closeCbPtr != (CloseCallback *) NULL) {
// cbPtr = statePtr->closeCbPtr;
// statePtr->closeCbPtr = cbPtr->nextPtr;
// (cbPtr.proc) (cbPtr->clientData);
// ckfree((char *) cbPtr);
//}
 
// Ensure that the last output buffer will be flushed.
 
if ( ( curOut != null ) && ( curOut.nextAdded > curOut.nextRemoved ) )
{
bufferReady = true;
}
 
// If this channel supports it, close the read side, since we don't need it
// anymore and this will help avoid deadlocks on some channel types.
 
//if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
// result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
// TCL_CLOSE_READ);
//} else {
// result = 0;
//}
result = 0;
 
// The call to flushChannel will flush any queued output and invoke
// the close function of the channel driver, or it will set up the
// channel to be flushed and closed asynchronously.
 
closed = true;
if ( ( flushChannel( null, false ) != 0 ) || ( result != 0 ) )
{
// FIXME: We should raise a TclPosixException here instead
//return TCL.TCL_ERROR;
throw new IOException( "Exception in flushChannel" );
}
}
 
/// <summary> CloseChannel -> closeChannel
///
/// Utility procedure to close a channel and free associated resources.
///
/// If the channel was stacked, then the it will copy the necessary
/// elements of the NEXT channel into the TOP channel, in essence
/// unstacking the channel. The NEXT channel will then be freed.
///
/// If the channel was not stacked, then we will free all the bits
/// for the TOP channel, including the data structure itself.
///
/// Returns 1 if the channel was stacked, 0 otherwise.
/// </summary>
 
protected internal int closeChannel( Interp interp, int errorCode )
{
int result = 0;
//ChannelState *statePtr; // state of the channel stack.
//ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
//if (chanPtr == NULL) {
// return result;
//}
//statePtr = chanPtr->state;
 
// Discard a leftover buffer in the current output buffer field.
 
if ( curOut != null )
{
//ckfree((char *) statePtr->curOutPtr);
curOut = null;
}
 
// The caller guarantees that there are no more buffers
// queued for output.
 
if ( outQueueHead != null )
{
throw new TclRuntimeError( "TclFlush, closed channel: queued output left" );
}
 
// If the EOF character is set in the channel, append that to the
// output device.
 
if ( eofChar != 0 )
{
try
{
output.WriteByte( (byte)eofChar );
}
catch ( IOException ex )
{
// FIXME: How can we recover here??
SupportClass.WriteStackTrace( ex, Console.Error );
}
}
 
// Remove this channel from of the list of all channels.
 
//Tcl_CutChannel((Tcl_Channel) chanPtr);
 
// Close and free the channel driver state.
 
//if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
// result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
//} else {
// result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
// 0);
//}
 
// Some resources can be cleared only if the bottom channel
// in a stack is closed. All the other channels in the stack
// are not allowed to remove.
 
//if (chanPtr == statePtr->bottomChanPtr) {
// if (statePtr->channelName != (char *) NULL) {
// ckfree((char *) statePtr->channelName);
// statePtr->channelName = NULL;
// }
 
// Tcl_FreeEncoding(statePtr->encoding);
// if (statePtr->outputStage != NULL) {
// ckfree((char *) statePtr->outputStage);
// statePtr->outputStage = (char *) NULL;
// }
//}
 
// If we are being called synchronously, report either
// any latent error on the channel or the current error.
 
if ( unreportedError != 0 )
{
errorCode = unreportedError;
}
if ( errorCode == 0 )
{
errorCode = result;
if ( errorCode != 0 )
{
// FIXME: How can we deal with this errno issue?
//Tcl_SetErrno(errorCode);
}
}
 
// Cancel any outstanding timer.
 
//Tcl_DeleteTimerHandler(statePtr->timer);
 
// Mark the channel as deleted by clearing the type structure.
 
//if (chanPtr->downChanPtr != (Channel *) NULL) {
// Channel *downChanPtr = chanPtr->downChanPtr;
 
// statePtr->nextCSPtr = tsdPtr->firstCSPtr;
// tsdPtr->firstCSPtr = statePtr;
 
// statePtr->topChanPtr = downChanPtr;
// downChanPtr->upChanPtr = (Channel *) NULL;
// chanPtr->typePtr = NULL;
 
// Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
// return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
//}
 
// There is only the TOP Channel, so we free the remaining
// pointers we have and then ourselves. Since this is the
// last of the channels in the stack, make sure to free the
// ChannelState structure associated with it. We use
// Tcl_EventuallyFree to allow for any last
 
//chanPtr->typePtr = NULL;
 
//Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC);
//Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
 
return errorCode;
}
 
/// <summary> Tcl_Flush -> flush
///
/// Flushes output data on a channel.
/// </summary>
 
internal void flush()
{
// Force current output buffer to be output also.
 
if ( ( curOut != null ) && ( curOut.nextAdded > curOut.nextRemoved ) )
{
bufferReady = true;
}
 
int result = flushChannel( null, false );
if ( result != 0 )
{
// FIXME: Should we throw an exception here?
throw new IOException( "Exception during flushChannel" );
}
// ATK .NET has own buffer also we need to Flush the
// IO.Stream too
output.Flush();
}
 
/// <summary> FlushChannel -> flushChannel
///
/// This function flushes as much of the queued output as is possible
/// now. If calledFromAsyncFlush is true, it is being called in an
/// event handler to flush channel output asynchronously.
///
/// Return 0 if successful, else the error code that was returned by the
/// channel type operation.
///
/// May produce output on a channel. May block indefinitely if the
/// channel is synchronous. May schedule an async flush on the channel.
/// May recycle memory for buffers in the output queue.
///
/// </summary>
/// <param name="interp"> Interp object.
/// </param>
/// <param name="calledFromAsyncFlush"> True if called from an asynchronous
/// flush callback.
/// </param>
 
internal int flushChannel( Interp interp, bool calledFromAsyncFlush )
{
//ChannelState *statePtr = chanPtr->state;
ChannelBuffer buf;
int toWrite; // Amount of output data in current
// buffer available to be written.
int written; // Amount of output data actually
// written in current round.
int errorCode = 0; // Stores POSIX error codes from
// channel driver operations.
bool wroteSome = false; // Set to true if any data was
// written to the driver.
 
// Prevent writing on a dead channel -- a channel that has been closed
// but not yet deallocated. This can occur if the exit handler for the
// channel deallocation runs before all channels are deregistered in
// all interpreters.
 
//if (CheckForDeadChannel(interp, statePtr)) return -1;
 
// Loop over the queued buffers and attempt to flush as
// much as possible of the queued output to the channel.
 
while ( true )
{
// If the queue is empty and there is a ready current buffer, OR if
// the current buffer is full, then move the current buffer to the
// queue.
 
if ( ( ( curOut != null ) && ( curOut.nextAdded == curOut.bufLength ) ) || ( bufferReady && ( outQueueHead == null ) ) )
{
bufferReady = false;
curOut.next = null;
if ( outQueueHead == null )
{
outQueueHead = curOut;
}
else
{
outQueueTail.next = curOut;
}
outQueueTail = curOut;
curOut = null;
}
buf = outQueueHead;
 
// If we are not being called from an async flush and an async
// flush is active, we just return without producing any output.
 
if ( ( !calledFromAsyncFlush ) && bgFlushScheduled )
{
return 0;
}
 
// If the output queue is still empty, break out of the while loop.
 
if ( buf == null )
{
break; // Out of the "while (1)".
}
 
// Produce the output on the channel.
 
toWrite = buf.nextAdded - buf.nextRemoved;
//written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
// bufPtr->buf + bufPtr->nextRemoved, toWrite,
// &errorCode);
try
{
output.Write( buf.buf, buf.nextRemoved, toWrite );
written = toWrite;
}
catch ( IOException ex )
{
// FIXME: How can we recover and get posix errors?
SupportClass.WriteStackTrace( ex, System.Console.Error );
errorCode = TclPosixException.EIO; // Generic I/O error ???
written = -1;
}
 
// If the write failed completely attempt to start the asynchronous
// flush mechanism and break out of this loop - do not attempt to
// write any more output at this time.
 
if ( written < 0 )
{
// If the last attempt to write was interrupted, simply retry.
 
if ( errorCode == TclPosixException.EINTR )
{
errorCode = 0;
continue;
}
 
// If the channel is non-blocking and we would have blocked,
// start a background flushing handler and break out of the loop.
 
if ( ( errorCode == TclPosixException.EWOULDBLOCK ) || ( errorCode == TclPosixException.EAGAIN ) )
{
// This used to check for CHANNEL_NONBLOCKING, and panic
// if the channel was blocking. However, it appears
// that setting stdin to -blocking 0 has some effect on
// the stdout when it's a tty channel (dup'ed underneath)
 
if ( !bgFlushScheduled )
{
bgFlushScheduled = true;
updateInterest();
}
errorCode = 0;
break;
}
 
// Decide whether to report the error upwards or defer it.
 
if ( calledFromAsyncFlush )
{
if ( unreportedError == 0 )
{
unreportedError = errorCode;
}
}
else
{
// FIXME: Need to figure out what to do here!
//Tcl_SetErrno(errorCode);
//if (interp != NULL) {
// // Casting away CONST here is safe because the
// // TCL_VOLATILE flag guarantees CONST treatment
// // of the Posix error string.
// Tcl_SetResult(interp,
// (char *) Tcl_PosixError(interp), TCL_VOLATILE);
}
 
// When we get an error we throw away all the output
// currently queued.
 
discardQueued();
continue;
}
else
{
wroteSome = true;
}
 
buf.nextRemoved += written;
 
// If this buffer is now empty, recycle it.
 
if ( buf.nextRemoved == buf.nextAdded )
{
outQueueHead = buf.next;
if ( outQueueHead == null )
{
outQueueTail = null;
}
recycleBuffer( buf, false );
}
} // Closes "while (1)".
 
// If we wrote some data while flushing in the background, we are done.
// We can't finish the background flush until we run out of data and
// the channel becomes writable again. This ensures that all of the
// pending data has been flushed at the system level.
 
if ( bgFlushScheduled )
{
if ( wroteSome )
{
return errorCode;
}
else if ( outQueueHead == null )
{
bgFlushScheduled = false;
// FIXME: What is this watchProc?
//(chanPtr->typePtr->watchProc)(chanPtr->instanceData,
// statePtr->interestMask);
}
}
 
// If the channel is flagged as closed, delete it when the refCount
// drops to zero, the output queue is empty and there is no output
// in the current output buffer.
 
if ( closed && ( refCount <= 0 ) && ( outQueueHead == null ) && ( ( curOut == null ) || ( curOut.nextAdded == curOut.nextRemoved ) ) )
{
return closeChannel( interp, errorCode );
}
return errorCode;
}
 
// Helper class to implement integer pass by reference.
 
public class IntPtr
{
private void InitBlock( TclOutputStream enclosingInstance )
{
this.enclosingInstance = enclosingInstance;
}
private TclOutputStream enclosingInstance;
public TclOutputStream Enclosing_Instance
{
get
{
return enclosingInstance;
}
 
}
internal int i;
 
internal IntPtr( TclOutputStream enclosingInstance )
{
InitBlock( enclosingInstance );
}
 
internal IntPtr( TclOutputStream enclosingInstance, int value )
{
InitBlock( enclosingInstance );
i = value;
}
}
 
/// <summary> RecycleBuffer -> recycleBuffer
///
/// Helper function to recycle output buffers. Ensures that
/// that curOut is set to a buffer. Only if these conditions
/// are met is the buffer released so that it can be
/// garbage collected.
/// </summary>
 
private void recycleBuffer( ChannelBuffer buf, bool mustDiscard )
{
 
if ( mustDiscard )
return;
 
// Only save buffers which are at least as big as the requested
// buffersize for the channel. This is to honor dynamic changes
// of the buffersize made by the user.
 
if ( ( buf.bufLength - tcl.lang.ChannelBuffer.BUFFER_PADDING ) < bufSize )
{
return;
}
 
if ( curOut == null )
{
curOut = buf;
buf.nextRemoved = tcl.lang.ChannelBuffer.BUFFER_PADDING;
buf.nextAdded = tcl.lang.ChannelBuffer.BUFFER_PADDING;
buf.next = null;
}
}
 
/// <summary> DiscardOutputQueued -> discardQueued
///
/// Discards all output queued in the output queue of a channel.
/// </summary>
 
private void discardQueued()
{
ChannelBuffer buf;
 
while ( outQueueHead != null )
{
buf = outQueueHead;
outQueueHead = buf.next;
recycleBuffer( buf, false );
}
outQueueHead = null;
outQueueTail = null;
}
 
/// <summary> UpdateInterest -> updateInterest
///
/// Arrange for the notifier to call us back at appropriate times
/// based on the current state of the channel.
/// </summary>
 
internal void updateInterest()
{
// FIXME: Currently unimplemented
}
 
/// <summary> seekCheckBuferReady
///
/// This method is used by the seek command to check
/// the channel for buffered output and mark the
/// buffer as ready to flush if found.
/// </summary>
 
internal void seekCheckBuferReady()
{
if ( ( curOut != null ) && ( curOut.nextAdded > curOut.nextRemoved ) )
{
bufferReady = true;
}
}
 
/// <summary> TranslateOutputEOL -> translateEOL
///
/// Helper function for writeBytes() and writeChars(). Converts the
/// '\n' characters in the source buffer into the appropriate EOL
/// form specified by the output translation mode.
///
/// EOL translation stops either when the source buffer is empty
/// or the output buffer is full.
///
/// When converting to CRLF mode and there is only 1 byte left in
/// the output buffer, this routine stores the '\r' in the last
/// byte and then stores the '\n' in the byte just past the end of the
/// buffer. The caller is responsible for passing in a buffer that
/// is large enough to hold the extra byte.
///
/// Results:
///
/// The return value is 1 if a '\n' was translated from the source
/// buffer, or 0 otherwise -- this can be used by the caller to
/// decide to flush a line-based channel even though the channel
/// buffer is not full.
///
/// dstLenPtr.i is filled with how many bytes of the output buffer
/// were used. As mentioned above, this can be one more that
/// the output buffer's specified length if a CRLF was stored.
///
/// srcLenPtr.i is filled with how many bytes of the source buffer
/// were consumed.
///
/// It may be obvious, but bears mentioning that when converting
/// in CRLF mode (which requires two bytes of storage in the output
/// buffer), the number of bytes consumed from the source buffer
/// will be less than the number of bytes stored in the output buffer.
///
/// </summary>
/// <param name="dstArray,">Output buffer to fill with translated bytes or chars.
/// </param>
/// <param name="dstStart,">First unused index in the dst output array.
/// </param>
/// <param name="srcArray,">Input buffer that holds the bytes or chars to translate
/// </param>
/// <param name="srcStart,">Index of first available byte in src array.
/// </param>
/// <param name="dstLenPtr,">On entry, the maximum length of output
/// buffer in bytes or chars. On exit, the number of
/// bytes or chars actually used in output buffer.
/// </param>
/// <param name="srcLenPtr,">On entry, the length of source buffer.
/// On exit, the number of bytes or chars read from
/// the source buffer.
/// </param>
 
internal bool translateEOL( System.Object dstArray, int dstStart, Object srcArray, int srcStart, IntPtr dstLenPtr, IntPtr srcLenPtr )
{
 
// Figure out if the srcArray and dstArray buffers
// are byte or char arrays.
bool isCharType;
char[] srcArrayChar, dstArrayChar;
byte[] srcArrayByte, dstArrayByte;
 
if ( ( srcArray is char[] ) && ( dstArray is char[] ) )
{
isCharType = true;
srcArrayChar = (char[])srcArray;
dstArrayChar = (char[])dstArray;
srcArrayByte = null;
dstArrayByte = null;
}
else if ( ( srcArray is byte[] ) && ( dstArray is byte[] ) )
{
isCharType = false;
srcArrayChar = null;
dstArrayChar = null;
srcArrayByte = (byte[])srcArray;
dstArrayByte = (byte[])dstArray;
}
else
{
throw new TclRuntimeError( "unknown array argument types" );
}
 
int src, dst, dstEnd, srcLen;
bool newlineFound;
 
src = srcStart;
dst = dstStart;
newlineFound = false;
srcLen = srcLenPtr.i;
 
switch ( translation )
{
 
case TclIO.TRANS_LF:
{
if ( isCharType )
{
for ( dstEnd = dst + srcLen; dst < dstEnd; )
{
if ( srcArrayChar[src] == '\n' )
{
newlineFound = true;
}
dstArrayChar[dst++] = srcArrayChar[src++];
}
}
else
{
for ( dstEnd = dst + srcLen; dst < dstEnd; )
{
if ( srcArrayByte[src] == '\n' )
{
newlineFound = true;
}
dstArrayByte[dst++] = srcArrayByte[src++];
}
}
dstLenPtr.i = srcLen;
break;
}
 
case TclIO.TRANS_CR:
{
if ( isCharType )
{
for ( dstEnd = dst + srcLen; dst < dstEnd; )
{
if ( srcArrayChar[src] == '\n' )
{
dstArrayChar[dst++] = '\r';
newlineFound = true;
src++;
}
else
{
dstArrayChar[dst++] = srcArrayChar[src++];
}
}
}
else
{
for ( dstEnd = dst + srcLen; dst < dstEnd; )
{
if ( srcArrayByte[src] == '\n' )
{
dstArrayByte[dst++] = (byte)SupportClass.Identity( '\r' );
newlineFound = true;
src++;
}
else
{
dstArrayByte[dst++] = srcArrayByte[src++];
}
}
}
dstLenPtr.i = srcLen;
break;
}
 
case TclIO.TRANS_CRLF:
{
// Since this causes the number of bytes to grow, we
// start off trying to put 'srcLen' bytes into the
// output buffer, but allow it to store more bytes, as
// long as there's still source bytes and room in the
// output buffer.
 
int dstMax;
//int dstStart, srcStart;
 
//dstStart = dst;
dstMax = dst + dstLenPtr.i;
 
//srcStart = src;
 
if ( srcLen < dstLenPtr.i )
{
dstEnd = dst + srcLen;
}
else
{
dstEnd = dst + dstLenPtr.i;
}
 
if ( isCharType )
{
while ( dst < dstEnd )
{
if ( srcArrayChar[src] == '\n' )
{
if ( dstEnd < dstMax )
{
dstEnd++;
}
dstArrayChar[dst++] = '\r';
newlineFound = true;
}
dstArrayChar[dst++] = srcArrayChar[src++];
}
}
else
{
while ( dst < dstEnd )
{
if ( srcArrayByte[src] == '\n' )
{
if ( dstEnd < dstMax )
{
dstEnd++;
}
dstArrayByte[dst++] = (byte)SupportClass.Identity( '\r' );
newlineFound = true;
}
dstArrayByte[dst++] = srcArrayByte[src++];
}
}
 
srcLenPtr.i = src - srcStart;
dstLenPtr.i = dst - dstStart;
break;
}
 
default:
{
break;
}
 
}
return newlineFound;
}
 
/// <summary> Tcl_UtfToExternal -> unicodeToExternal
///
/// Convert a source buffer from unicode characters to a specified encoding.
///
/// FIXME: Add doc for return values
///
/// </summary>
/// <param name="src,"> Source characters.
/// </param>
/// <param name="srcOff,"> First index in src input array.
/// </param>
/// <param name="srcLen,"> Number of characters in src buffer.
/// </param>
/// <param name="dst,"> Array to store encoded bytes in.
/// </param>
/// <param name="dstOff,"> First available index in dst array.
/// </param>
/// <param name="dstLen,"> Length of dst array.
/// </param>
/// <param name="srcReadPtr,"> Filled with the number of characters from
/// the source string that were converted.
/// This may be less than the original source
/// length if there was a problem converting
/// some source characters.
/// </param>
/// <param name="dstWrotePtr,">Filled with the number of bytes that were
/// stored in the output buffer as a result of
/// the conversion
/// </param>
/// <param name="dstCharsPtr,">Filled with the number of characters that
/// correspond to the bytes stored in the
/// output buffer.
/// </param>
 
internal int unicodeToExternal( char[] src, int srcOff, int srcLen, byte[] dst, int dstOff, int dstLen, IntPtr srcReadPtr, IntPtr dstWrotePtr, IntPtr dstCharsPtr )
{
bool debug;
int result;
 
if ( (System.Object)encoding == null )
{
throw new TclRuntimeError( "unicodeToExternal called with null encoding" );
}
 
if ( srcLen == 0 )
{
srcReadPtr.i = 0;
if ( dstWrotePtr != null )
dstWrotePtr.i = 0;
if ( dstCharsPtr != null )
dstCharsPtr.i = 0;
return 0;
}
 
#if DEBUG
System.Diagnostics.Debug.WriteLine("now to encode char array of length " + srcLen);
System.Diagnostics.Debug.WriteLine("srcOff is " + srcOff);
for (int i = srcOff; i < (srcOff + srcLen); i++)
{
System.Diagnostics.Debug.WriteLine("(char) '" + src[i] + "'");
}
System.Diagnostics.Debug.WriteLine("encoded as " + encoding);
#endif
 
if ( ctb == null )
{
try
{
ctb = this.encoding.GetEncoder();
}
catch ( IOException ex )
{
// Valid encodings should be checked already
throw new TclRuntimeError( "unsupported encoding \"" + encoding + "\"" );
}
}
 
int chars_read, bytes_written;
 
int required_bytes = ctb.GetByteCount( src, srcOff, srcLen, false );
// ATK do not allow buffer overflow by decresing read bytes count
if ( required_bytes > dstLen )
{
srcLen = dstLen;
}
bytes_written = ctb.GetBytes( src, srcOff, srcLen, dst, dstOff, false );
srcReadPtr.i = srcLen;
if ( dstWrotePtr != null )
dstWrotePtr.i = bytes_written;
if ( dstCharsPtr != null )
dstCharsPtr.i = srcLen;
 
// FIXME: When do we return error codes?
result = 0;
 
return result;
}
 
/// <summary> WriteBytes -> writeBytes
///
/// Write a sequence of bytes into an output buffer, may queue the
/// buffer for output if it gets full, and also remembers whether the
/// current buffer is ready e.g. if it contains a newline and we are 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="src"> Bytes to write.
/// </param>
/// <param name="srfOff"> First index in src array.
/// </param>
/// <param name="srfLen"> Number of bytes to write.
/// </param>
 
internal int writeBytes( byte[] srcArray, int srcOff, int srcLen )
{
ChannelBuffer buf;
byte[] dstArray;
int dst, src, dstMax, sawLF, total, savedLF;
IntPtr dstLen = new IntPtr( this );
IntPtr toWrite = new IntPtr( this );
 
total = 0;
sawLF = 0;
savedLF = 0;
src = srcOff;
 
// Loop over all bytes in src, storing them in output buffer with
// proper EOL translation.
 
while ( srcLen + savedLF > 0 )
{
buf = curOut;
if ( buf == null )
{
buf = new ChannelBuffer( bufSize );
curOut = buf;
}
//dst = bufPtr->buf + bufPtr->nextAdded;
dstArray = buf.buf;
dst = buf.nextAdded;
dstMax = buf.bufLength - buf.nextAdded;
dstLen.i = dstMax;
 
toWrite.i = dstLen.i;
if ( toWrite.i > srcLen )
{
toWrite.i = srcLen;
}
 
if ( savedLF != 0 )
{
// A '\n' was left over from last call to translateEOL()
// and we need to store it in this buffer. If the channel is
// line-based, we will need to flush it.
 
dstArray[dst++] = (byte)SupportClass.Identity( '\n' );
dstLen.i--;
sawLF++;
}
if ( translateEOL( dstArray, dst, srcArray, src, dstLen, toWrite ) )
{
sawLF++;
}
dstLen.i += savedLF;
savedLF = 0;
 
if ( dstLen.i > dstMax )
{
savedLF = 1;
dstLen.i = dstMax;
}
buf.nextAdded += dstLen.i;
if ( checkFlush( buf, ( sawLF != 0 ) ) != 0 )
{
return -1;
}
total += dstLen.i;
src += toWrite.i;
srcLen -= toWrite.i;
sawLF = 0;
}
return total;
}
 
/// <summary> CheckFlush -> checkFlush
///
/// Helper function for writeBytes() and writeChars(). If the
/// channel buffer is ready to be flushed, flush it.
///
/// The return value is -1 if there was a problem flushing the
/// channel buffer, or 0 otherwise.
///
/// The buffer will be recycled if it is flushed.
///
/// </summary>
/// <param name="buf"> Channel buffer to possibly flush.
/// </param>
/// <param name="newlineFlag"> True if a the channel buffer
/// contains a newline.
/// </param>
 
internal int checkFlush( ChannelBuffer buf, bool newlineFlag )
{
// The current buffer is ready for output:
// 1. if it is full.
// 2. if it contains a newline and this channel is line-buffered.
// 3. if it contains any output and this channel is unbuffered.
 
if ( !bufferReady )
{
if ( buf.nextAdded == buf.bufLength )
{
bufferReady = true;
}
else if ( buffering == TclIO.BUFF_LINE )
{
if ( newlineFlag )
{
bufferReady = true;
}
}
else if ( buffering == TclIO.BUFF_NONE )
{
bufferReady = true;
}
}
if ( bufferReady )
{
if ( flushChannel( null, false ) != 0 )
{
return -1;
}
}
return 0;
}
 
/// <summary> WriteChars -> writeChars
///
/// Convert chars to the channel's external encoding and
/// write the produced bytes into an output buffer, may queue the
/// buffer for output if it gets full, and also remembers whether the
/// current buffer is ready e.g. if it contains a newline and we are 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="src"> Chars to write.
/// </param>
/// <param name="srfOff"> First index in src array.
/// </param>
/// <param name="srfLen"> Number of chars to write.
/// </param>
 
internal int writeChars( char[] srcArray, int srcOff, int srcLen )
{
//ChannelState *statePtr = chanPtr->state; // state info for channel
ChannelBuffer buf;
char[] stageArray;
byte[] dstArray;
int stage, src, dst;
int saved, savedLF, sawLF, total, dstLen, stageMax;
int endEncoding, result;
bool consumedSomething;
//Tcl_Encoding encoding;
byte[] safe = new byte[ChannelBuffer.BUFFER_PADDING];
IntPtr stageLen = new IntPtr( this );
IntPtr toWrite = new IntPtr( this );
IntPtr stageRead = new IntPtr( this );
IntPtr dstWrote = new IntPtr( this );
 
total = 0;
sawLF = 0;
savedLF = 0;
saved = 0;
//encoding = statePtr->encoding;
src = 0;
 
// Write the terminated escape sequence even if srcLen is 0.
 
endEncoding = ( encodingEnd ? 0 : 1 );
 
// Loop over all characters in src, storing them in staging buffer
// with proper EOL translation.
 
consumedSomething = true;
while ( consumedSomething && ( srcLen + savedLF + endEncoding > 0 ) )
{
consumedSomething = false;
if ( outputStage == null )
{
outputStage = new char[bufSize + 2];
}
stageArray = outputStage;
stage = 0;
stageMax = bufSize;
stageLen.i = stageMax;
 
toWrite.i = stageLen.i;
if ( toWrite.i > srcLen )
{
toWrite.i = srcLen;
}
 
if ( savedLF != 0 )
{
// A '\n' was left over from last call to TranslateOutputEOL()
// and we need to store it in the staging buffer. If the
// channel is line-based, we will need to flush the output
// buffer (after translating the staging buffer).
 
stageArray[stage++] = '\n';
stageLen.i--;
sawLF++;
}
if ( translateEOL( stageArray, stage, srcArray, src, stageLen, toWrite ) )
{
sawLF++;
}
 
stage -= savedLF;
stageLen.i += savedLF;
savedLF = 0;
 
if ( stageLen.i > stageMax )
{
savedLF = 1;
stageLen.i = stageMax;
}
src += toWrite.i;
srcLen -= toWrite.i;
 
// Loop over all characters in staging buffer, converting them
// to external encoding, storing them in output buffer.
 
while ( stageLen.i + saved + endEncoding > 0 )
{
buf = curOut;
if ( buf == null )
{
buf = new ChannelBuffer( bufSize );
curOut = buf;
}
// dst = buf.buf + buf.nextAdded;
dstArray = buf.buf;
dst = buf.nextAdded;
dstLen = buf.bufLength - buf.nextAdded;
 
if ( saved != 0 )
{
// Here's some translated bytes left over from the last
// buffer that we need to stick at the beginning of this
// buffer.
 
Array.Copy( safe, 0, dstArray, dst, saved );
buf.nextAdded += saved;
dst += saved;
dstLen -= saved;
saved = 0;
}
 
result = unicodeToExternal( stageArray, stage, stageLen.i, dstArray, dst, dstLen + ChannelBuffer.BUFFER_PADDING, stageRead, dstWrote, null );
 
// FIXME: Not clear how this condition is dealt with.
//
// Fix for SF #506297, reported by Martin Forssen
// <ruric@users.sourceforge.net>.
//
// The encoding chosen in the script exposing the bug writes out
// three intro characters when TCL_ENCODING_START is set, but does
// not consume any input as TCL_ENCODING_END is cleared. As some
// output was generated the enclosing loop calls UtfToExternal
// again, again with START set. Three more characters in the out
// and still no use of input ... To break this infinite loop we
// remove TCL_ENCODING_START from the set of flags after the first
// call (no condition is required, the later calls remove an unset
// flag, which is a no-op). This causes the subsequent calls to
// UtfToExternal to consume and convert the actual input.
 
encodingStart = false;
 
// The following can never happen since we use unicode characters.
//
//if ((result != 0) && ((stageRead.i + dstWrote.i) == 0)) {
// // We have an incomplete UTF-8 character at the end of the
// // staging buffer. It will get moved to the beginning of the
// // staging buffer followed by more bytes from src.
//
// src -= stageLen.i;
// srcLen += stageLen.i;
// stageLen.i = 0;
// savedLF = 0;
// break;
//}
buf.nextAdded += dstWrote.i;
if ( buf.nextAdded > buf.bufLength )
{
// When translating from unicode to external encoding, we
// allowed the translation to produce a character that
// crossed the end of the output buffer, so that we would
// get a completely full buffer before flushing it. The
// extra bytes will be moved to the beginning of the next
// buffer.
 
saved = buf.nextAdded - buf.bufLength;
// ATK Array.Copy(SupportClass.ToByteArray((System.Array) dstArray), dst + dstLen, SupportClass.ToByteArray(safe), 0, saved);
Array.Copy( dstArray, dst + dstLen, safe, 0, saved );
buf.nextAdded = buf.bufLength;
}
if ( checkFlush( buf, ( sawLF != 0 ) ) != 0 )
{
return -1;
}
 
total += dstWrote.i;
stage += stageRead.i;
stageLen.i -= stageRead.i;
sawLF = 0;
 
consumedSomething = true;
 
// If all translated characters are written to the buffer,
// endEncoding is set to 0 because the escape sequence may be
// output.
 
if ( ( stageLen.i + saved == 0 ) && ( result == 0 ) )
{
endEncoding = 0;
}
}
}
 
// If nothing was written and it happened because there was no progress
// in the UTF conversion, we throw an error.
 
if ( !consumedSomething && ( total == 0 ) )
{
//Tcl_SetErrno (EINVAL);
return -1;
}
return total;
}
 
/// <summary> DoWriteChars -> doWriteChars
///
/// Takes a sequence of characters and converts them for output
/// using the channel's current encoding, may queue the buffer for
/// output if it gets full, and also remembers whether the current
/// buffer is ready e.g. if it contains a newline and we are in
/// line buffering mode. Compensates stacking, i.e. will redirect the
/// data from the specified channel to the topmost channel in a stack.
///
/// 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="src"> Chars to write.
/// </param>
/// <param name="srfOff"> First index in src array.
/// </param>
/// <param name="srfLen"> Number of chars to write.
/// </param>
 
internal int doWriteChars( char[] src, int srcOff, int srcLen )
{
// HACK ATK Was soll das?
return -1;
}
 
/// <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 );
}
}
}
}
/trunk/TCL/src/regexp_brazil/Regexp.cs
@@ -0,0 +1,1756 @@
/*
* Regexp.java
*
* Copyright (c) 1999 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* SCCS: %Z% %M% %I% %E% %U%
*/
// Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
//$Header$
 
using System;
using System.Text;
namespace sunlabs.brazil.util.regexp
{
 
/// <summary> The <code>Regexp</code> class can be used to match a pattern against a
/// string and optionally replace the matched parts with new strings.
/// <p>
/// Regular expressions were implemented by translating Henry Spencer's
/// regular expression package for <a href="http://www.scriptics.com">tcl8.0</a>.
/// Much of the description below is copied verbatim from the tcl8.0 regsub
/// manual entry.
/// <hr>
/// REGULAR EXPRESSIONS
/// <p>
/// A regular expression is zero or more <code>branches</code>, separated by
/// "|". It matches anything that matches one of the branches.
/// <p>
/// A branch is zero or more <code>pieces</code>, concatenated.
/// It matches a match for the first piece, followed by a match for the
/// second piece, etc.
/// <p>
/// A piece is an <code>atom</code>, possibly followed by "*", "+", or
/// "?". <ul>
/// <li> An atom followed by "*" matches a sequence of 0 or more matches of
/// the atom.
/// <li> An atom followed by "+" matches a sequence of 1 or more matches of
/// the atom.
/// <li> An atom followed by "?" matches either 0 or 1 matches of the atom.
/// </ul>
/// <p>
/// An atom is <ul>
/// <li> a regular expression in parentheses (matching a match for the
/// regular expression)
/// <li> a <code>range</code> (see below)
/// <li> "." (matching any single character)
/// <li> "^" (matching the null string at the beginning of the input string)
/// <li> "$" (matching the null string at the end of the input string)
/// <li> a "\" followed by a single character (matching that character)
/// <li> a single character with no other significance (matching that
/// character).
/// </ul>
/// <p>
/// A <code>range</code> is a sequence of characters enclosed in "[]".
/// The range normally matches any single character from the sequence.
/// If the sequence begins with "^", the range matches any single character
/// <b>not</b> from the rest of the sequence.
/// If two characters in the sequence are separated by "-", this is shorthand
/// for the full list of characters between them (e.g. "[0-9]" matches any
/// decimal digit). To include a literal "]" in the sequence, make it the
/// first character (following a possible "^"). To include a literal "-",
/// make it the first or last character.
/// <p>
/// In general there may be more than one way to match a regular expression
/// to an input string. For example, consider the command
/// <pre>
/// String[] match = new String[2];
/// Regexp.match("(a*)b*", "aabaaabb", match);
/// </pre>
/// Considering only the rules given so far, <code>match[0]</code> and
/// <code>match[1]</code> could end up with the values <ul>
/// <li> "aabb" and "aa"
/// <li> "aaab" and "aaa"
/// <li> "ab" and "a"
/// </ul>
/// or any of several other combinations. To resolve this potential ambiguity,
/// Regexp chooses among alternatives using the rule "first then longest".
/// In other words, it considers the possible matches in order working
/// from left to right across the input string and the pattern, and it
/// attempts to match longer pieces of the input string before shorter
/// ones. More specifically, the following rules apply in decreasing
/// order of priority: <ol>
/// <li> If a regular expression could match two different parts of an input
/// string then it will match the one that begins earliest.
/// <li> If a regular expression contains "|" operators then the
/// leftmost matching sub-expression is chosen.
/// <li> In "*", "+", and "?" constructs, longer matches are chosen in
/// preference to shorter ones.
/// <li>
/// In sequences of expression components the components are considered
/// from left to right.
/// </ol>
/// <p>
/// In the example from above, "(a*)b*" therefore matches exactly "aab"; the
/// "(a*)" portion of the pattern is matched first and it consumes the leading
/// "aa", then the "b*" portion of the pattern consumes the next "b". Or,
/// consider the following example:
/// <pre>
/// String match = new String[3];
/// Regexp.match("(ab|a)(b*)c", "abc", match);
/// </pre>
/// After this command, <code>match[0]</code> will be "abc",
/// <code>match[1]</code> will be "ab", and <code>match[2]</code> will be an
/// empty string.
/// Rule 4 specifies that the "(ab|a)" component gets first shot at the input
/// string and Rule 2 specifies that the "ab" sub-expression
/// is checked before the "a" sub-expression.
/// Thus the "b" has already been claimed before the "(b*)"
/// component is checked and therefore "(b*)" must match an empty string.
/// <hr>
/// <a name=regsub></a>
/// REGULAR EXPRESSION SUBSTITUTION
/// <p>
/// Regular expression substitution matches a string against a regular
/// expression, transforming the string by replacing the matched region(s)
/// with new substring(s).
/// <p>
/// What gets substituted into the result is controlled by a
/// <code>subspec</code>. The subspec is a formatting string that specifies
/// what portions of the matched region should be substituted into the
/// result.
/// <ul>
/// <li> "&" or "\0" is replaced with a copy of the entire matched region.
/// <li> "\<code>n</code>", where <code>n</code> is a digit from 1 to 9,
/// is replaced with a copy of the <code>n</code><i>th</i> subexpression.
/// <li> "\&" or "\\" are replaced with just "&" or "\" to escape their
/// special meaning.
/// <li> any other character is passed through.
/// </ul>
/// In the above, strings like "\2" represents the two characters
/// <code>backslash</code> and "2", not the Unicode character 0002.
/// <hr>
/// Here is an example of how to use Regexp
/// <pre>
///
/// public static void
/// main(String[] args)
/// throws Exception
/// {
/// Regexp re;
/// String[] matches;
/// String s;
///
/// &#47;*
/// * A regular expression to match the first line of a HTTP request.
/// *
/// * 1. ^ - starting at the beginning of the line
/// * 2. ([A-Z]+) - match and remember some upper case characters
/// * 3. [ \t]+ - skip blank space
/// * 4. ([^ \t]*) - match and remember up to the next blank space
/// * 5. [ \t]+ - skip more blank space
/// * 6. (HTTP/1\\.[01]) - match and remember HTTP/1.0 or HTTP/1.1
/// * 7. $ - end of string - no chars left.
/// *&#47;
///
/// s = "GET http://a.b.com:1234/index.html HTTP/1.1";
///
/// Regexp re = new Regexp("^([A-Z]+)[ \t]+([^ \t]+)[ \t]+(HTTP/1\\.[01])$");
/// String[] matches = new String[4];
/// if (re.match(s, matches)) {
/// System.out.println("METHOD " + matches[1]);
/// System.out.println("URL " + matches[2]);
/// System.out.println("VERSION " + matches[3]);
/// }
///
/// &#47;*
/// * A regular expression to extract some simple comma-separated data,
/// * reorder some of the columns, and discard column 2.
/// *&#47;
///
/// s = "abc,def,ghi,klm,nop,pqr";
///
/// Regexp re = new Regexp("^([^,]+),([^,]+),([^,]+),(.*)");
/// System.out.println(re.sub(s, "\\3,\\1,\\4"));
/// }
/// </pre>
///
/// </summary>
/// <author> Colin Stevens (colin.stevens@sun.com)
/// </author>
/// <version> 1.7, 99/10/14
/// </version>
/// <seealso cref="Regsub">
/// </seealso>
 
public class Regexp
{
//[STAThread]
//public static void Main(string[] args)
//{
// if ((args.Length == 2) && (args[0].Equals("compile")))
// {
// System.Diagnostics.Debug.WriteLine(new Regexp(args[1]));
// }
// else if ((args.Length == 3) && (args[0].Equals("match")))
// {
// Regexp r = new Regexp(args[1]);
// string[] substrs = new string[r.subspecs()];
// bool match = r.match(args[2], substrs);
// System.Diagnostics.Debug.WriteLine("match:\t" + match);
// for (int i = 0; i < substrs.Length; i++)
// {
// System.Diagnostics.Debug.WriteLine((i + 1) + ":\t" + substrs[i]);
// }
// }
// else if ((args.Length == 4) && (args[0].Equals("sub")))
// {
// Regexp r = new Regexp(args[1]);
// System.Diagnostics.Debug.WriteLine(r.subAll(args[2], args[3]));
// }
// else
// {
// System.Diagnostics.Debug.WriteLine("usage:");
// System.Diagnostics.Debug.WriteLine("\tRegexp match <pattern> <string>");
// System.Diagnostics.Debug.WriteLine("\tRegexp sub <pattern> <string> <subspec>");
// System.Diagnostics.Debug.WriteLine("\tRegexp compile <pattern>");
// }
//}
 
/*
* Structure for regexp "program". This is essentially a linear encoding
* of a nondeterministic finite-state machine (aka syntax charts or
* "railroad normal form" in parsing technology). Each node is an opcode
* plus a "next" pointer, possibly plus an operand. "Next" pointers of
* all nodes except BRANCH implement concatenation; a "next" pointer with
* a BRANCH on both ends of it is connecting two alternatives. (Here we
* have one of the subtle syntax dependencies: an individual BRANCH (as
* opposed to a collection of them) is never concatenated with anything
* because of operator precedence.) The operand of some types of node is
* a literal string; for others, it is a node leading into a sub-FSM. In
* particular, the operand of a BRANCH node is the first node of the branch.
* (NB this is *not* a tree structure: the tail of the branch connects
* to the thing following the set of BRANCHes.) The opcodes are:
*/
 
internal const int NSUBEXP = 100;
 
/* definition number opnd? meaning */
 
internal const char END = (char)( 0 ); /* no End of program. */
internal const char BOL = (char)( 1 ); /* no Match "" at beginning of line. */
internal const char EOL = (char)( 2 ); /* no Match "" at end of line. */
internal const char ANY = (char)( 3 ); /* no Match any one character. */
internal const char ANYOF = (char)( 4 ); /* str Match any character in this string. */
internal const char ANYBUT = (char)( 5 ); /* str Match any character not in this string. */
internal const char BRANCH = (char)( 6 ); /* node Match this alternative, or the next... */
internal const char BACK = (char)( 7 ); /* no Match "", "next" ptr points backward. */
internal const char EXACTLY = (char)( 8 ); /* str Match this string. */
internal const char NOTHING = (char)( 9 ); /* no Match empty string. */
internal const char STAR = (char)( 10 ); /* node Match this (simple) thing 0 or more times. */
internal const char PLUS = (char)( 11 ); /* node Match this (simple) thing 1 or more times. */
internal const char OPEN = (char)( 20 ); /* no Mark this point in input as start of #n. */
/* OPEN+1 is number 1, etc. */
internal static readonly char CLOSE = (char)( OPEN + NSUBEXP );
/* no Analogous to OPEN. */
internal static readonly string[] opnames = new string[] { "END", "BOL", "EOL", "ANY", "ANYOF", "ANYBUT", "BRANCH", "BACK", "EXACTLY", "NOTHING", "STAR", "PLUS" };
 
/*
* A node is one char of opcode followed by one char of "next" pointer.
* The value is a positive offset from the opcode of the node containing
* it. An operand, if any, simply follows the node. (Note that much of
* the code generation knows about this implicit relationship.)
*
* Opcode notes:
*
* BRANCH The set of branches constituting a single choice are hooked
* together with their "next" pointers, since precedence prevents
* anything being concatenated to any individual branch. The
* "next" pointer of the last BRANCH in a choice points to the
* thing following the whole choice. This is also where the
* final "next" pointer of each individual branch points; each
* branch starts with the operand node of a BRANCH node.
*
* ANYOF, ANYBUT, EXACTLY
* The format of a string operand is one char of length
* followed by the characters making up the string.
*
* BACK Normal "next" pointers all implicitly point forward; BACK
* exists to make loop structures possible.
*
* STAR, PLUS
* '?', and complex '*' and '+' are implemented as circular
* BRANCH structures using BACK. Simple cases (one character
* per match) are implemented with STAR and PLUS for speed
* and to minimize recursive plunges.
*
* OPENn, CLOSEn
* are numbered at compile time.
*/
 
 
/// <summary> The bytecodes making up the regexp program.</summary>
internal char[] program;
 
/// <summary> Whether the regexp matching should be case insensitive.</summary>
internal bool ignoreCase;
 
/// <summary> The number of parenthesized subexpressions in the regexp pattern,
/// plus 1 for the match of the whole pattern itself.
/// </summary>
internal int npar;
 
/// <summary> <code>true</code> if the pattern must match the beginning of the
/// string, so we don't have to waste time matching against all possible
/// starting locations in the string.
/// </summary>
internal bool anchored;
 
internal int startChar;
internal string must;
 
/// <summary> Compiles a new Regexp object from the given regular expression
/// pattern.
/// <p>
/// It takes a certain amount of time to parse and validate a regular
/// expression pattern before it can be used to perform matches
/// or substitutions. If the caller caches the new Regexp object, that
/// parsing time will be saved because the same Regexp can be used with
/// respect to many different strings.
///
/// </summary>
/// <param name="">pat
/// The string holding the regular expression pattern.
///
/// @throws IllegalArgumentException if the pattern is malformed.
/// The detail message for the exception will be set to a
/// string indicating how the pattern was malformed.
/// </param>
public Regexp( string pat )
{
compile( pat );
}
 
/// <summary> Compiles a new Regexp object from the given regular expression
/// pattern.
///
/// </summary>
/// <param name="">pat
/// The string holding the regular expression pattern.
///
/// </param>
/// <param name="">ignoreCase
/// If <code>true</code> then this regular expression will
/// do case-insensitive matching. If <code>false</code>, then
/// the matches are case-sensitive. Regular expressions
/// generated by <code>Regexp(String)</code> are case-sensitive.
///
/// @throws IllegalArgumentException if the pattern is malformed.
/// The detail message for the exception will be set to a
/// string indicating how the pattern was malformed.
/// </param>
public Regexp( string pat, bool ignoreCase )
{
this.ignoreCase = ignoreCase;
if ( ignoreCase )
{
pat = pat.ToLower();
}
compile( pat );
}
 
/// <summary> Returns the number of parenthesized subexpressions in this regular
/// expression, plus one more for this expression itself.
///
/// </summary>
/// <returns> The number.
/// </returns>
public int subspecs()
{
return npar;
}
 
/// <summary> Matches the given string against this regular expression.
///
/// </summary>
/// <param name="">str
/// The string to match.
///
/// </param>
/// <returns> The substring of <code>str</code> that matched the entire
/// regular expression, or <code>null</code> if the string did not
/// match this regular expression.
/// </returns>
public string match( string str )
{
Match m = exec( str, 0, 0 );
 
if ( m == null )
{
return null;
}
return str.Substring( m.indices[0], ( m.indices[1] ) - ( m.indices[0] ) );
}
 
/// <summary> Matches the given string against this regular expression, and computes
/// the set of substrings that matched the parenthesized subexpressions.
/// <p>
/// <code>substrs[0]</code> is set to the range of <code>str</code>
/// that matched the entire regular expression.
/// <p>
/// <code>substrs[1]</code> is set to the range of <code>str</code>
/// that matched the first (leftmost) parenthesized subexpression.
/// <code>substrs[n]</code> is set to the range that matched the
/// <code>n</code><i>th</i> subexpression, and so on.
/// <p>
/// If subexpression <code>n</code> did not match, then
/// <code>substrs[n]</code> is set to <code>null</code>. Not to
/// be confused with "", which is a valid value for a
/// subexpression that matched 0 characters.
/// <p>
/// The length that the caller should use when allocating the
/// <code>substr</code> array is the return value of
/// <code>Regexp.subspecs</code>. The array
/// can be shorter (in which case not all the information will
/// be returned), or longer (in which case the remainder of the
/// elements are initialized to <code>null</code>), or
/// <code>null</code> (to ignore the subexpressions).
///
/// </summary>
/// <param name="">str
/// The string to match.
///
/// </param>
/// <param name="">substrs
/// An array of strings allocated by the caller, and filled in
/// with information about the portions of <code>str</code> that
/// matched the regular expression. May be <code>null</code>.
///
/// </param>
/// <returns> <code>true</code> if <code>str</code> that matched this
/// regular expression, <code>false</code> otherwise.
/// If <code>false</code> is returned, then the contents of
/// <code>substrs</code> are unchanged.
///
/// </returns>
/// <seealso cref="#subspecs">
/// </seealso>
public bool match( string str, string[] substrs )
{
Match m = exec( str, 0, 0 );
 
if ( m == null )
{
return false;
}
if ( substrs != null )
{
int max = System.Math.Min( substrs.Length, npar );
int i;
int j = 0;
for ( i = 0; i < max; i++ )
{
int start = m.indices[j++];
int end = m.indices[j++];
if ( start < 0 )
{
substrs[i] = null;
}
else
{
substrs[i] = str.Substring( start, ( end ) - ( start ) );
}
}
for ( ; i < substrs.Length; i++ )
{
substrs[i] = null;
}
}
return true;
}
 
/// <summary> Matches the given string against this regular expression, and computes
/// the set of substrings that matched the parenthesized subexpressions.
/// <p>
/// For the indices specified below, the range extends from the character
/// at the starting index up to, but not including, the character at the
/// ending index.
/// <p>
/// <code>indices[0]</code> and <code>indices[1]</code> are set to
/// starting and ending indices of the range of <code>str</code>
/// that matched the entire regular expression.
/// <p>
/// <code>indices[2]</code> and <code>indices[3]</code> are set to the
/// starting and ending indices of the range of <code>str</code> that
/// matched the first (leftmost) parenthesized subexpression.
/// <code>indices[n * 2]</code> and <code>indices[n * 2 + 1]</code>
/// are set to the range that matched the <code>n</code><i>th</i>
/// subexpression, and so on.
/// <p>
/// If subexpression <code>n</code> did not match, then
/// <code>indices[n * 2]</code> and <code>indices[n * 2 + 1]</code>
/// are both set to <code>-1</code>.
/// <p>
/// The length that the caller should use when allocating the
/// <code>indices</code> array is twice the return value of
/// <code>Regexp.subspecs</code>. The array
/// can be shorter (in which case not all the information will
/// be returned), or longer (in which case the remainder of the
/// elements are initialized to <code>-1</code>), or
/// <code>null</code> (to ignore the subexpressions).
///
/// </summary>
/// <param name="">str
/// The string to match.
///
/// </param>
/// <param name="">indices
/// An array of integers allocated by the caller, and filled in
/// with information about the portions of <code>str</code> that
/// matched all the parts of the regular expression.
/// May be <code>null</code>.
///
/// </param>
/// <returns> <code>true</code> if the string matched the regular expression,
/// <code>false</code> otherwise. If <code>false</code> is
/// returned, then the contents of <code>indices</code> are
/// unchanged.
///
/// </returns>
/// <seealso cref="#subspecs">
/// </seealso>
public bool match( string str, int[] indices )
{
Match m = exec( str, 0, 0 );
 
if ( m == null )
{
return false;
}
if ( indices != null )
{
int max = System.Math.Min( indices.Length, npar * 2 );
Array.Copy( (System.Array)m.indices, 0, (System.Array)indices, 0, max );
 
for ( int i = max; i < indices.Length; i++ )
{
indices[i] = -1;
}
}
return true;
}
 
/// <summary> Matches a string against a regular expression and replaces the first
/// match with the string generated from the substitution parameter.
///
/// </summary>
/// <param name="">str
/// The string to match against this regular expression.
///
/// </param>
/// <param name="">subspec
/// The substitution parameter, described in <a href=#regsub>
/// REGULAR EXPRESSION SUBSTITUTION</a>.
///
/// </param>
/// <returns> The string formed by replacing the first match in
/// <code>str</code> with the string generated from
/// <code>subspec</code>. If no matches were found, then
/// the return value is <code>null</code>.
/// </returns>
public string sub( string str, string subspec )
{
Regsub rs = new Regsub( this, str );
if ( rs.nextMatch() )
{
StringBuilder sb = new StringBuilder( rs.skipped() );
applySubspec( rs, subspec, sb );
sb.Append( rs.rest() );
 
return sb.ToString();
}
else
{
return null;
}
}
 
/// <summary> Matches a string against a regular expression and replaces all
/// matches with the string generated from the substitution parameter.
/// After each substutition is done, the portions of the string already
/// examined, including the newly substituted region, are <b>not</b> checked
/// again for new matches -- only the rest of the string is examined.
///
/// </summary>
/// <param name="">str
/// The string to match against this regular expression.
///
/// </param>
/// <param name="">subspec
/// The substitution parameter, described in <a href=#regsub>
/// REGULAR EXPRESSION SUBSTITUTION</a>.
///
/// </param>
/// <returns> The string formed by replacing all the matches in
/// <code>str</code> with the strings generated from
/// <code>subspec</code>. If no matches were found, then
/// the return value is a copy of <code>str</code>.
/// </returns>
public string subAll( string str, string subspec )
{
return sub( str, new SubspecFilter( subspec, true ) );
}
 
/// <summary> Utility method to give access to the standard substitution algorithm
/// used by <code>sub</code> and <code>subAll</code>. Appends to the
/// string buffer the string generated by applying the substitution
/// parameter to the matched region.
///
/// </summary>
/// <param name="">rs
/// Information about the matched region.
///
/// </param>
/// <param name="">subspec
/// The substitution parameter.
///
/// </param>
/// <param name="">sb
/// StringBuffer to which the generated string is appended.
/// </param>
public static void applySubspec( Regsub rs, string subspec, StringBuilder sb )
{
try
{
int len = subspec.Length;
for ( int i = 0; i < len; i++ )
{
char ch = subspec[i];
switch ( ch )
{
 
case '&':
{
sb.Append( rs.matched() );
break;
}
 
case '\\':
{
i++;
ch = subspec[i];
if ( ( ch >= '0' ) && ( ch <= '9' ) )
{
string match = rs.submatch( ch - '0' );
if ( (System.Object)match != null )
{
sb.Append( match );
}
break;
}
// fall through.
}
goto default;
 
default:
{
sb.Append( ch );
}
break;
 
}
}
}
catch ( System.IndexOutOfRangeException e )
{
/*
* Ignore malformed substitution pattern.
* Return string matched so far.
*/
}
}
 
public string sub( string str, Filter rf )
{
Regsub rs = new Regsub( this, str );
if ( rs.nextMatch() == false )
{
return str;
}
 
StringBuilder sb = new StringBuilder();
do
{
sb.Append( rs.skipped() );
if ( rf.filter( rs, sb ) == false )
{
break;
}
}
while ( rs.nextMatch() );
sb.Append( rs.rest() );
return sb.ToString();
}
 
/// <summary> This interface is used by the <code>Regexp</code> class to generate
/// the replacement string for each pattern match found in the source
/// string.
///
/// </summary>
/// <author> Colin Stevens (colin.stevens@sun.com)
/// </author>
/// <version> 1.7, 99/10/14
/// </version>
public interface Filter
{
/// <summary> Given the current state of the match, generate the replacement
/// string. This method will be called for each match found in
/// the source string, unless this filter decides not to handle any
/// more matches.
/// <p>
/// The implementation can use whatever rules it chooses
/// to generate the replacement string. For example, here is an
/// example of a filter that replaces the first <b>5</b>
/// occurrences of "%XX" in a string with the ASCII character
/// represented by the hex digits "XX":
/// <pre>
/// String str = ...;
///
/// Regexp re = new Regexp("%[a-fA-F0-9][a-fA-F0-9]");
///
/// Regexp.Filter rf = new Regexp.Filter() {
/// int count = 5;
/// public boolean filter(Regsub rs, StringBuffer sb) {
/// String match = rs.matched();
/// int hi = Character.digit(match.charAt(1), 16);
/// int lo = Character.digit(match.charAt(2), 16);
/// sb.append((char) ((hi &lt;&lt; 4) | lo));
/// return (--count > 0);
/// }
/// }
///
/// String result = re.sub(str, rf);
/// </pre>
///
/// </summary>
/// <param name="">rs
/// <code>Regsub</code> containing the state of the current
/// match.
///
/// </param>
/// <param name="">sb
/// The string buffer that this filter should append the
/// generated string to. This string buffer actually
/// contains the results the calling <code>Regexp</code> has
/// generated up to this point.
///
/// </param>
/// <returns> <code>false</code> if no further matches should be
/// considered in this string, <code>true</code> to allow
/// <code>Regexp</code> to continue looking for further
/// matches.
/// </returns>
bool filter( Regsub rs, StringBuilder sb );
}
 
private class SubspecFilter : Filter
{
internal string subspec;
internal bool all;
 
public SubspecFilter( string subspec, bool all )
{
this.subspec = subspec;
this.all = all;
}
 
public bool filter( Regsub rs, StringBuilder sb )
{
sunlabs.brazil.util.regexp.Regexp.applySubspec( rs, subspec, sb );
return all;
}
}
 
/// <summary> Returns a string representation of this compiled regular
/// expression. The format of the string representation is a
/// symbolic dump of the bytecodes.
///
/// </summary>
/// <returns> A string representation of this regular expression.
/// </returns>
public override string ToString()
{
StringBuilder sb = new StringBuilder();
 
sb.Append( "# subs: " + npar + "\n" );
sb.Append( "anchor: " + anchored + "\n" );
sb.Append( "start: " + (char)startChar + "\n" );
sb.Append( "must: " + must + "\n" );
 
for ( int i = 0; i < program.Length; )
{
sb.Append( i + ":\t" );
int op = program[i];
if ( op >= CLOSE )
{
sb.Append( "CLOSE" + ( op - CLOSE ) );
}
else if ( op >= OPEN )
{
sb.Append( "OPEN" + ( op - OPEN ) );
}
else
{
sb.Append( opnames[op] );
}
int line;
int offset = (int)program[i + 1];
if ( offset == 0 )
{
sb.Append( '\t' );
}
else if ( op == BACK )
{
sb.Append( "\t-" + offset + "," + ( i - offset ) );
}
else
{
sb.Append( "\t+" + offset + "," + ( i + offset ) );
}
 
if ( ( op == ANYOF ) || ( op == ANYBUT ) || ( op == EXACTLY ) )
{
sb.Append( "\t'" );
sb.Append( program, i + 3, program[i + 2] );
sb.Append( "'" );
i += 3 + program[i + 2];
}
else
{
i += 2;
}
sb.Append( '\n' );
}
return sb.ToString();
}
 
 
private void compile( string exp )
{
Compiler rcstate = new Compiler();
rcstate.parse = exp.ToCharArray();
rcstate.off = 0;
rcstate.npar = 1;
rcstate.code = new StringBuilder();
 
rcstate.reg( false );
 
program = rcstate.code.ToString().ToCharArray();
npar = rcstate.npar;
startChar = -1;
 
/* optimize */
if ( program[rcstate.regnext( 0 )] == END )
{
if ( program[2] == BOL )
{
anchored = true;
}
else if ( program[2] == EXACTLY )
{
startChar = (int)program[5];
}
}
 
/*
* If there's something expensive in the r.e., find the
* longest literal string that must appear and make it the
* regmust. Resolve ties in favor of later strings, since
* the regstart check works with the beginning of the r.e.
* and avoiding duplication strengthens checking. Not a
* strong reason, but sufficient in the absence of others.
*/
/*
if ((rcstate.flagp & Compiler.SPSTART) != 0) {
int index = -1;
int longest = 0;
for (scan = 0; scan < program.length; ) {
switch (program[scan]) {
case EXACTLY:
int length = program[scan + 2];
if (length > longest) {
index = scan;
longest = length;
}
// fall through;
case ANYOF:
case ANYBUT:
scan += 3 + program[scan + 2];
break;
default:
scan += 2;
break;
}
}
if (longest > 0) {
must = new String(program, index + 3, longest);
}
}*/
}
 
internal Match exec( string str, int start, int off )
{
if ( ignoreCase )
{
str = str.ToLower();
}
 
Match match = new Match();
 
match.program = program;
 
/* Mark beginning of line for ^ . */
match.str = str;
match.bol = start;
match.length = str.Length;
 
match.indices = new int[npar * 2];
 
if ( anchored )
{
/* Simplest case: anchored match need be tried only once. */
if ( match.regtry( off ) )
{
return match;
}
}
else if ( startChar >= 0 )
{
/* We know what char it must start with. */
while ( off < match.length )
{
off = str.IndexOf( (System.Char)startChar, off );
if ( off < 0 )
{
break;
}
if ( match.regtry( off ) )
{
return match;
}
off++;
}
}
else
{
/* Messy cases: unanchored match. */
do
{
if ( match.regtry( off ) )
{
return match;
}
}
while ( off++ < match.length );
}
return null;
}
 
internal class Compiler
{
internal char[] parse;
internal int off;
internal int npar;
internal StringBuilder code;
internal int flagp;
 
 
internal const string META = "^$.[()|?+*\\";
internal const string MULT = "*+?";
 
internal const int WORST = 0; /* Worst case. */
internal const int HASWIDTH = 1; /* Known never to match null string. */
internal const int SIMPLE = 2; /* Simple enough to be STAR/PLUS operand. */
internal const int SPSTART = 4; /* Starts with * or +. */
 
/*
- reg - regular expression, i.e. main body or parenthesized thing
*
* Caller must absorb opening parenthesis.
*
* Combining parenthesis handling with the base level of regular expression
* is a trifle forced, but the need to tie the tails of the branches to what
* follows makes it hard to avoid.
*/
internal int reg( bool paren )
{
int netFlags = HASWIDTH;
int parno = 0;
 
int ret = -1;
if ( paren )
{
parno = npar++;
if ( npar >= sunlabs.brazil.util.regexp.Regexp.NSUBEXP )
{
throw new System.ArgumentException( "too many ()" );
}
ret = regnode( (char)( sunlabs.brazil.util.regexp.Regexp.OPEN + parno ) );
}
 
/* Pick up the branches, linking them together. */
int br = regbranch();
if ( ret >= 0 )
{
regtail( ret, br );
}
else
{
ret = br;
}
 
if ( ( flagp & HASWIDTH ) == 0 )
{
netFlags &= ~HASWIDTH;
}
netFlags |= ( flagp & SPSTART );
while ( ( off < parse.Length ) && ( parse[off] == '|' ) )
{
off++;
br = regbranch();
regtail( ret, br );
if ( ( flagp & HASWIDTH ) == 0 )
{
netFlags &= ~HASWIDTH;
}
netFlags |= ( flagp & SPSTART );
}
 
/* Make a closing node, and hook it on the end. */
int ender = regnode( ( paren ) ? (char)( sunlabs.brazil.util.regexp.Regexp.CLOSE + parno ) : sunlabs.brazil.util.regexp.Regexp.END );
regtail( ret, ender );
 
/* Hook the tails of the branches to the closing node. */
for ( br = ret; br >= 0; br = regnext( br ) )
{
regoptail( br, ender );
}
 
/* Check for proper termination. */
if ( paren && ( ( off >= parse.Length ) || ( parse[off++] != ')' ) ) )
{
throw new System.ArgumentException( "missing )" );
}
else if ( ( paren == false ) && ( off < parse.Length ) )
{
throw new System.ArgumentException( "unexpected )" );
}
 
flagp = netFlags;
return ret;
}
 
/*
- regbranch - one alternative of an | operator
*
* Implements the concatenation operator.
*/
internal int regbranch()
{
int netFlags = WORST; /* Tentatively. */
 
int ret = regnode( sunlabs.brazil.util.regexp.Regexp.BRANCH );
int chain = -1;
while ( ( off < parse.Length ) && ( parse[off] != '|' ) && ( parse[off] != ')' ) )
{
int latest = regpiece();
netFlags |= flagp & HASWIDTH;
if ( chain < 0 )
{
/* First piece. */
netFlags |= ( flagp & SPSTART );
}
else
{
regtail( chain, latest );
}
chain = latest;
}
if ( chain < 0 )
{
/* Loop ran zero times. */
regnode( sunlabs.brazil.util.regexp.Regexp.NOTHING );
}
 
flagp = netFlags;
return ret;
}
 
/*
- regpiece - something followed by possible [*+?]
*
* Note that the branching code sequences used for ? and the general cases
* of * and + are somewhat optimized: they use the same NOTHING node as
* both the endmarker for their branch list and the body of the last branch.
* It might seem that this node could be dispensed with entirely, but the
* endmarker role is not redundant.
*/
internal int regpiece()
{
int netFlags;
 
int ret = regatom();
 
if ( ( off >= parse.Length ) || ( isMult( parse[off] ) == false ) )
{
return ret;
}
char op = parse[off];
 
if ( ( ( flagp & HASWIDTH ) == 0 ) && ( op != '?' ) )
{
throw new System.ArgumentException( "*+ operand could be empty" );
}
netFlags = ( op != '+' ) ? ( WORST | SPSTART ) : ( WORST | HASWIDTH );
 
if ( ( op == '*' ) && ( ( flagp & SIMPLE ) != 0 ) )
{
reginsert( sunlabs.brazil.util.regexp.Regexp.STAR, ret );
}
else if ( op == '*' )
{
/* Emit x* as (x&|), where & means "self". */
reginsert( sunlabs.brazil.util.regexp.Regexp.BRANCH, ret ); /* Either x */
regoptail( ret, regnode( sunlabs.brazil.util.regexp.Regexp.BACK ) ); /* and loop */
regoptail( ret, ret ); /* back */
regtail( ret, regnode( sunlabs.brazil.util.regexp.Regexp.BRANCH ) ); /* or */
regtail( ret, regnode( sunlabs.brazil.util.regexp.Regexp.NOTHING ) ); /* null. */
}
else if ( ( op == '+' ) && ( ( flagp & SIMPLE ) != 0 ) )
{
reginsert( sunlabs.brazil.util.regexp.Regexp.PLUS, ret );
}
else if ( op == '+' )
{
/* Emit x+ as x(&|), where & means "self". */
int next = regnode( sunlabs.brazil.util.regexp.Regexp.BRANCH ); /* Either */
regtail( ret, next );
regtail( regnode( sunlabs.brazil.util.regexp.Regexp.BACK ), ret ); /* loop back */
regtail( next, regnode( sunlabs.brazil.util.regexp.Regexp.BRANCH ) ); /* or */
regtail( ret, regnode( sunlabs.brazil.util.regexp.Regexp.NOTHING ) ); /* null. */
}
else if ( op == '?' )
{
/* Emit x? as (x|) */
reginsert( sunlabs.brazil.util.regexp.Regexp.BRANCH, ret ); /* Either x */
regtail( ret, regnode( sunlabs.brazil.util.regexp.Regexp.BRANCH ) ); /* or */
int next = regnode( sunlabs.brazil.util.regexp.Regexp.NOTHING ); /* null. */
regtail( ret, next );
regoptail( ret, next );
}
off++;
if ( ( off < parse.Length ) && isMult( parse[off] ) )
{
throw new System.ArgumentException( "nested *?+" );
}
 
flagp = netFlags;
return ret;
}
 
/*
- regatom - the lowest level
*
* Optimization: gobbles an entire sequence of ordinary characters so that
* it can turn them into a single node, which is smaller to store and
* faster to run. Backslashed characters are exceptions, each becoming a
* separate node; the code is simpler that way and it's not worth fixing.
*/
internal int regatom()
{
int netFlags = WORST; /* Tentatively. */
int ret;
 
switch ( parse[off++] )
{
 
case '^':
ret = regnode( sunlabs.brazil.util.regexp.Regexp.BOL );
break;
 
case '$':
ret = regnode( sunlabs.brazil.util.regexp.Regexp.EOL );
break;
 
case '.':
ret = regnode( sunlabs.brazil.util.regexp.Regexp.ANY );
netFlags |= ( HASWIDTH | SIMPLE );
break;
 
case '[':
{
try
{
if ( parse[off] == '^' )
{
ret = regnode( sunlabs.brazil.util.regexp.Regexp.ANYBUT );
off++;
}
else
{
ret = regnode( sunlabs.brazil.util.regexp.Regexp.ANYOF );
}
 
int pos = reglen();
regc( '\x0000' );
 
if ( ( parse[off] == ']' ) || ( parse[off] == '-' ) )
{
regc( parse[off++] );
}
while ( parse[off] != ']' )
{
if ( parse[off] == '-' )
{
off++;
if ( parse[off] == ']' )
{
regc( '-' );
}
else
{
int start = parse[off - 2];
int end = parse[off++];
if ( start > end )
{
throw new System.ArgumentException( "invalid [] range" );
}
for ( int i = start + 1; i <= end; i++ )
{
regc( (char)i );
}
}
}
else
{
regc( parse[off++] );
}
}
regset( pos, (char)( reglen() - pos - 1 ) );
off++;
netFlags |= HASWIDTH | SIMPLE;
}
catch ( System.IndexOutOfRangeException e )
{
throw new System.ArgumentException( "missing ]" );
}
break;
}
 
case '(':
ret = reg( true );
netFlags |= ( flagp & ( HASWIDTH | SPSTART ) );
break;
 
case '|':
case ')':
throw new System.ArgumentException( "internal urp" );
 
case '?':
case '+':
case '*':
throw new System.ArgumentException( "?+* follows nothing" );
 
case '\\':
if ( off >= parse.Length )
{
throw new System.ArgumentException( "trailing \\" );
}
ret = regnode( sunlabs.brazil.util.regexp.Regexp.EXACTLY );
regc( (char)1 );
regc( parse[off++] );
netFlags |= HASWIDTH | SIMPLE;
break;
 
default:
{
off--;
int end;
for ( end = off; end < parse.Length; end++ )
{
if ( META.IndexOf( (System.Char)parse[end] ) >= 0 )
{
break;
}
}
if ( ( end > off + 1 ) && ( end < parse.Length ) && isMult( parse[end] ) )
{
end--; /* Back off clear of ?+* operand. */
}
netFlags |= HASWIDTH;
if ( end == off + 1 )
{
netFlags |= SIMPLE;
}
ret = regnode( sunlabs.brazil.util.regexp.Regexp.EXACTLY );
regc( (char)( end - off ) );
for ( ; off < end; off++ )
{
regc( parse[off] );
}
}
break;
 
}
 
flagp = netFlags;
return ret;
}
 
/*
- regnode - emit a node
*/
internal int regnode( char op )
{
int ret = code.Length;
code.Append( op );
code.Append( '\x0000' );
 
return ret;
}
 
/*
- regc - emit (if appropriate) a byte of code
*/
internal void regc( char b )
{
code.Append( b );
}
 
internal int reglen()
{
return code.Length;
}
 
internal void regset( int pos, char ch )
{
code[pos] = ch;
}
 
 
/*
- reginsert - insert an operator in front of already-emitted operand
*
* Means relocating the operand.
*/
internal void reginsert( char op, int pos )
{
char[] tmp = new char[] { op, '\x0000' };
code.Insert( pos, tmp );
}
 
/*
- regtail - set the next-pointer at the end of a node chain
*/
internal void regtail( int pos, int val )
{
/* Find last node. */
 
int scan = pos;
while ( true )
{
int tmp = regnext( scan );
if ( tmp < 0 )
{
break;
}
scan = tmp;
}
 
int offset = ( code[scan] == sunlabs.brazil.util.regexp.Regexp.BACK ) ? scan - val : val - scan;
code[scan + 1] = (char)offset;
}
 
/*
- regoptail - regtail on operand of first argument; nop if operandless
*/
internal void regoptail( int pos, int val )
{
if ( ( pos < 0 ) || ( code[pos] != sunlabs.brazil.util.regexp.Regexp.BRANCH ) )
{
return;
}
regtail( pos + 2, val );
}
 
 
/*
- regnext - dig the "next" pointer out of a node
*/
internal int regnext( int pos )
{
int offset = code[pos + 1];
if ( offset == 0 )
{
return -1;
}
if ( code[pos] == sunlabs.brazil.util.regexp.Regexp.BACK )
{
return pos - offset;
}
else
{
return pos + offset;
}
}
 
internal static bool isMult( char ch )
{
return ( ch == '*' ) || ( ch == '+' ) || ( ch == '?' );
}
}
 
internal class Match
{
internal char[] program;
 
internal string str;
internal int bol;
internal int input;
internal int length;
 
internal int[] indices;
 
internal bool regtry( int off )
{
this.input = off;
 
for ( int i = 0; i < indices.Length; i++ )
{
indices[i] = -1;
}
 
if ( regmatch( 0 ) )
{
indices[0] = off;
indices[1] = input;
return true;
}
else
{
return false;
}
}
 
/*
- regmatch - main matching routine
*
* Conceptually the strategy is simple: check to see whether the current
* node matches, call self recursively to see whether the rest matches,
* and then act accordingly. In practice we make some effort to avoid
* recursion, in particular by going through "ordinary" nodes (that don't
* need to know whether the rest of the match failed) by a loop instead of
* by recursion.
*/
internal bool regmatch( int scan )
{
while ( true )
{
int next = regnext( scan );
int op = program[scan];
switch ( op )
{
 
case sunlabs.brazil.util.regexp.Regexp.BOL:
if ( input != bol )
{
return false;
}
break;
 
 
case sunlabs.brazil.util.regexp.Regexp.EOL:
if ( input != length )
{
return false;
}
break;
 
 
case sunlabs.brazil.util.regexp.Regexp.ANY:
if ( input >= length )
{
return false;
}
input++;
break;
 
 
case sunlabs.brazil.util.regexp.Regexp.EXACTLY:
{
if ( compare( scan ) == false )
{
return false;
}
break;
}
 
 
case sunlabs.brazil.util.regexp.Regexp.ANYOF:
if ( input >= length )
{
return false;
}
if ( present( scan ) == false )
{
return false;
}
input++;
break;
 
 
case sunlabs.brazil.util.regexp.Regexp.ANYBUT:
if ( input >= length )
{
return false;
}
if ( present( scan ) )
{
return false;
}
input++;
break;
 
 
case sunlabs.brazil.util.regexp.Regexp.NOTHING:
case sunlabs.brazil.util.regexp.Regexp.BACK:
break;
 
 
case sunlabs.brazil.util.regexp.Regexp.BRANCH:
{
if ( program[next] != sunlabs.brazil.util.regexp.Regexp.BRANCH )
{
next = scan + 2;
}
else
{
do
{
int save = input;
if ( regmatch( scan + 2 ) )
{
return true;
}
input = save;
scan = regnext( scan );
}
while ( ( scan >= 0 ) && ( program[scan] == sunlabs.brazil.util.regexp.Regexp.BRANCH ) );
return false;
}
break;
}
 
 
case sunlabs.brazil.util.regexp.Regexp.STAR:
case sunlabs.brazil.util.regexp.Regexp.PLUS:
{
/*
* Lookahead to avoid useless match attempts
* when we know what character comes next.
*/
 
int ch = -1;
if ( program[next] == sunlabs.brazil.util.regexp.Regexp.EXACTLY )
{
ch = program[next + 3];
}
 
int min = ( op == sunlabs.brazil.util.regexp.Regexp.STAR ) ? 0 : 1;
int save = input;
int no = regrepeat( scan + 2 );
 
while ( no >= min )
{
/* If it could work, try it. */
if ( ( ch < 0 ) || ( ( input < length ) && ( str[input] == ch ) ) )
{
if ( regmatch( next ) )
{
return true;
}
}
/* Couldn't or didn't -- back up. */
no--;
input = save + no;
}
return false;
}
 
 
case sunlabs.brazil.util.regexp.Regexp.END:
return true;
 
 
default:
if ( op >= sunlabs.brazil.util.regexp.Regexp.CLOSE )
{
int no = op - sunlabs.brazil.util.regexp.Regexp.CLOSE;
int save = input;
 
if ( regmatch( next ) )
{
/*
* Don't set endp if some later
* invocation of the same parentheses
* already has.
*/
if ( indices[no * 2 + 1] <= 0 )
{
indices[no * 2 + 1] = save;
}
return true;
}
}
else if ( op >= sunlabs.brazil.util.regexp.Regexp.OPEN )
{
int no = op - sunlabs.brazil.util.regexp.Regexp.OPEN;
int save = input;
 
if ( regmatch( next ) )
{
/*
* Don't set startp if some later invocation of the
* same parentheses already has.
*/
if ( indices[no * 2] <= 0 )
{
indices[no * 2] = save;
}
return true;
}
}
return false;
 
}
scan = next;
}
}
 
internal bool compare( int scan )
{
int count = program[scan + 2];
if ( input + count > length )
{
return false;
}
int start = scan + 3;
int end = start + count;
for ( int i = start; i < end; i++ )
{
if ( str[input++] != program[i] )
{
return false;
}
}
return true;
}
 
internal bool present( int scan )
{
char ch = str[input];
 
int count = program[scan + 2];
int start = scan + 3;
int end = start + count;
 
for ( int i = start; i < end; i++ )
{
if ( program[i] == ch )
{
return true;
}
}
return false;
}
 
 
/*
- regrepeat - repeatedly match something simple, report how many
*/
internal int regrepeat( int scan )
{
int op = program[scan];
int count = 0;
 
switch ( op )
{
 
case sunlabs.brazil.util.regexp.Regexp.ANY:
 
count = length - input;
input = length;
break;
 
 
case sunlabs.brazil.util.regexp.Regexp.EXACTLY:
{
// 'g*' matches all the following 'g' characters.
 
char ch = program[scan + 3];
while ( ( input < length ) && ( str[input] == ch ) )
{
input++;
count++;
}
break;
}
 
 
case sunlabs.brazil.util.regexp.Regexp.ANYOF:
 
while ( ( input < length ) && present( scan ) )
{
input++;
count++;
}
break;
 
 
 
case sunlabs.brazil.util.regexp.Regexp.ANYBUT:
while ( ( input < length ) && !present( scan ) )
{
input++;
count++;
}
break;
}
return count;
}
 
/*
- regnext - dig the "next" pointer out of a node
*/
internal int regnext( int scan )
{
int offset = program[scan + 1];
if ( program[scan] == sunlabs.brazil.util.regexp.Regexp.BACK )
{
return scan - offset;
}
else
{
return scan + offset;
}
}
}
}
}
/trunk/TCL/src/regexp_brazil/Regsub.cs
@@ -0,0 +1,214 @@
/*
* Regsub.java
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL
* WARRANTIES.
*
* SCCS: %Z% %M% %I% %E% %U%
*/
// Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
//$Header$
 
using System;
namespace sunlabs.brazil.util.regexp
{
 
/// <summary> The <code>Regsub</code> class provides an iterator-like object to
/// extract the matched and unmatched portions of a string with respect to
/// a given regular expression.
/// <p>
/// After each match is found, the portions of the string already
/// checked are not searched again -- searching for the next match will
/// begin at the character just after where the last match ended.
/// <p>
/// Here is an example of using Regsub to replace all "%XX" sequences in
/// a string with the ASCII character represented by the hex digits "XX":
/// <pre>
/// public static void
/// main(String[] args)
/// throws Exception
/// {
/// Regexp re = new Regexp("%[a-fA-F0-9][a-fA-F0-9]");
/// Regsub rs = new Regsub(re, args[0]);
///
/// StringBuffer sb = new StringBuffer();
///
/// while (rs.nextMatch()) {
/// sb.append(rs.skipped());
///
/// String match = rs.matched();
///
/// int hi = Character.digit(match.charAt(1), 16);
/// int lo = Character.digit(match.charAt(2), 16);
/// sb.append((char) ((hi &lt;&lt; 4) | lo));
/// }
/// sb.append(rs.rest());
///
/// System.out.println(sb);
/// }
/// </pre>
///
/// </summary>
/// <author> Colin Stevens (colin.stevens@sun.com)
/// </author>
/// <version> 1.4, 99/10/14
/// </version>
/// <seealso cref="Regexp">
/// </seealso>
public class Regsub
{
internal Regexp r;
internal string str;
internal int ustart;
internal int mstart;
internal int end;
internal Regexp.Match m;
 
/// <summary> Construct a new <code>Regsub</code> that can be used to step
/// through the given string, finding each substring that matches
/// the given regular expression.
/// <p>
/// <code>Regexp</code> contains two substitution methods,
/// <code>sub</code> and <code>subAll</code>, that can be used instead
/// of <code>Regsub</code> if just simple substitutions are being done.
///
/// </summary>
/// <param name="">r
/// The compiled regular expression.
///
/// </param>
/// <param name="">str
/// The string to search.
///
/// </param>
/// <seealso cref="Regexp#sub">
/// </seealso>
/// <seealso cref="Regexp#subAll">
/// </seealso>
public Regsub( Regexp r, string str )
{
this.r = r;
this.str = str;
this.ustart = 0;
this.mstart = -1;
this.end = 0;
}
 
/// <summary> Searches for the next substring that matches the regular expression.
/// After calling this method, the caller would call methods like
/// <code>skipped</code>, <code>matched</code>, etc. to query attributes
/// of the matched region.
/// <p>
/// Calling this function again will search for the next match, beginning
/// at the character just after where the last match ended.
///
/// </summary>
/// <returns> <code>true</code> if a match was found, <code>false</code>
/// if there are no more matches.
/// </returns>
public bool nextMatch()
{
ustart = end;
 
/*
* Consume one character if the last match didn't consume any
* characters, to avoid an infinite loop.
*/
 
int off = ustart;
if ( off == mstart )
{
off++;
if ( off >= str.Length )
{
return false;
}
}
 
 
m = r.exec( str, 0, off );
if ( m == null )
{
return false;
}
 
mstart = m.indices[0];
end = m.indices[1];
 
return true;
}
 
/// <summary> Returns a substring consisting of all the characters skipped
/// between the end of the last match (or the start of the original
/// search string) and the start of this match.
/// <p>
/// This method can be used extract all the portions of string that
/// <b>didn't</b> match the regular expression.
///
/// </summary>
/// <returns> The characters that didn't match.
/// </returns>
public string skipped()
{
return str.Substring( ustart, ( mstart ) - ( ustart ) );
}
 
/// <summary> Returns a substring consisting of the characters that matched
/// the entire regular expression during the last call to
/// <code>nextMatch</code>.
///
/// </summary>
/// <returns> The characters that did match.
///
/// </returns>
/// <seealso cref="#submatch">
/// </seealso>
public string matched()
{
return str.Substring( mstart, ( end ) - ( mstart ) );
}
 
/// <summary> Returns a substring consisting of the characters that matched
/// the given parenthesized subexpression during the last call to
/// <code>nextMatch</code>.
///
/// </summary>
/// <param name="">i
/// The index of the parenthesized subexpression.
///
/// </param>
/// <returns> The characters that matched the subexpression, or
/// <code>null</code> if the given subexpression did not
/// exist or did not match.
/// </returns>
public string submatch( int i )
{
if ( i * 2 + 1 >= m.indices.Length )
{
return null;
}
int start = m.indices[i * 2];
int end = m.indices[i * 2 + 1];
if ( ( start < 0 ) || ( end < 0 ) )
{
return null;
}
return str.Substring( start, ( end ) - ( start ) );
}
 
/// <summary> Returns a substring consisting of all the characters that come
/// after the last match. As the matches progress, the <code>rest</code>
/// gets shorter. When <code>nextMatch</code> returns <code>false</code>,
/// then this method will return the rest of the string that can't be
/// matched.
///
/// </summary>
/// <returns> The rest of the characters after the last match.
/// </returns>
public string rest()
{
return str.Substring( end );
}
}
}
/trunk/TCL/src/tcl_h.cs
@@ -0,0 +1,2376 @@
namespace tcl.lang
{
public partial class TCL
{
 
/*
* tcl.h --
*
* This header file describes the externally-visible facilities
* of the Tcl interpreter.
*
* Copyright (c) 1987-1994 The Regents of the University of California.
* Copyright (c) 1993-1996 Lucent Technologies.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 by Scriptics Corporation.
* Copyright (c) 2002 by Kevin B. Kenny. All rights reserved.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
*
* RCS @(#) $Id: tcl.h,v 1.153.2.34 2008/02/06 15:25:15 dgp Exp $
*/
 
#if !_TCL
//#define _TCL
 
/*
* For C++ compilers, use extern "C"
*/
 
#if __cplusplus
//extern "C" {
#endif
 
/*
* The following defines are used to indicate the various release levels.
*/
 
//#define TCL_ALPHA_RELEASE 0
//#define TCL_BETA_RELEASE 1
//#define TCL_FINAL_RELEASE 2
 
/*
* When version numbers change here, must also go into the following files
* and update the version numbers:
*
* library/init.tcl (only if Major.minor changes, not patchlevel) 1 LOC
* unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch)
* win/configure.in (as above)
* win/tcl.m4 (not patchlevel)
* win/makefile.vc (not patchlevel) 2 LOC
* README (sections 0 and 2)
* mac/README (2 LOC, not patchlevel)
* macosx/Tcl.pbproj/project.pbxproj (not patchlevel) 1 LOC
* macosx/Tcl.pbproj/default.pbxuser (not patchlevel) 1 LOC
* win/README.binary (sections 0-4)
* win/README (not patchlevel) (sections 0 and 2)
* unix/tcl.spec (2 LOC Major/Minor, 1 LOC patch)
* tests/basic.test (1 LOC M/M, not patchlevel)
* tools/tcl.hpj.in (not patchlevel, for windows installer)
* tools/tcl.wse.in (for windows installer)
* tools/tclSplash.bmp (not patchlevel)
*/
//#define TCL_MAJOR_VERSION 8
//#define TCL_MINOR_VERSION 4
//#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
//#define TCL_RELEASE_SERIAL 18
 
//#define TCL_VERSION "8.4"
//#define TCL_PATCH_LEVEL "8.4.18"
 
/*
* The following definitions set up the proper options for Windows
* compilers. We use this method because there is no autoconf equivalent.
*/
 
//#if !__WIN32__
//# if defined(_WIN32) || defined(WIN32) || defined(__MINGW32__) || defined(__BORLANDC__)
//# define __WIN32__
//# ifndef WIN32
//# define WIN32
//# endif
//# endif
//#endif
 
/*
* STRICT: See MSDN Article Q83456
*/
//#if __WIN32__
//# ifndef STRICT
//# define STRICT
//# endif
//#endif // * __WIN32__ */
 
/*
* The following definitions set up the proper options for Macintosh
* compilers. We use this method because there is no autoconf equivalent.
*/
 
//#if MAC_TCL
//#include <ConditionalMacros.h>
//# ifndef USE_TCLALLOC
//# define USE_TCLALLOC 1
//# endif
//# ifndef NO_STRERROR
//# define NO_STRERROR 1
//# endif
//# define INLINE
//#endif
 
 
/*
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
* quotation marks), JOIN joins two arguments.
*/
//#if !STRINGIFY
//# define STRINGIFY(x) STRINGIFY1(x)
//# define STRINGIFY1(x) #x
//#endif
//#if !JOIN
//# define JOIN(a,b) JOIN1(a,b)
//# define JOIN1(a,b) a##b
//#endif
 
/*
* A special definition used to allow this header file to be included
* from windows or mac resource files so that they can obtain version
* information. RC_INVOKED is defined by default by the windows RC tool
* and manually set for macintosh.
*
* Resource compilers don't like all the C stuff, like typedefs and
* procedure declarations, that occur below, so block them out.
*/
 
#if !RC_INVOKED
 
/*
* Special macro to define mutexes, that doesn't do anything
* if we are not using threads.
*/
 
#if TCL_THREADS
//#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name;
#else
//#define TCL_DECLARE_MUTEX(name)
#endif
 
/*
* Macros that eliminate the overhead of the thread synchronization
* functions when compiling without thread support.
*/
 
#if !TCL_THREADS
//#define Tcl_MutexLock(mutexPtr)
//#define Tcl_MutexUnlock(mutexPtr)
//#define Tcl_MutexFinalize(mutexPtr)
//#define Tcl_ConditionNotify(condPtr)
//#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
//#define Tcl_ConditionFinalize(condPtr)
#endif // * TCL_THREADS */
 
 
//#if !BUFSIZ
//# include <stdio.h>
//#endif
 
 
/*
* Definitions that allow Tcl functions with variable numbers of
* arguments to be used with either varargs.h or stdarg.h. TCL_VARARGS
* is used in procedure prototypes. TCL_VARARGS_DEF is used to declare
* the arguments in a function definiton: it takes the type and name of
* the first argument and supplies the appropriate argument declaration
* string for use in the function definition. TCL_VARARGS_START
* initializes the va_list data structure and returns the first argument.
*/
//#if !(NO_STDARG)
//# include <stdarg.h>
//# define TCL_VARARGS(type, name) (type name, ...)
//# define TCL_VARARGS_DEF(type, name) (type name, ...)
//# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
//#else
//# include <varargs.h>
//# define TCL_VARARGS(type, name) ()
//# define TCL_VARARGS_DEF(type, name) (va_alist)
//# define TCL_VARARGS_START(type, name, list) \
// (va_start(list), va_arg(list, type))
//#endif
 
/*
* Macros used to declare a function to be exported by a DLL.
* Used by Windows, maps to no-op declarations on non-Windows systems.
* The default build on windows is for a DLL, which causes the DLLIMPORT
* and DLLEXPORT macros to be nonempty. To build a static library, the
* macro STATIC_BUILD should be defined.
*/
 
//#if STATIC_BUILD
//# define DLLIMPORT
//# define DLLEXPORT
//#else
//# if (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || (defined(__GNUC__) && defined(__declspec)))) || (defined(MAC_TCL) && FUNCTION_DECLSPEC)
//# define DLLIMPORT __declspec(dllimport)
//# define DLLEXPORT __declspec(dllexport)
//# else
//# define DLLIMPORT
//# define DLLEXPORT
//# endif
//#endif
 
/*
* These macros are used to control whether functions are being declared for
* import or export. If a function is being declared while it is being built
* to be included in a shared library, then it should have the DLLEXPORT
* storage class. If is being declared for use by a module that is going to
* link against the shared library, then it should have the DLLIMPORT storage
* class. If the symbol is beind declared for a static build or for use from a
* stub library, then the storage class should be empty.
*
* The convention is that a macro called BUILD_xxxx, where xxxx is the
* name of a library we are building, is set on the compile line for sources
* that are to be placed in the library. When this macro is set, the
* storage class will be set to DLLEXPORT. At the end of the header file, the
* storage class will be reset to DLLIMPORT.
*/
//#undef TCL_STORAGE_CLASS
//#if BUILD_tcl
//# define TCL_STORAGE_CLASS DLLEXPORT
//#else
//# ifdef USE_TCL_STUBS
//# define TCL_STORAGE_CLASS
//# else
//# define TCL_STORAGE_CLASS DLLIMPORT
//# endif
//#endif
 
 
/*
* Definitions that allow this header file to be used either with or
* without ANSI C features like function prototypes.
*/
//#undef _ANSI_ARGS_
//#undef CONST
//#if !INLINE
//# define INLINE
//#endif
 
//#if !NO_CONST
//# define CONST const
//#else
//# define CONST
//#endif
 
//#if !NO_PROTOTYPES
//# define _ANSI_ARGS_(x) x
//#else
//# define _ANSI_ARGS_(x) ()
//#endif
 
//#if USE_NON_CONST
//# ifdef USE_COMPAT_CONST
//# error define at most one of USE_NON_CONST and USE_COMPAT_CONST
//# endif
//# define CONST84
//# define CONST84_RETURN
//#else
//# ifdef USE_COMPAT_CONST
//# define CONST84
//# define CONST84_RETURN CONST
//# else
//# define CONST84 CONST
//# define CONST84_RETURN CONST
//# endif
//#endif
 
 
/*
* Make sure EXTERN isn't defined elsewhere
*/
//#if EXTERN
//# undef EXTERN
//#endif // * EXTERN */
 
//#if __cplusplus
//# define EXTERN extern "C" TCL_STORAGE_CLASS
//#else
//# define EXTERN extern TCL_STORAGE_CLASS
//#endif
 
 
/*
* The following code is copied from winnt.h.
* If we don't replicate it here, then <windows.h> can't be included
* after tcl.h, since tcl.h also defines VOID.
* This block is skipped under Cygwin and Mingw.
*
*
*/
//#if (__WIN32__) && !HAVE_WINNT_IGNORE_VOID)
//#if !VOID
////#define VOID void
////typedef char CHAR;
////typedef short SHORT;
////typedef long LONG;
//#endif
//#endif // * __WIN32__ && !HAVE_WINNT_IGNORE_VOID */
 
/*
* Macro to use instead of "void" for arguments that must have
* type "void *" in ANSI C; maps them to type "char *" in
* non-ANSI systems.
*/
 
//#if !NO_VOID
//# define VOID void
//#else
//# define VOID char
//#endif
 
///*
//* Miscellaneous declarations.
//*/
 
//#if !_CLIENTDATA
//# ifndef NO_VOID
//// typedef void *ClientData;
//# else
//// typedef int *ClientData;
//# endif
//# define _CLIENTDATA
//#endif
 
/*
* Darwin specifc configure overrides (to support fat compiles, where
* configure runs only once for multiple architectures):
*/
 
//#if __APPLE__
//# ifdef __LP64__
//# undef TCL_WIDE_INT_TYPE
//# define TCL_WIDE_INT_IS_LONG 1
//# else /* !__LP64__ */
//# define TCL_WIDE_INT_TYPE long long
//# undef TCL_WIDE_INT_IS_LONG
//# endif /* __LP64__ */
//# undef HAVE_STRUCT_STAT64
//#endif // * __APPLE__ */
 
/*
* Define Tcl_WideInt to be a type that is (at least) 64-bits wide,
* and define Tcl_Wideu32 to be the unsigned variant of that type
* (assuming that where we have one, we can have the other.)
*
* Also defines the following macros:
* TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on
* a real 64-bit system.)
* Tcl_WideAsLong - forgetful converter from wideInt to long.
* Tcl_LongAsWide - sign-extending converter from long to wideInt.
* Tcl_WideAsDouble - converter from wideInt to double.
* Tcl_DoubleAsWide - converter from double to wideInt.
*
* The following invariant should hold for any long value 'longVal':
* longVal == TCL.Tcl_WideAsLong(Tcl_LongAsWide(longVal))
*
* Note on converting between Tcl_WideInt and strings. This
* implementation (in tclObj.c) depends on the functions strtoull()
* and sprintf(...,"%" TCL_LL_MODIFIER "d",...). TCL_LL_MODIFIER_SIZE
* is the length of the modifier string, which is "ll" on most 32-bit
* Unix systems. It has to be split up like this to allow for the more
* complex formats sometimes needed (e.g. in the format(n) command.)
*/
 
//#if !(TCL_WIDE_INT_TYPE)&&!TCL_WIDE_INT_IS_LONG)
//# if defined(__GNUC__)
//# define TCL_WIDE_INT_TYPE long long
//# if defined(__WIN32__) && !__CYGWIN__)
//# define TCL_LL_MODIFIER "I64"
//# define TCL_LL_MODIFIER_SIZE 3
//# else
//# define TCL_LL_MODIFIER "L"
//# define TCL_LL_MODIFIER_SIZE 1
//# endif
////typedef struct stat Tcl_StatBuf;
//# elif defined(__WIN32__)
//# define TCL_WIDE_INT_TYPE __int64
//# ifdef __BORLANDC__
////typedef struct stati64 Tcl_StatBuf;
//# define TCL_LL_MODIFIER "L"
//# define TCL_LL_MODIFIER_SIZE 1
//# else /* __BORLANDC__ */
//# if _MSC_VER < 1400 || !_M_IX86)
////typedef struct _stati64 Tcl_StatBuf;
//# else
////typedef struct _stat64 Tcl_StatBuf;
//# endif /* _MSC_VER < 1400 */
//# define TCL_LL_MODIFIER "I64"
//# define TCL_LL_MODIFIER_SIZE 3
//# endif /* __BORLANDC__ */
//# else /* __WIN32__ */
///*
//* Don't know what platform it is and configure hasn't discovered what
//* is going on for us. Try to guess...
//*/
//# ifdef NO_LIMITS_H
//# error please define either TCL_WIDE_INT_TYPE or TCL_WIDE_INT_IS_LONG
//# else /* !NO_LIMITS_H */
//# include <limits.h>
//# if (INT_MAX < LONG_MAX)
//# define TCL_WIDE_INT_IS_LONG 1
//# else
//# define TCL_WIDE_INT_TYPE long long
//# endif
//# endif /* NO_LIMITS_H */
//# endif /* __WIN32__ */
//#endif // * !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
//#if TCL_WIDE_INT_IS_LONG
//# undef TCL_WIDE_INT_TYPE
//# define TCL_WIDE_INT_TYPE long
//#endif // * TCL_WIDE_INT_IS_LONG */
 
////typedef TCL_WIDE_INT_TYPE Tcl_WideInt;
////typedef unsigned TCL_WIDE_INT_TYPE Tcl_Wideu32;
 
//#if TCL_WIDE_INT_IS_LONG
////typedef struct stat Tcl_StatBuf;
//# define Tcl_WideAsLong(val) ((long)(val))
//# define Tcl_LongAsWide(val) ((long)(val))
//# define Tcl_WideAsDouble(val) ((double)((long)(val)))
//# define Tcl_DoubleAsWide(val) ((long)((double)(val)))
//# ifndef TCL_LL_MODIFIER
//# define TCL_LL_MODIFIER "l"
//# define TCL_LL_MODIFIER_SIZE 1
//# endif /* !TCL_LL_MODIFIER */
//#else /* TCL_WIDE_INT_IS_LONG */
///*
//* The next short section of defines are only done when not running on
//* Windows or some other strange platform.
//*/
//# ifndef TCL_LL_MODIFIER
//# ifdef HAVE_STRUCT_STAT64
////typedef struct stat64 Tcl_StatBuf;
//# else
////typedef struct stat Tcl_StatBuf;
//# endif /* HAVE_STRUCT_STAT64 */
//# define TCL_LL_MODIFIER "ll"
//# define TCL_LL_MODIFIER_SIZE 2
//# endif /* !TCL_LL_MODIFIER */
//# define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val)))
//# define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val)))
//# define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val)))
//# define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
//#endif // * TCL_WIDE_INT_IS_LONG */
 
 
/*
* This flag controls whether binary compatability is maintained with
* extensions built against a previous version of Tcl. This is true
* by default.
*/
//#if !TCL_PRESERVE_BINARY_COMPATABILITY
//# define TCL_PRESERVE_BINARY_COMPATABILITY 1
//#endif
 
 
/*
* Data structures defined opaquely in this module. The definitions below
* just provide dummy types. A few fields are made visible in Tcl_Interp
* structures, namely those used for returning a string result from
* commands. Direct access to the result field is discouraged in Tcl 8.0.
* The interpreter result is either an object or a string, and the two
* values are kept consistent unless some C code sets interp.result
* directly. Programmers should use either the procedure Tcl_GetObjResult()
* or Tcl_GetStringResult() to read the interpreter's result. See the
* SetResult man page for details.
*
* Note: any change to the Tcl_Interp definition below must be mirrored
* in the "real" definition in tclInt.h.
*
* Note: Tcl_ObjCmdProc procedures do not directly set result and freeProc.
* Instead, they set a Tcl_Obj member in the "real" structure that can be
* accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
*/
 
//typedef struct Tcl_Interp {
// char *result; /* If the last command returned a string
// * result, this points to it. */
// void (*freeProc) _ANSI_ARGS_((char *blockPtr));
// /* Zero means the string result is
// * statically allocated. TCL_DYNAMIC means
// * it was allocated with ckalloc and should
// * be freed with ckfree. Other values give
// * the address of procedure to invoke to
// * free the result. Tcl_Eval must free it
// * before executing next command. */
// int errorLine; /* When TCL_ERROR is returned, this gives
// * the line number within the command where
// * the error occurred (1 if first line). */
//} Tcl_Interp;
 
//typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
//typedef struct Tcl_Channel_ *Tcl_Channel;
//typedef struct Tcl_Command_ *Tcl_Command;
//typedef struct Tcl_Condition_ *Tcl_Condition;
//typedef struct Tcl_EncodingState_ *Tcl_EncodingState;
//typedef struct Tcl_Encoding_ *Tcl_Encoding;
//typedef struct Tcl_Event Tcl_Event;
//typedef struct Tcl_Mutex_ *Tcl_Mutex;
//typedef struct Tcl_Pid_ *Tcl_Pid;
//typedef struct Tcl_RegExp_ *Tcl_RegExp;
//typedef struct Tcl_ThreadDataKey_ *Tcl_ThreadDataKey;
//typedef struct Tcl_ThreadId_ *Tcl_ThreadId;
//typedef struct Tcl_TimerToken_ *Tcl_TimerToken;
//typedef struct Tcl_Trace_ *Tcl_Trace;
//typedef struct Tcl_Var_ *Tcl_Var;
//typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
//typedef struct Tcl_LoadHandle_ *Tcl_LoadHandle;
 
/*
* Definition of the interface to procedures implementing threads.
* A procedure following this definition is given to each call of
* 'Tcl_CreateThread' and will be called as the main fuction of
* the new thread created by that call.
*/
//#if MAC_TCL
////typedef pascal void *(Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
//#elif defined __WIN32__
////typedef unsigned (__stdcall Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
//#else
////typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
//#endif
 
 
/*
* Threading function return types used for abstracting away platform
* differences when writing a Tcl_ThreadCreateProc. See the NewThread
* function in generic/tclThreadTest.c for it's usage.
*/
//#if MAC_TCL
//# define Tcl_ThreadCreateType pascal void *
//# define TCL_THREAD_CREATE_RETURN return NULL
//#elif defined __WIN32__
//# define Tcl_ThreadCreateType unsigned __stdcall
//# define TCL_THREAD_CREATE_RETURN return 0
//#else
//# define Tcl_ThreadCreateType void
//# define TCL_THREAD_CREATE_RETURN
//#endif
 
 
/*
* Definition of values for default stacksize and the possible flags to be
* given to Tcl_CreateThread.
*/
//#define TCL_THREAD_STACK_DEFAULT (0) /* Use default size for stack */
//#define TCL_THREAD_NOFLAGS (0000) /* Standard flags, default behavior */
//#define TCL_THREAD_JOINABLE (0001) /* Mark the thread as joinable */
 
/*
* Flag values passed to Tcl_GetRegExpFromObj.
*/
//#define TCL_REG_BASIC 000000 /* BREs (convenience) */
//#define TCL_REG_EXTENDED 000001 /* EREs */
//#define TCL_REG_ADVF 000002 /* advanced features in EREs */
//#define TCL_REG_ADVANCED 000003 /* AREs (which are also EREs) */
//#define TCL_REG_QUOTE 000004 /* no special characters, none */
//#define TCL_REG_NOCASE 000010 /* ignore case */
//#define TCL_REG_NOSUB 000020 /* don't care about subexpressions */
//#define TCL_REG_EXPANDED 000040 /* expanded format, white space &
// * comments */
//#define TCL_REG_NLSTOP 000100 /* \n doesn't match . or [^ ] */
//#define TCL_REG_NLANCH 000200 /* ^ matches after \n, $ before */
//#define TCL_REG_NEWLINE 000300 /* newlines are line terminators */
//#define TCL_REG_CANMATCH 001000 /* report details on partial/limited
// * matches */
 
/*
* The following flag is experimental and only intended for use by Expect. It
* will probably go away in a later release.
*/
//#define TCL_REG_BOSONLY 002000 /* prepend \A to pattern so it only
// * matches at the beginning of the
// * string. */
 
/*
* Flags values passed to Tcl_RegExpExecObj.
*/
//#define TCL_REG_NOTBOL 0001 /* Beginning of string does not match ^. */
//#define TCL_REG_NOTEOL 0002 /* End of string does not match $. */
 
/*
* Structures filled in by Tcl_RegExpInfo. Note that all offset values are
* relative to the start of the match string, not the beginning of the
* entire string.
*/
//typedef struct Tcl_RegExpIndices {
// long start; /* character offset of first character in match */
// long end; /* character offset of first character after the
// * match. */
//} Tcl_RegExpIndices;
 
//typedef struct Tcl_RegExpInfo {
// int nsubs; /* number of subexpressions in the
// * compiled expression */
// Tcl_RegExpIndices *matches; /* array of nsubs match offset
// * pairs */
// long extendStart; /* The offset at which a subsequent
// * match might begin. */
// long reserved; /* Reserved for later use. */
//} Tcl_RegExpInfo;
 
/*
* Picky compilers complain if this typdef doesn't appear before the
* struct's reference in tclDecls.h.
*/
//typedef Tcl_StatBuf *Tcl_Stat_;
//typedef struct stat *Tcl_OldStat_;
 
/*
* When a TCL command returns, the interpreter contains a result from the
* command. Programmers are strongly encouraged to use one of the
* procedures Tcl_GetObjResult() or Tcl_GetStringResult() to read the
* interpreter's result. See the SetResult man page for details. Besides
* this result, the command procedure returns an integer code, which is
* one of the following:
*
* TCL_OK Command completed normally; the interpreter's
* result contains the command's result.
* TCL_ERROR The command couldn't be completed successfully;
* the interpreter's result describes what went wrong.
* TCL_RETURN The command requests that the current procedure
* return; the interpreter's result contains the
* procedure's return value.
* TCL_BREAK The command requests that the innermost loop
* be exited; the interpreter's result is meaningless.
* TCL_CONTINUE Go on to the next iteration of the current loop;
* the interpreter's result is meaningless.
*/
public const int TCL_OK = 0;
public const int TCL_ERROR = 1;
public const int TCL_RETURN = 2;
public const int TCL_BREAK = 3;
public const int TCL_CONTINUE = 4;
 
//#define TCL_RESULT_SIZE 200
 
/*
* Flags to control what substitutions are performed by Tcl_SubstObj():
*/
//#define TCL_SUBST_COMMANDS 001
//#define TCL_SUBST_VARIABLES 002
//#define TCL_SUBST_BACKSLASHES 004
//#define TCL_SUBST_ALL 007
 
 
/*
* Argument descriptors for math function callbacks in expressions:
*/
//typedef enum {
// TCL_INT, TCL.TCL_DOUBLE, TCL.TCL_EITHER, TCL.TCL_WIDE_INT
//} Tcl_ValueType;
//typedef struct Tcl_Value {
// Tcl_ValueType type; /* Indicates intValue or doubleValue is
// * valid, or both. */
// long intValue; /* Integer value. */
// double doubleValue; /* Double-precision floating value. */
// Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */
//} Tcl_Value;
 
/*
* Forward declaration of Tcl_Obj to prevent an error when the forward
* reference to Tcl_Obj is encountered in the procedure types declared
* below.
*/
//struct Tcl_Obj;
 
 
/*
* Procedure types defined by Tcl:
*/
 
//typedef int (Tcl_AppInitProc) _ANSI_ARGS_((Tcl_Interp interp));
//typedef int (Tcl_AsyncProc) _ANSI_ARGS_((ClientData clientData,
// Tcl_Interp interp, int code));
//typedef void (Tcl_ChannelProc) _ANSI_ARGS_((ClientData clientData, int mask));
//typedef void (Tcl_CloseProc) _ANSI_ARGS_((ClientData data));
//typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData));
//typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData,
// Tcl_Interp interp, int argc, CONST84 char *argv[]));
//typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
// Tcl_Interp interp, int level, char *command, TCL.TCL_CmdProc proc,
// ClientData cmdClientData, int argc, CONST84 char *argv[]));
//typedef int (Tcl_CmdObjTraceProc) _ANSI_ARGS_((ClientData clientData,
// Tcl_Interp interp, int level, string command,
// Tcl_Command commandInfo, int objc, struct Tcl_Obj * CONST * objv));
//typedef void (Tcl_CmdObjTraceDeleteProc) _ANSI_ARGS_((ClientData clientData));
//typedef void (Tcl_DupInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *srcPtr,
// struct Tcl_Obj *dupPtr));
//typedef int (Tcl_EncodingConvertProc)_ANSI_ARGS_((ClientData clientData,
// string src, int srcLen, int flags, TCL.TCL_EncodingState *statePtr,
// char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr,
// int *dstCharsPtr));
//typedef void (Tcl_EncodingFreeProc)_ANSI_ARGS_((ClientData clientData));
//typedef int (Tcl_EventProc) _ANSI_ARGS_((Tcl_Event *evPtr, int flags));
//typedef void (Tcl_EventCheckProc) _ANSI_ARGS_((ClientData clientData,
// int flags));
//typedef int (Tcl_EventDeleteProc) _ANSI_ARGS_((Tcl_Event *evPtr,
// ClientData clientData));
//typedef void (Tcl_EventSetupProc) _ANSI_ARGS_((ClientData clientData,
// int flags));
//typedef void (Tcl_ExitProc) _ANSI_ARGS_((ClientData clientData));
//typedef void (Tcl_FileProc) _ANSI_ARGS_((ClientData clientData, int mask));
//typedef void (Tcl_FileFreeProc) _ANSI_ARGS_((ClientData clientData));
//typedef void (Tcl_FreeInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
//typedef void (Tcl_FreeProc) _ANSI_ARGS_((char *blockPtr));
//typedef void (Tcl_IdleProc) _ANSI_ARGS_((ClientData clientData));
//typedef void (Tcl_InterpDeleteProc) _ANSI_ARGS_((ClientData clientData,
// Tcl_Interp interp));
//typedef int (Tcl_MathProc) _ANSI_ARGS_((ClientData clientData,
// Tcl_Interp interp, TCL.TCL_Value *args, TCL.TCL_Value *resultPtr));
//typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData));
//typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData,
// Tcl_Interp interp, int objc, struct Tcl_Obj * CONST * objv));
//typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp interp));
//typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(string , format));
//typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
// Tcl_Channel chan, char *address, int port));
//typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData));
//typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp interp,
// struct Tcl_Obj *objPtr));
//typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
//typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
// Tcl_Interp interp, CONST84 char part1, CONST84 char part2, int flags));
//typedef void (Tcl_CommandTraceProc) _ANSI_ARGS_((ClientData clientData,
// Tcl_Interp interp, string oldName, string newName,
// int flags));
//typedef void (Tcl_CreateFileHandlerProc) _ANSI_ARGS_((int fd, int mask,
// Tcl_FileProc proc, ClientData clientData));
//typedef void (Tcl_DeleteFileHandlerProc) _ANSI_ARGS_((int fd));
//typedef void (Tcl_AlertNotifierProc) _ANSI_ARGS_((ClientData clientData));
//typedef void (Tcl_ServiceModeHookProc) _ANSI_ARGS_((int mode));
//typedef ClientData (Tcl_InitNotifierProc) _ANSI_ARGS_((VOID));
//typedef void (Tcl_FinalizeNotifierProc) _ANSI_ARGS_((ClientData clientData));
//typedef void (Tcl_MainLoopProc) _ANSI_ARGS_((void));
 
 
/*
* The following structure represents a type of object, which is a
* particular internal representation for an object plus a set of
* procedures that provide standard operations on objects of that type.
*/
 
//typedef struct Tcl_ObjType {
// char *name; /* Name of the type, e.g. "int". */
// Tcl_FreeInternalRepProc *freeIntRepProc;
// /* Called to free any storage for the type's
// * internal rep. NULL if the internal rep
// * does not need freeing. */
// Tcl_DupInternalRepProc *dupIntRepProc;
// /* Called to create a new object as a copy
// * of an existing object. */
// Tcl_UpdateStringProc *updateStringProc;
// /* Called to update the string rep from the
// * type's internal representation. */
// Tcl_SetFromAnyProc *setFromAnyProc;
// /* Called to convert the object's internal
// * rep to this type. Frees the internal rep
// * of the old type. Returns TCL_ERROR on
// * failure. */
//} Tcl_ObjType;
 
 
/*
* One of the following structures exists for each object in the Tcl
* system. An object stores a value as either a string, some internal
* representation, or both.
*/
 
//typedef struct Tcl_Obj {
// int refCount; /* When 0 the object will be freed. */
// char *bytes; /* This points to the first byte of the
// * object's string representation. The array
// * must be followed by a null byte (i.e., at
// * offset length) but may also contain
// * embedded null characters. The array's
// * storage is allocated by ckalloc. NULL
// * means the string rep is invalid and must
// * be regenerated from the internal rep.
// * Clients should use Tcl_GetStringFromObj
// * or Tcl_GetString to get a pointer to the
// * byte array as a readonly value. */
// int length; /* The number of bytes at *bytes, not
// * including the terminating null. */
// Tcl_ObjType *typePtr; /* Denotes the object's type. Always
// * corresponds to the type of the object's
// * internal rep. NULL indicates the object
// * has no internal rep (has no type). */
// union { /* The internal representation: */
// long longValue; /* - an long integer value */
// double doubleValue; /* - a double-precision floating value */
// VOID *otherValuePtr; /* - another, type-specific value */
// Tcl_WideInt wideValue; /* - a long long value */
// struct { /* - internal rep as two pointers */
// VOID ptr1;
// VOID ptr2;
// } twoPtrValue;
// } internalRep;
//} Tcl_Obj;
 
 
/*
* Macros to increment and decrement a Tcl_Obj's reference count, and to
* test whether an object is shared (i.e. has reference count > 1).
* Note: clients should use Tcl_DecrRefCount() when they are finished using
* an object, and should never call TclFreeObj() directly. TclFreeObj() is
* only defined and made public in tcl.h to support Tcl_DecrRefCount's macro
* definition. Note also that Tcl_DecrRefCount() refers to the parameter
* "obj" twice. This means that you should avoid calling it with an
* expression that is expensive to compute or has side effects.
*/
//void Tcl_IncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
//void Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
//int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
 
//#if TCL_MEM_DEBUG
//# define Tcl_IncrRefCount(objPtr) \
//// Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
//# define Tcl_DecrRefCount(objPtr) \
//// Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
//# define Tcl_IsShared(objPtr) \
//// Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
//#else
//# define Tcl_IncrRefCount(objPtr) \
//// ++(objPtr)->refCount
//// /*
//// * Use do/while0 idiom for optimum correctness without compiler warnings
//// * http://c2.com/cgi/wiki?TrivialDoWhileLoop
//// */
//# define Tcl_DecrRefCount(objPtr) \
//// do { if (--(objPtr)->refCount <= 0) TclFreeObj(objPtr); } while(0)
//# define Tcl_IsShared(objPtr) \
//// ((objPtr)->refCount > 1)
//#endif
 
/*
* Macros and definitions that help to debug the use of Tcl objects.
* When TCL_MEM_DEBUG is defined, the Tcl_New declarations are
* overridden to call debugging versions of the object creation procedures.
*/
 
//#if TCL_MEM_DEBUG
//# define Tcl_NewBooleanObj(val) \
//// Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
//# define Tcl_NewByteArrayObj(bytes, len) \
//// Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
//# define Tcl_NewDoubleObj(val) \
//// Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
//# define Tcl_NewIntObj(val) \
//// Tcl_DbNewLongObj(val, __FILE__, __LINE__)
//# define Tcl_NewListObj(objc, objv) \
//// Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
//# define Tcl_NewLongObj(val) \
//// Tcl_DbNewLongObj(val, __FILE__, __LINE__)
//# define Tcl_NewObj() \
//// Tcl_DbNewObj(__FILE__, __LINE__)
//# define Tcl_NewStringObj(bytes, len) \
//// Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__)
//# define Tcl_NewWideIntObj(val) \
//// Tcl_DbNewWideIntObj(val, __FILE__, __LINE__)
//#endif // * TCL_MEM_DEBUG */
 
 
/*
* The following structure contains the state needed by
* Tcl_SaveResult. No-one outside of Tcl should access any of these
* fields. This structure is typically allocated on the stack.
*/
//typedef struct Tcl_SavedResult {
// char *result;
// Tcl_FreeProc *freeProc;
// Tcl_Obj *objResultPtr;
// char *appendResult;
// int appendAvl;
// int appendUsed;
// char resultSpace[TCL_RESULT_SIZE+1];
//} Tcl_SavedResult;
 
 
/*
* The following definitions support Tcl's namespace facility.
* Note: the first five fields must match exactly the fields in a
* Namespace structure (see tclInt.h).
*/
 
//typedef struct Tcl_Namespace {
// char *name; /* The namespace's name within its parent
// * namespace. This contains no ::'s. The
// * name of the global namespace is ""
// * although "::" is an synonym. */
// char *fullName; /* The namespace's fully qualified name.
// * This starts with ::. */
// ClientData clientData; /* Arbitrary value associated with this
// * namespace. */
// Tcl_NamespaceDeleteProc* deleteProc;
// /* Procedure invoked when deleting the
// * namespace to, e.g., free clientData. */
// struct Tcl_Namespace* parentPtr;
// /* Points to the namespace that contains
// * this one. NULL if this is the global
// * namespace. */
//} Tcl_Namespace;
 
 
/*
* The following structure represents a call frame, or activation record.
* A call frame defines a naming context for a procedure call: its local
* scope (for local variables) and its namespace scope (used for non-local
* variables; often the global :: namespace). A call frame can also define
* the naming context for a namespace eval or namespace inscope command:
* the namespace in which the command's code should execute. The
* Tcl_CallFrame structures exist only while procedures or namespace
* eval/inscope's are being executed, and provide a Tcl call stack.
*
* A call frame is initialized and pushed using Tcl_PushCallFrame and
* popped using Tcl_PopCallFrame. Storage for a Tcl_CallFrame must be
* provided by the Tcl_PushCallFrame caller, and callers typically allocate
* them on the C call stack for efficiency. For this reason, TCL.TCL_CallFrame
* is defined as a structure and not as an opaque token. However, most
* Tcl_CallFrame fields are hidden since applications should not access
* them directly; others are declared as "dummyX".
*
* WARNING!! The structure definition must be kept consistent with the
* CallFrame structure in tclInt.h. If you change one, change the other.
*/
 
//typedef struct Tcl_CallFrame {
// Tcl_Namespace *nsPtr;
// int dummy1;
// int dummy2;
// char *dummy3;
// char *dummy4;
// char *dummy5;
// int dummy6;
// char *dummy7;
// char *dummy8;
// int dummy9;
// char* dummy10;
//} Tcl_CallFrame;
 
 
/*
* Information about commands that is returned by Tcl_GetCommandInfo and
* passed to Tcl_SetCommandInfo. objProc is an objc/objv object-based
* command procedure while proc is a traditional Tcl argc/argv
* string-based procedure. Tcl_CreateObjCommand and Tcl_CreateCommand
* ensure that both objProc and proc are non-NULL and can be called to
* execute the command. However, it may be faster to call one instead of
* the other. The member isNativeObjectProc is set to 1 if an
* object-based procedure was registered by Tcl_CreateObjCommand, and to
* 0 if a string-based procedure was registered by Tcl_CreateCommand.
* The other procedure is typically set to a compatibility wrapper that
* does string-to-object or object-to-string argument conversions then
* calls the other procedure.
*/
 
//typedef struct Tcl_CmdInfo {
// int isNativeObjectProc; /* 1 if objProc was registered by a call to
// * Tcl_CreateObjCommand; 0 otherwise.
// * Tcl_SetCmdInfo does not modify this
// * field. */
// Tcl_ObjCmdProc *objProc; /* Command's object-based procedure. */
// ClientData objClientData; /* ClientData for object proc. */
// Tcl_CmdProc proc; /* Command's string-based procedure. */
// ClientData clientData; /* ClientData for string proc. */
// Tcl_CmdDeleteProc *deleteProc;
// /* Procedure to call when command is
// * deleted. */
// ClientData deleteData; /* Value to pass to deleteProc (usually
// * the same as clientData). */
// Tcl_Namespace *namespacePtr; /* Points to the namespace that contains
// * this command. Note that Tcl_SetCmdInfo
// * will not change a command's namespace;
// * use Tcl_RenameCommand to do that. */
 
//} Tcl_CmdInfo;
 
/*
* The structure defined below is used to hold dynamic strings. The only
* field that clients should use is the string field, accessible via the
* macro Tcl_DStringValue.
*/
//#define TCL_DSTRING_STATIC_SIZE 200
//typedef struct Tcl_DString {
// char *string; /* Points to beginning of string: either
// * staticSpace below or a malloced array. */
// int length; /* Number of non-NULL characters in the
// * string. */
// int spaceAvl; /* Total number of bytes available for the
// * string and its terminating NULL char. */
// char staticSpace[TCL_DSTRING_STATIC_SIZE];
// /* Space to use in common case where string
// * is small. */
//} Tcl_DString;
 
//#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
//#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
//#define Tcl_DStringTrunc Tcl_DStringSetLength
 
/*
* Definitions for the maximum number of digits of precision that may
* be specified in the "tcl_precision" variable, and the number of
* bytes of buffer space required by Tcl_PrintDouble.
*/
//#define TCL_MAX_PREC 17
//#define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10)
 
/*
* Definition for a number of bytes of buffer space sufficient to hold the
* string representation of an integer in base 10 (assuming the existence
* of 64-bit integers).
*/
//#define TCL_INTEGER_SPACE 24
 
/*
* Flag that may be passed to Tcl_ConvertElement to force it not to
* output braces (careful! if you change this flag be sure to change
* the definitions at the front of tclUtil.c).
*/
//#define TCL_DONT_USE_BRACES 1
 
/*
* Flag that may be passed to Tcl_GetIndexFromObj to force it to disallow
* abbreviated strings.
*/
//#define TCL_EXACT 1
 
/*
* Flag values passed to Tcl_RecordAndEval and/or Tcl_EvalObj.
* WARNING: these bit choices must not conflict with the bit choices
* for evalFlag bits in tclInt.h!!
*/
public const int TCL_NO_EVAL = 0x10000;
public const int TCL_EVAL_GLOBAL = 0x20000;
public const int TCL_EVAL_DIRECT = 0x40000;
public const int TCL_EVAL_INVOKE = 0x80000;
 
/*
* Special freeProc values that may be passed to Tcl_SetResult (see
* the man page for details):
*/
public const int TCL_VOLATILE = 1;//((Tcl_FreeProc ) 1)
public const int TCL_STATIC = 2;//((Tcl_FreeProc ) 0)
public const int TCL_DYNAMIC = 3;//((Tcl_FreeProc ) 3)
 
/*
* Flag values passed to variable-related procedures.
*/
public const int TCL_GLOBAL_ONLY = 1;
public const int TCL_NAMESPACE_ONLY = 2;
public const int TCL_APPEND_VALUE = 4;
public const int TCL_LIST_ELEMENT = 8;
public const int TCL_TRACE_READS = 0x10;
public const int TCL_TRACE_WRITES = 0x20;
public const int TCL_TRACE_UNSETS = 0x40;
public const int TCL_TRACE_DESTROYED = 0x80;
public const int Tcl_Interp_DESTROYED = 0x100;
public const int TCL_LEAVE_ERR_MSG = 0x200;
public const int TCL_TRACE_ARRAY = 0x800;
#if !TCL_REMOVE_OBSOLETE_TRACES
/* Required to support old variable/vdelete/vinfo traces */
public const int TCL_TRACE_OLD_STYLE = 0x1000;
#endif
/* Indicate the semantics of the result of a trace */
public const int TCL_TRACE_RESULT_DYNAMIC = 0x8000;
public const int TCL_TRACE_RESULT_OBJECT = 0x10000;
 
/*
* Flag values passed to command-related procedures.
*/
 
//#define TCL_TRACE_RENAME 0x2000
//#define TCL_TRACE_DELETE 0x4000
 
//#define TCL_ALLOW_INLINE_COMPILATION 0x20000
 
/*
* Flag values passed to Tcl_CreateObjTrace, and used internally
* by command execution traces. Slots 4,8,16 and 32 are
* used internally by execution traces (see tclCmdMZ.c)
*/
//#define TCL_TRACE_ENTER_EXEC 1
//#define TCL_TRACE_LEAVE_EXEC 2
 
/*
* The TCL_PARSE_PART1 flag is deprecated and has no effect.
* The part1 is now always parsed whenever the part2 is NULL.
* (This is to avoid a common error when converting code to
* use the new object based APIs and forgetting to give the
* flag)
*/
#if !TCL_NO_DEPRECATED
//# define TCL_PARSE_PART1 0x400
#endif
 
 
/*
* Types for linked variables:
*/
//const int TCL_LINK_INT = 1;
//const int TCL_LINK_DOUBLE = 2;
//const int TCL_LINK_BOOLEAN =3;
//const int TCL_LINK_STRING = 4;
//const int TCL_LINK_WIDE_INT= 5;
//const int TCL_LINK_READ_ONLY= 0x80;
 
 
/*
* Forward declarations of Tcl_HashTable and related types.
*/
//typedef struct Tcl_HashKeyType Tcl_HashKeyType;
//typedef struct Tcl_HashTable Tcl_HashTable;
//typedef struct Tcl_HashEntry Tcl_HashEntry;
 
//typedef unsigned int (Tcl_HashKeyProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
// VOID *keyPtr));
//typedef int (Tcl_CompareHashKeysProc) _ANSI_ARGS_((VOID *keyPtr,
// Tcl_HashEntry *hPtr));
//typedef Tcl_HashEntry *(Tcl_AllocHashEntryProc) _ANSI_ARGS_((
// Tcl_HashTable *tablePtr, object *keyPtr));
//typedef void (Tcl_FreeHashEntryProc) _ANSI_ARGS_((Tcl_HashEntry *hPtr));
 
/*
* This flag controls whether the hash table stores the hash of a key, or
* recalculates it. There should be no reason for turning this flag off
* as it is completely binary and source compatible unless you directly
* access the bucketPtr member of the Tcl_HashTableEntry structure. This
* member has been removed and the space used to store the hash value.
*/
//#if !TCL_HASH_KEY_STORE_HASH
//# define TCL_HASH_KEY_STORE_HASH 1
//#endif
 
/*
* Structure definition for an entry in a hash table. No-one outside
* Tcl should access any of these fields directly; use the macros
* defined below.
*/
 
//struct Tcl_HashEntry {
// Tcl_HashEntry *nextPtr; /* Pointer to next entry in this
// * hash bucket, or NULL for end of
// * chain. */
// Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */
#if TCL_HASH_KEY_STORE_HASH
# if TCL_PRESERVE_BINARY_COMPATABILITY
// VOID *hash; /* Hash value, stored as pointer to
// * ensure that the offsets of the
// * fields in this structure are not
// * changed. */
# else
// unsigned int hash; /* Hash value. */
# endif
#else
// Tcl_HashEntry **bucketPtr; /* Pointer to bucket that points to
// * first entry in this entry's chain:
// * used for deleting the entry. */
#endif
// ClientData clientData; /* Application stores something here
// * with Tcl_SetHashValue. */
// union { /* Key has one of these forms: */
// char *oneWordValue; /* One-word value for key. */
// Tcl_Obj *objPtr; /* Tcl_Obj * key value. */
// int words[1]; /* Multiple integer words for key.
// * The actual size will be as large
// * as necessary for this table's
// * keys. */
// char string[4]; /* String for key. The actual size
// * will be as large as needed to hold
// * the key. */
// } key; /* MUST BE LAST FIELD IN RECORD!! */
//};
 
/*
* Flags used in Tcl_HashKeyType.
*
* TCL_HASH_KEY_RANDOMIZE_HASH:
* There are some things, pointers for example
* which don't hash well because they do not use
* the lower bits. If this flag is set then the
* hash table will attempt to rectify this by
* randomising the bits and then using the upper
* N bits as the index into the table.
*/
//#define TCL_HASH_KEY_RANDOMIZE_HASH 0x1
 
/*
* Structure definition for the methods associated with a hash table
* key type.
*/
//#define TCL_HASH_KEY_TYPE_VERSION 1
//struct Tcl_HashKeyType {
// int version; /* Version of the table. If this structure is
// * extended in future then the version can be
// * used to distinguish between different
// * structures.
// */
 
// int flags; /* Flags, see above for details. */
 
// /* Calculates a hash value for the key. If this is NULL then the pointer
// * itself is used as a hash value.
// */
// Tcl_HashKeyProc *hashKeyProc;
 
// /* Compares two keys and returns zero if they do not match, and non-zero
// * if they do. If this is NULL then the pointers are compared.
// */
// Tcl_CompareHashKeysProc *compareKeysProc;
 
// /* Called to allocate memory for a new entry, i.e. if the key is a
// * string then this could allocate a single block which contains enough
// * space for both the entry and the string. Only the key field of the
// * allocated Tcl_HashEntry structure needs to be filled in. If something
// * else needs to be done to the key, i.e. incrementing a reference count
// * then that should be done by this function. If this is NULL then Tcl_Alloc
// * is used to allocate enough space for a Tcl_HashEntry and the key pointer
// * is assigned to key.oneWordValue.
// */
// Tcl_AllocHashEntryProc *allocEntryProc;
 
// /* Called to free memory associated with an entry. If something else needs
// * to be done to the key, i.e. decrementing a reference count then that
// * should be done by this function. If this is NULL then Tcl_Free is used
// * to free the Tcl_HashEntry.
// */
// Tcl_FreeHashEntryProc *freeEntryProc;
//};
 
/*
* Structure definition for a hash table. Must be in tcl.h so clients
* can allocate space for these structures, but clients should never
* access any fields in this structure.
*/
 
//#define TCL_SMALL_HASH_TABLE 4
//struct Tcl_HashTable {
// Tcl_HashEntry **buckets; /* Pointer to bucket array. Each
// * element points to first entry in
// * bucket's hash chain, or NULL. */
// Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
// /* Bucket array used for small tables
// * (to avoid mallocs and frees). */
// int numBuckets; /* Total number of buckets allocated
// * at **bucketPtr. */
// int numEntries; /* Total number of entries present
// * in table. */
// int rebuildSize; /* Enlarge table when numEntries gets
// * to be this large. */
// int downShift; /* Shift count used in hashing
// * function. Designed to use high-
// * order bits of randomized keys. */
// int mask; /* Mask value used in hashing
// * function. */
// int keyType; /* Type of keys used in this table.
// * It's either TCL_CUSTOM_KEYS,
// * TCL_STRING_KEYS, TCL.TCL_ONE_WORD_KEYS,
// * or an integer giving the number of
// * ints that is the size of the key.
// */
#if TCL_PRESERVE_BINARY_COMPATABILITY
// Tcl_HashEntry *(*findProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
// string key));
// Tcl_HashEntry *(*createProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
// string key, int *newPtr));
#endif
// Tcl_HashKeyType *typePtr; /* Type of the keys used in the
// * Tcl_HashTable. */
//};
 
/*
* Structure definition for information used to keep track of searches
* through hash tables:
*/
 
//typedef struct Tcl_HashSearch {
// Tcl_HashTable *tablePtr; /* Table being searched. */
// int nextIndex; /* Index of next bucket to be
// * enumerated after present one. */
// Tcl_HashEntry *nextEntryPtr; /* Next entry to be enumerated in the
// * the current bucket. */
//} Tcl_HashSearch;
 
/*
* Acceptable key types for hash tables:
*
* TCL_STRING_KEYS: The keys are strings, they are copied into
* the entry.
* TCL_ONE_WORD_KEYS: The keys are pointers, the pointer is stored
* in the entry.
* TCL_CUSTOM_TYPE_KEYS: The keys are arbitrary types which are copied
* into the entry.
* TCL_CUSTOM_PTR_KEYS: The keys are pointers to arbitrary types, the
* pointer is stored in the entry.
*
* While maintaining binary compatability the above have to be distinct
* values as they are used to differentiate between old versions of the
* hash table which don't have a typePtr and new ones which do. Once binary
* compatability is discarded in favour of making more wide spread changes
* TCL_STRING_KEYS can be the same as TCL_CUSTOM_TYPE_KEYS, and
* TCL_ONE_WORD_KEYS can be the same as TCL_CUSTOM_PTR_KEYS because they
* simply determine how the key is accessed from the entry and not the
* behavior.
*/
 
//#define TCL_STRING_KEYS 0
//#define TCL_ONE_WORD_KEYS 1
 
//#if TCL_PRESERVE_BINARY_COMPATABILITY
//# define TCL_CUSTOM_TYPE_KEYS -2
//# define TCL_CUSTOM_PTR_KEYS -1
//#else
//# define TCL_CUSTOM_TYPE_KEYS TCL_STRING_KEYS
//# define TCL_CUSTOM_PTR_KEYS TCL_ONE_WORD_KEYS
//#endif
 
/*
* Macros for clients to use to access fields of hash entries:
*/
 
//#define Tcl_GetHashValue(h) ((h)->clientData)
//#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
#if TCL_PRESERVE_BINARY_COMPATABILITY
//# define Tcl_GetHashKey(vtablePtr, h) \
// ((char ) (((vtablePtr)->keyType == TCL.Tcl_ONE_WORD_KEYS || \
// (vtablePtr)->keyType == TCL.Tcl_CUSTOM_PTR_KEYS) \
// ? (h)->key.oneWordValue \
// : (h)->key.string))
#else
//# define Tcl_GetHashKey(vtablePtr, h) \
// ((char ) (((vtablePtr)->keyType == TCL.Tcl_ONE_WORD_KEYS) \
// ? (h)->key.oneWordValue \
// : (h)->key.string))
#endif
 
/*
* Macros to use for clients to use to invoke find and create procedures
* for hash tables:
*/
 
#if TCL_PRESERVE_BINARY_COMPATABILITY
//# define Tcl_FindHashEntry(vtablePtr, key) \
// (*((vtablePtr)->findProc))(vtablePtr, key)
//# define Tcl_CreateHashEntry(vtablePtr, key, newPtr) \
// (*((vtablePtr)->createProc))(vtablePtr, key, newPtr)
#else //* !TCL_PRESERVE_BINARY_COMPATABILITY */
/*
* Macro to use new extended version of Tcl_InitHashTable.
*/
//# define Tcl_InitHashTable(vtablePtr, keyType) \
// Tcl_InitHashTableEx(vtablePtr, keyType, NULL)
#endif // * TCL_PRESERVE_BINARY_COMPATABILITY */
 
 
/*
* Flag values to pass to Tcl_DoOneEvent to disable searches
* for some kinds of events:
*/
//#define TCL_DONT_WAIT (1<<1)
//#define TCL_WINDOW_EVENTS (1<<2)
//#define TCL_FILE_EVENTS (1<<3)
//#define TCL_TIMER_EVENTS (1<<4)
//#define TCL_IDLE_EVENTS (1<<5) /* WAS 0x10 ???? */
//#define TCL_ALL_EVENTS (~TCL_DONT_WAIT)
 
/*
* The following structure defines a generic event for the Tcl event
* system. These are the things that are queued in calls to Tcl_QueueEvent
* and serviced later by Tcl_DoOneEvent. There can be many different
* kinds of events with different fields, corresponding to window events,
* timer events, etc. The structure for a particular event consists of
* a Tcl_Event header followed by additional information specific to that
* event.
*/
//struct Tcl_Event {
// Tcl_EventProc proc; /* Procedure to call to service this event. */
// struct Tcl_Event *nextPtr; /* Next in list of pending events, or NULL. */
//};
 
/*
* Positions to pass to Tcl_QueueEvent:
*/
//typedef enum {
// TCL_QUEUE_TAIL, TCL.TCL_QUEUE_HEAD, TCL.TCL_QUEUE_MARK
//} Tcl_QueuePosition;
 
/*
* Values to pass to Tcl_SetServiceMode to specify the behavior of notifier
* event routines.
*/
//#define TCL_SERVICE_NONE 0
//#define TCL_SERVICE_ALL 1
 
 
/*
* The following structure keeps is used to hold a time value, either as
* an absolute time (the number of seconds from the epoch) or as an
* elapsed time. On Unix systems the epoch is Midnight Jan 1, 1970 GMT.
* On Macintosh systems the epoch is Midnight Jan 1, 1904 GMT.
*/
//typedef struct Tcl_Time {
// long sec; /* Seconds. */
// long usec; /* Microseconds. */
//} Tcl_Time;
 
//typedef void (Tcl_SetTimerProc) _ANSI_ARGS_((Tcl_Time *timePtr));
//typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
 
 
/*
* Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler
* to indicate what sorts of events are of interest:
*/
//#define TCL_READABLE (1<<1)
//#define TCL_WRITABLE (1<<2)
//#define TCL_EXCEPTION (1<<3)
 
/*
* Flag values to pass to Tcl_OpenCommandChannel to indicate the
* disposition of the stdio handles. TCL_STDIN, TCL.TCL_STDOUT, TCL.TCL_STDERR,
* are also used in Tcl_GetStdChannel.
*/
//#define TCL_STDIN (1<<1)
//#define TCL_STDOUT (1<<2)
//#define TCL_STDERR (1<<3)
//#define TCL_ENFORCE_MODE (1<<4)
 
/*
* Bits passed to Tcl_DriverClose2Proc to indicate which side of a channel
* should be closed.
*/
//#define TCL_CLOSE_READ (1<<1)
//#define TCL_CLOSE_WRITE (1<<2)
 
/*
* Value to use as the closeProc for a channel that supports the
* close2Proc interface.
*/
//#define TCL_CLOSE2PROC ((Tcl_DriverCloseProc )1)
 
/*
* Channel version tag. This was introduced in 8.3.2/8.4.
*/
//#define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelTypeVersion) 0x1)
//#define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2)
//#define TCL_CHANNEL_VERSION_3 ((Tcl_ChannelTypeVersion) 0x3)
//#define TCL_CHANNEL_VERSION_4 ((Tcl_ChannelTypeVersion) 0x4)
 
/*
* TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc
*/
 
//#define TCL_CHANNEL_THREAD_INSERT (0)
//#define TCL_CHANNEL_THREAD_REMOVE (1)
 
/*
* Typedefs for the various operations in a channel type:
*/
//typedef int (Tcl_DriverBlockModeProc) _ANSI_ARGS_((
// ClientData instanceData, int mode));
//typedef int (Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData,
// Tcl_Interp interp));
//typedef int (Tcl_DriverClose2Proc) _ANSI_ARGS_((ClientData instanceData,
// Tcl_Interp interp, int flags));
//typedef int (Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData,
// char *buf, int toRead, int *errorCodePtr));
//typedef int (Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData,
// CONST84 char *buf, int toWrite, int *errorCodePtr));
//typedef int (Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData,
// long offset, int mode, int *errorCodePtr));
//typedef int (Tcl_DriverSetOptionProc) _ANSI_ARGS_((
// ClientData instanceData, TCL.TCL_Interp interp,
// string optionName, string value));
//typedef int (Tcl_DriverGetOptionProc) _ANSI_ARGS_((
// ClientData instanceData, TCL.TCL_Interp interp,
// CONST84 char *optionName, TCL.TCL_DString *dsPtr));
//typedef void (Tcl_DriverWatchProc) _ANSI_ARGS_((
// ClientData instanceData, int mask));
//typedef int (Tcl_DriverGetHandleProc) _ANSI_ARGS_((
// ClientData instanceData, int direction,
// ClientData *handlePtr));
//typedef int (Tcl_DriverFlushProc) _ANSI_ARGS_((
// ClientData instanceData));
//typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_((
// ClientData instanceData, int interestMask));
//typedef Tcl_WideInt (Tcl_DriverWideSeekProc) _ANSI_ARGS_((
// ClientData instanceData, TCL.TCL_WideInt offset,
// int mode, int *errorCodePtr));
 
// /* TIP #218, Channel Thread Actions */
//typedef void (Tcl_DriverThreadActionProc) _ANSI_ARGS_ ((
// ClientData instanceData, int action));
 
/*
* The following declarations either map ckalloc and ckfree to
* malloc and free, or they map them to procedures with all sorts
* of debugging hooks defined in tclCkalloc.c.
*/
#if TCL_MEM_DEBUG
 
//# define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
//# define ckfree(x) Tcl_DbCkfree(x, __FILE__, __LINE__)
//# define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
//# define attemptckalloc(x) Tcl_AttemptDbCkalloc(x, __FILE__, __LINE__)
//# define attemptckrealloc(x,y) Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__)
#else // * !TCL_MEM_DEBUG */
 
/*
* If we are not using the debugging allocator, we should call the
* Tcl_Alloc, et al. routines in order to guarantee that every module
* is using the same memory allocator both inside and outside of the
* Tcl library.
*/
//# define ckalloc(x) Tcl_Alloc(x)
//# define ckfree(x) Tcl_Free(x)
//# define ckrealloc(x,y) Tcl_Realloc(x,y)
//# define attemptckalloc(x) Tcl_AttemptAlloc(x)
//# define attemptckrealloc(x,y) Tcl_AttemptRealloc(x,y)
//# define Tcl_InitMemory(x)
//# define Tcl_DumpActiveMemory(x)
//# define Tcl_ValidateAllMemory(x,y)
 
#endif // * !TCL_MEM_DEBUG */
 
/*
* struct Tcl_ChannelType:
*
* One such structure exists for each type (kind) of channel.
* It collects together in one place all the functions that are
* part of the specific channel type.
*
* It is recommend that the Tcl_Channel* functions are used to access
* elements of this structure, instead of direct accessing.
*/
//typedef struct Tcl_ChannelType {
// char *typeName; /* The name of the channel type in Tcl
// * commands. This storage is owned by
// * channel type. */
// Tcl_ChannelTypeVersion version; /* Version of the channel type. */
// Tcl_DriverCloseProc *closeProc; /* Procedure to call to close the
// * channel, or TCL_CLOSE2PROC if the
// * close2Proc should be used
// * instead. */
// Tcl_DriverInputProc *inputProc; /* Procedure to call for input
// * on channel. */
// Tcl_DriverOutputProc *outputProc; /* Procedure to call for output
// * on channel. */
// Tcl_DriverSeekProc *seekProc; /* Procedure to call to seek
// * on the channel. May be NULL. */
// Tcl_DriverSetOptionProc *setOptionProc;
// /* Set an option on a channel. */
// Tcl_DriverGetOptionProc *getOptionProc;
// /* Get an option from a channel. */
// Tcl_DriverWatchProc *watchProc; /* Set up the notifier to watch
// * for events on this channel. */
// Tcl_DriverGetHandleProc *getHandleProc;
// /* Get an OS handle from the channel
// * or NULL if not supported. */
// Tcl_DriverClose2Proc *close2Proc; /* Procedure to call to close the
// * channel if the device supports
// * closing the read & write sides
// * independently. */
// Tcl_DriverBlockModeProc *blockModeProc;
// /* Set blocking mode for the
// * raw channel. May be NULL. */
// /*
// * Only valid in TCL_CHANNEL_VERSION_2 channels or later
// */
// Tcl_DriverFlushProc *flushProc; /* Procedure to call to flush a
// * channel. May be NULL. */
// Tcl_DriverHandlerProc *handlerProc; /* Procedure to call to handle a
// * channel event. This will be passed
// * up the stacked channel chain. */
// /*
// * Only valid in TCL_CHANNEL_VERSION_3 channels or later
// */
// Tcl_DriverWideSeekProc *wideSeekProc;
// /* Procedure to call to seek
// * on the channel which can
// * handle 64-bit offsets. May be
// * NULL, and must be NULL if
// * seekProc is NULL. */
 
// /*
// * Only valid in TCL_CHANNEL_VERSION_4 channels or later
// * TIP #218, Channel Thread Actions
// */
// Tcl_DriverThreadActionProc *threadActionProc;
// /* Procedure to call to notify
// * the driver of thread specific
// * activity for a channel.
// * May be NULL. */
//} Tcl_ChannelType;
 
/*
* The following flags determine whether the blockModeProc above should
* set the channel into blocking or nonblocking mode. They are passed
* as arguments to the blockModeProc procedure in the above structure.
*/
//#define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */
//#define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking
// * mode. */
 
/*
* Enum for different types of file paths.
*/
//typedef enum Tcl_PathType {
// TCL_PATH_ABSOLUTE,
// TCL_PATH_RELATIVE,
// TCL_PATH_VOLUME_RELATIVE
//} Tcl_PathType;
 
 
/*
* The following structure is used to pass glob type data amongst
* the various glob routines and Tcl_FSMatchInDirectory.
*/
//typedef struct Tcl_GlobTypeData {
// /* Corresponds to bcdpfls as in 'find -t' */
// int type;
// /* Corresponds to file permissions */
// int perm;
// /* Acceptable mac type */
// Tcl_Obj* macType;
// /* Acceptable mac creator */
// Tcl_Obj* macCreator;
//} Tcl_GlobTypeData;
 
/*
* type and permission definitions for glob command
*/
//#define TCL_GLOB_TYPE_BLOCK (1<<0)
//#define TCL_GLOB_TYPE_CHAR (1<<1)
//#define TCL_GLOB_TYPE_DIR (1<<2)
//#define TCL_GLOB_TYPE_PIPE (1<<3)
//#define TCL_GLOB_TYPE_FILE (1<<4)
//#define TCL_GLOB_TYPE_LINK (1<<5)
//#define TCL_GLOB_TYPE_SOCK (1<<6)
//#define TCL_GLOB_TYPE_MOUNT (1<<7)
 
//#define TCL_GLOB_PERM_RONLY (1<<0)
//#define TCL_GLOB_PERM_HIDDEN (1<<1)
//#define TCL_GLOB_PERM_R (1<<2)
//#define TCL_GLOB_PERM_W (1<<3)
//#define TCL_GLOB_PERM_X (1<<4)
 
 
/*
* Typedefs for the various filesystem operations:
*/
//typedef int (Tcl_FSStatProc) _ANSI_ARGS_((Tcl_Obj pathPtr, TCL.TCL_StatBuf *buf));
//typedef int (Tcl_FSAccessProc) _ANSI_ARGS_((Tcl_Obj pathPtr, int mode));
//typedef Tcl_Channel (Tcl_FSOpenFileChannelProc)
// _ANSI_ARGS_((Tcl_Interp interp, TCL.TCL_Obj pathPtr,
// int mode, int permissions));
//typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp* interp,
// Tcl_Obj *result, TCL.TCL_Obj pathPtr, CONST char pattern,
// Tcl_GlobTypeData * types));
//typedef Tcl_Obj* (Tcl_FSGetCwdProc) _ANSI_ARGS_((Tcl_Interp interp));
//typedef int (Tcl_FSChdirProc) _ANSI_ARGS_((Tcl_Obj pathPtr));
//typedef int (Tcl_FSLstatProc) _ANSI_ARGS_((Tcl_Obj pathPtr,
// Tcl_StatBuf *buf));
//typedef int (Tcl_FSCreateDirectoryProc) _ANSI_ARGS_((Tcl_Obj pathPtr));
//typedef int (Tcl_FSDeleteFileProc) _ANSI_ARGS_((Tcl_Obj pathPtr));
//typedef int (Tcl_FSCopyDirectoryProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
// Tcl_Obj *destPathPtr, TCL.TCL_Obj **errorPtr));
//typedef int (Tcl_FSCopyFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
// Tcl_Obj *destPathPtr));
//typedef int (Tcl_FSRemoveDirectoryProc) _ANSI_ARGS_((Tcl_Obj pathPtr,
// int recursive, TCL.TCL_Obj **errorPtr));
//typedef int (Tcl_FSRenameFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
// Tcl_Obj *destPathPtr));
//typedef void (Tcl_FSUnloadFileProc) _ANSI_ARGS_((Tcl_LoadHandle loadHandle));
//typedef Tcl_Obj* (Tcl_FSListVolumesProc) _ANSI_ARGS_((void));
/* We have to declare the utime structure here. */
//struct utimbuf;
//typedef int (Tcl_FSUtimeProc) _ANSI_ARGS_((Tcl_Obj pathPtr,
// struct utimbuf *tval));
//typedef int (Tcl_FSNormalizePathProc) _ANSI_ARGS_((Tcl_Interp interp,
// Tcl_Obj pathPtr, int nextCheckpoint));
//typedef int (Tcl_FSFileAttrsGetProc) _ANSI_ARGS_((Tcl_Interp interp,
// int index, TCL.TCL_Obj pathPtr,
// Tcl_Obj **objPtrRef));
//typedef CONST char** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((Tcl_Obj pathPtr,
// Tcl_Obj** objPtrRef));
//typedef int (Tcl_FSFileAttrsSetProc) _ANSI_ARGS_((Tcl_Interp interp,
// int index, TCL.TCL_Obj pathPtr,
// Tcl_Obj *objPtr));
//typedef Tcl_Obj* (Tcl_FSLinkProc) _ANSI_ARGS_((Tcl_Obj pathPtr,
// Tcl_Obj *toPtr, int linkType));
//typedef int (Tcl_FSLoadFileProc) _ANSI_ARGS_((Tcl_Interp * interp,
// Tcl_Obj pathPtr,
// Tcl_LoadHandle *handlePtr,
// Tcl_FSUnloadFileProc **unloadProcPtr));
//typedef int (Tcl_FSPathInFilesystemProc) _ANSI_ARGS_((Tcl_Obj pathPtr,
// ClientData *clientDataPtr));
//typedef Tcl_Obj* (Tcl_FSFilesystemPathTypeProc)
// _ANSI_ARGS_((Tcl_Obj pathPtr));
//typedef Tcl_Obj* (Tcl_FSFilesystemSeparatorProc)
// _ANSI_ARGS_((Tcl_Obj pathPtr));
//typedef void (Tcl_FSFreeInternalRepProc) _ANSI_ARGS_((ClientData clientData));
//typedef ClientData (Tcl_FSDupInternalRepProc)
// _ANSI_ARGS_((ClientData clientData));
//typedef Tcl_Obj* (Tcl_FSInternalToNormalizedProc)
// _ANSI_ARGS_((ClientData clientData));
//typedef ClientData (Tcl_FSCreateInternalRepProc) _ANSI_ARGS_((Tcl_Obj pathPtr));
 
//typedef struct Tcl_FSVersion_ *Tcl_FSVersion;
 
/*
*----------------------------------------------------------------
* Data structures related to hooking into the filesystem
*----------------------------------------------------------------
*/
 
/*
* Filesystem version tag. This was introduced in 8.4.
*/
//#define TCL_FILESYSTEM_VERSION_1 ((Tcl_FSVersion) 0x1)
 
/*
* struct Tcl_Filesystem:
*
* One such structure exists for each type (kind) of filesystem.
* It collects together in one place all the functions that are
* part of the specific filesystem. Tcl always accesses the
* filesystem through one of these structures.
*
* Not all entries need be non-NULL; any which are NULL are simply
* ignored. However, a complete filesystem should provide all of
* these functions. The explanations in the structure show
* the importance of each function.
*/
 
//typedef struct Tcl_Filesystem {
// string typeName; /* The name of the filesystem. */
// int structureLength; /* Length of this structure, so future
// * binary compatibility can be assured. */
// Tcl_FSVersion version;
// /* Version of the filesystem type. */
// Tcl_FSPathInFilesystemProc pathInFilesystemProc;
// /* Function to check whether a path is in
// * this filesystem. This is the most
// * important filesystem procedure. */
// Tcl_FSDupInternalRepProc *dupInternalRepProc;
// /* Function to duplicate internal fs rep. May
// * be NULL (but then fs is less efficient). */
// Tcl_FSFreeInternalRepProc *freeInternalRepProc;
// /* Function to free internal fs rep. Must
// * be implemented, if internal representations
// * need freeing, otherwise it can be NULL. */
// Tcl_FSInternalToNormalizedProc *internalToNormalizedProc;
// /* Function to convert internal representation
// * to a normalized path. Only required if
// * the fs creates pure path objects with no
// * string/path representation. */
// Tcl_FSCreateInternalRepProc *createInternalRepProc;
// /* Function to create a filesystem-specific
// * internal representation. May be NULL
// * if paths have no internal representation,
// * or if the Tcl_FSPathInFilesystemProc
// * for this filesystem always immediately
// * creates an internal representation for
// * paths it accepts. */
// Tcl_FSNormalizePathProc *normalizePathProc;
// /* Function to normalize a path. Should
// * be implemented for all filesystems
// * which can have multiple string
// * representations for the same path
// * object. */
// Tcl_FSFilesystemPathTypeProc *filesystemPathTypeProc;
// /* Function to determine the type of a
// * path in this filesystem. May be NULL. */
// Tcl_FSFilesystemSeparatorProc *filesystemSeparatorProc;
// /* Function to return the separator
// * character(s) for this filesystem. Must
// * be implemented. */
// Tcl_FSStatProc *statProc;
// /*
// * Function to process a 'Tcl_FSStat()'
// * call. Must be implemented for any
// * reasonable filesystem.
// */
// Tcl_FSAccessProc *accessProc;
// /*
// * Function to process a 'Tcl_FSAccess()'
// * call. Must be implemented for any
// * reasonable filesystem.
// */
// Tcl_FSOpenFileChannelProc *openFileChannelProc;
// /*
// * Function to process a
// * 'Tcl_FSOpenFileChannel()' call. Must be
// * implemented for any reasonable
// * filesystem.
// */
// Tcl_FSMatchInDirectoryProc *matchInDirectoryProc;
// /* Function to process a
// * 'Tcl_FSMatchInDirectory()'. If not
// * implemented, then glob and recursive
// * copy functionality will be lacking in
// * the filesystem. */
// Tcl_FSUtimeProc *utimeProc;
// /* Function to process a
// * 'Tcl_FSUtime()' call. Required to
// * allow setting (not reading) of times
// * with 'file mtime', 'file atime' and
// * the open-r/open-w/fcopy implementation
// * of 'file copy'. */
// Tcl_FSLinkProc *linkProc;
// /* Function to process a
// * 'Tcl_FSLink()' call. Should be
// * implemented only if the filesystem supports
// * links (reading or creating). */
// Tcl_FSListVolumesProc *listVolumesProc;
// /* Function to list any filesystem volumes
// * added by this filesystem. Should be
// * implemented only if the filesystem adds
// * volumes at the head of the filesystem. */
// Tcl_FSFileAttrStringsProc *fileAttrStringsProc;
// /* Function to list all attributes strings
// * which are valid for this filesystem.
// * If not implemented the filesystem will
// * not support the 'file attributes' command.
// * This allows arbitrary additional information
// * to be attached to files in the filesystem. */
// Tcl_FSFileAttrsGetProc *fileAttrsGetProc;
// /* Function to process a
// * 'Tcl_FSFileAttrsGet()' call, used by
// * 'file attributes'. */
// Tcl_FSFileAttrsSetProc *fileAttrsSetProc;
// /* Function to process a
// * 'Tcl_FSFileAttrsSet()' call, used by
// * 'file attributes'. */
// Tcl_FSCreateDirectoryProc *createDirectoryProc;
// /* Function to process a
// * 'Tcl_FSCreateDirectory()' call. Should
// * be implemented unless the FS is
// * read-only. */
// Tcl_FSRemoveDirectoryProc *removeDirectoryProc;
// /* Function to process a
// * 'Tcl_FSRemoveDirectory()' call. Should
// * be implemented unless the FS is
// * read-only. */
// Tcl_FSDeleteFileProc *deleteFileProc;
// /* Function to process a
// * 'Tcl_FSDeleteFile()' call. Should
// * be implemented unless the FS is
// * read-only. */
// Tcl_FSCopyFileProc *copyFileProc;
// /* Function to process a
// * 'Tcl_FSCopyFile()' call. If not
// * implemented Tcl will fall back
// * on open-r, open-w and fcopy as
// * a copying mechanism, for copying
// * actions initiated in Tcl (not C). */
// Tcl_FSRenameFileProc *renameFileProc;
// /* Function to process a
// * 'Tcl_FSRenameFile()' call. If not
// * implemented, Tcl will fall back on
// * a copy and delete mechanism, for
// * rename actions initiated in Tcl (not C). */
// Tcl_FSCopyDirectoryProc *copyDirectoryProc;
// /* Function to process a
// * 'Tcl_FSCopyDirectory()' call. If
// * not implemented, Tcl will fall back
// * on a recursive create-dir, file copy
// * mechanism, for copying actions
// * initiated in Tcl (not C). */
// Tcl_FSLstatProc *lstatProc;
// /* Function to process a
// * 'Tcl_FSLstat()' call. If not implemented,
// * Tcl will attempt to use the 'statProc'
// * defined above instead. */
// Tcl_FSLoadFileProc *loadFileProc;
// /* Function to process a
// * 'Tcl_FSLoadFile()' call. If not
// * implemented, Tcl will fall back on
// * a copy to native-temp followed by a
// * Tcl_FSLoadFile on that temporary copy. */
// Tcl_FSGetCwdProc *getCwdProc;
// /*
// * Function to process a 'Tcl_FSGetCwd()'
// * call. Most filesystems need not
// * implement this. It will usually only be
// * called once, if 'getcwd' is called
// * before 'chdir'. May be NULL.
// */
// Tcl_FSChdirProc *chdirProc;
// /*
// * Function to process a 'Tcl_FSChdir()'
// * call. If filesystems do not implement
// * this, it will be emulated by a series of
// * directory access checks. Otherwise,
// * virtual filesystems which do implement
// * it need only respond with a positive
// * return result if the dirName is a valid
// * directory in their filesystem. They
// * need not remember the result, since that
// * will be automatically remembered for use
// * by GetCwd. Real filesystems should
// * carry out the correct action (i.e. call
// * the correct system 'chdir' api). If not
// * implemented, then 'cd' and 'pwd' will
// * fail inside the filesystem.
// */
//} Tcl_Filesystem;
 
/*
* The following definitions are used as values for the 'linkAction' flag
* to Tcl_FSLink, or the linkProc of any filesystem. Any combination
* of flags can be given. For link creation, the linkProc should create
* a link which matches any of the types given.
*
* TCL_CREATE_SYMBOLIC_LINK: Create a symbolic or soft link.
* TCL_CREATE_HARD_LINK: Create a hard link.
*/
//#define TCL_CREATE_SYMBOLIC_LINK 0x01
//#define TCL_CREATE_HARD_LINK 0x02
 
/*
* The following structure represents the Notifier functions that
* you can override with the Tcl_SetNotifier call.
*/
//typedef struct Tcl_NotifierProcs {
// Tcl_SetTimerProc *setTimerProc;
// Tcl_WaitForEventProc *waitForEventProc;
// Tcl_CreateFileHandlerProc *createFileHandlerProc;
// Tcl_DeleteFileHandlerProc *deleteFileHandlerProc;
// Tcl_InitNotifierProc *initNotifierProc;
// Tcl_FinalizeNotifierProc *finalizeNotifierProc;
// Tcl_AlertNotifierProc *alertNotifierProc;
// Tcl_ServiceModeHookProc *serviceModeHookProc;
//} Tcl_NotifierProcs;
 
 
/*
* The following structure represents a user-defined encoding. It collects
* together all the functions that are used by the specific encoding.
*/
//typedef struct Tcl_EncodingType {
// string encodingName; /* The name of the encoding, e.g. "euc-jp".
// * This name is the unique key for this
// * encoding type. */
// Tcl_EncodingConvertProc *toUtfProc;
// /* Procedure to convert from external
// * encoding into UTF-8. */
// Tcl_EncodingConvertProc *fromUtfProc;
// /* Procedure to convert from UTF-8 into
// * external encoding. */
// Tcl_EncodingFreeProc *freeProc;
// /* If non-NULL, procedure to call when this
// * encoding is deleted. */
// ClientData clientData; /* Arbitrary value associated with encoding
// * type. Passed to conversion procedures. */
// int nullSize; /* Number of zero bytes that signify
// * end-of-string in this encoding. This
// * number is used to determine the source
// * string length when the srcLen argument is
// * negative. Must be 1 or 2. */
//} Tcl_EncodingType;
 
/*
* The following definitions are used as values for the conversion control
* flags argument when converting text from one character set to another:
*
* TCL_ENCODING_START: Signifies that the source buffer is the first
* block in a (potentially multi-block) input
* stream. Tells the conversion procedure to
* reset to an initial state and perform any
* initialization that needs to occur before the
* first byte is converted. If the source
* buffer contains the entire input stream to be
* converted, this flag should be set.
*
* TCL_ENCODING_END: Signifies that the source buffer is the last
* block in a (potentially multi-block) input
* stream. Tells the conversion routine to
* perform any finalization that needs to occur
* after the last byte is converted and then to
* reset to an initial state. If the source
* buffer contains the entire input stream to be
* converted, this flag should be set.
*
* TCL_ENCODING_STOPONERROR: If set, then the converter will return
* immediately upon encountering an invalid
* byte sequence or a source character that has
* no mapping in the target encoding. If clear,
* then the converter will skip the problem,
* substituting one or more "close" characters
* in the destination buffer and then continue
* to sonvert the source.
*/
//#define TCL_ENCODING_START 0x01
//#define TCL_ENCODING_END 0x02
//#define TCL_ENCODING_STOPONERROR 0x04
 
 
/*
* The following data structures and declarations are for the new Tcl
* parser.
*/
 
/*
* For each word of a command, and for each piece of a word such as a
* variable reference, one of the following structures is created to
* describe the token.
*/
//typedef struct Tcl_Token {
// int type; /* Type of token, such as TCL_TOKEN_WORD;
// * see below for valid types. */
// string start; /* First character in token. */
// int size; /* Number of bytes in token. */
// int numComponents; /* If this token is composed of other
// * tokens, this field tells how many of
// * them there are (including components of
// * components, etc.). The component tokens
// * immediately follow this one. */
//} Tcl_Token;
 
/*
* Type values defined for Tcl_Token structures. These values are
* defined as mask bits so that it's easy to check for collections of
* types.
*
* TCL_TOKEN_WORD - The token describes one word of a command,
* from the first non-blank character of
* the word (which may be " or {) up to but
* not including the space, semicolon, or
* bracket that terminates the word.
* NumComponents counts the total number of
* sub-tokens that make up the word. This
* includes, for example, sub-tokens of
* TCL_TOKEN_VARIABLE tokens.
* TCL_TOKEN_SIMPLE_WORD - This token is just like TCL_TOKEN_WORD
* except that the word is guaranteed to
* consist of a single TCL_TOKEN_TEXT
* sub-token.
* TCL_TOKEN_TEXT - The token describes a range of literal
* text that is part of a word.
* NumComponents is always 0.
* TCL_TOKEN_BS - The token describes a backslash sequence
* that must be collapsed. NumComponents
* is always 0.
* TCL_TOKEN_COMMAND - The token describes a command whose result
* must be substituted into the word. The
* token includes the enclosing brackets.
* NumComponents is always 0.
* TCL_TOKEN_VARIABLE - The token describes a variable
* substitution, including the dollar sign,
* variable name, and array index (if there
* is one) up through the right
* parentheses. NumComponents tells how
* many additional tokens follow to
* represent the variable name. The first
* token will be a TCL_TOKEN_TEXT token
* that describes the variable name. If
* the variable is an array reference then
* there will be one or more additional
* tokens, of type TCL_TOKEN_TEXT,
* TCL_TOKEN_BS, TCL.TCL_TOKEN_COMMAND, and
* TCL_TOKEN_VARIABLE, that describe the
* array index; numComponents counts the
* total number of nested tokens that make
* up the variable reference, including
* sub-tokens of TCL_TOKEN_VARIABLE tokens.
* TCL_TOKEN_SUB_EXPR - The token describes one subexpression of a
* expression, from the first non-blank
* character of the subexpression up to but not
* including the space, brace, or bracket
* that terminates the subexpression.
* NumComponents counts the total number of
* following subtokens that make up the
* subexpression; this includes all subtokens
* for any nested TCL_TOKEN_SUB_EXPR tokens.
* For example, a numeric value used as a
* primitive operand is described by a
* TCL_TOKEN_SUB_EXPR token followed by a
* TCL_TOKEN_TEXT token. A binary subexpression
* is described by a TCL_TOKEN_SUB_EXPR token
* followed by the TCL_TOKEN_OPERATOR token
* for the operator, then TCL_TOKEN_SUB_EXPR
* tokens for the left then the right operands.
* TCL_TOKEN_OPERATOR - The token describes one expression operator.
* An operator might be the name of a math
* function such as "abs". A TCL_TOKEN_OPERATOR
* token is always preceeded by one
* TCL_TOKEN_SUB_EXPR token for the operator's
* subexpression, and is followed by zero or
* more TCL_TOKEN_SUB_EXPR tokens for the
* operator's operands. NumComponents is
* always 0.
*/
//#define TCL_TOKEN_WORD 1
//#define TCL_TOKEN_SIMPLE_WORD 2
//#define TCL_TOKEN_TEXT 4
//#define TCL_TOKEN_BS 8
//#define TCL_TOKEN_COMMAND 16
//#define TCL_TOKEN_VARIABLE 32
//#define TCL_TOKEN_SUB_EXPR 64
//#define TCL_TOKEN_OPERATOR 128
 
/*
* Parsing error types. On any parsing error, one of these values
* will be stored in the error field of the Tcl_Parse structure
* defined below.
*/
//#define TCL_PARSE_SUCCESS 0
//#define TCL_PARSE_QUOTE_EXTRA 1
//#define TCL_PARSE_BRACE_EXTRA 2
//#define TCL_PARSE_MISSING_BRACE 3
//#define TCL_PARSE_MISSING_BRACKET 4
//#define TCL_PARSE_MISSING_PAREN 5
//#define TCL_PARSE_MISSING_QUOTE 6
//#define TCL_PARSE_MISSING_VAR_BRACE 7
//#define TCL_PARSE_SYNTAX 8
//#define TCL_PARSE_BAD_NUMBER 9
 
/*
* A structure of the following type is filled in by Tcl_ParseCommand.
* It describes a single command parsed from an input string.
*/
//#define NUM_STATIC_TOKENS 20
 
//typedef struct Tcl_Parse {
// string commentStart; /* Pointer to # that begins the first of
// * one or more comments preceding the
// * command. */
// int commentSize; /* Number of bytes in comments (up through
// * newline character that terminates the
// * last comment). If there were no
// * comments, this field is 0. */
// string commandStart; /* First character in first word of command. */
// int commandSize; /* Number of bytes in command, including
// * first character of first word, up
// * through the terminating newline,
// * close bracket, or semicolon. */
// int numWords; /* Total number of words in command. May
// * be 0. */
// Tcl_Token *tokenPtr; /* Pointer to first token representing
// * the words of the command. Initially
// * points to staticTokens, but may change
// * to point to malloc-ed space if command
// * exceeds space in staticTokens. */
// int numTokens; /* Total number of tokens in command. */
// int tokensAvailable; /* Total number of tokens available at
// * *tokenPtr. */
// int errorType; /* One of the parsing error types defined
// * above. */
 
// /*
// * The fields below are intended only for the private use of the
// * parser. They should not be used by procedures that invoke
// * Tcl_ParseCommand.
// */
 
// string string; /* The original command string passed to
// * Tcl_ParseCommand. */
// string end; /* Points to the character just after the
// * last one in the command string. */
// Tcl_Interp interp; /* Interpreter to use for error reporting,
// * or NULL. */
// string term; /* Points to character in string that
// * terminated most recent token. Filled in
// * by ParseTokens. If an error occurs,
// * points to beginning of region where the
// * error occurred (e.g. the open brace if
// * the close brace is missing). */
// int incomplete; /* This field is set to 1 by Tcl_ParseCommand
// * if the command appears to be incomplete.
// * This information is used by
// * Tcl_CommandComplete. */
// Tcl_Token staticTokens[NUM_STATIC_TOKENS];
// /* Initial space for tokens for command.
// * This space should be large enough to
// * accommodate most commands; dynamic
// * space is allocated for very large
// * commands that don't fit here. */
//} Tcl_Parse;
 
/*
* The following definitions are the error codes returned by the conversion
* routines:
*
* TCL_OK: All characters were converted.
*
* TCL_CONVERT_NOSPACE: The output buffer would not have been large
* enough for all of the converted data; as many
* characters as could fit were converted though.
*
* TCL_CONVERT_MULTIBYTE: The last few bytes in the source string were
* the beginning of a multibyte sequence, but
* more bytes were needed to complete this
* sequence. A subsequent call to the conversion
* routine should pass the beginning of this
* unconverted sequence plus additional bytes
* from the source stream to properly convert
* the formerly split-up multibyte sequence.
*
* TCL_CONVERT_SYNTAX: The source stream contained an invalid
* character sequence. This may occur if the
* input stream has been damaged or if the input
* encoding method was misidentified. This error
* is reported only if TCL_ENCODING_STOPONERROR
* was specified.
*
* TCL_CONVERT_UNKNOWN: The source string contained a character
* that could not be represented in the target
* encoding. This error is reported only if
* TCL_ENCODING_STOPONERROR was specified.
*/
//#define TCL_CONVERT_MULTIBYTE -1
//#define TCL_CONVERT_SYNTAX -2
//#define TCL_CONVERT_UNKNOWN -3
//#define TCL_CONVERT_NOSPACE -4
 
/*
* The maximum number of bytes that are necessary to represent a single
* Unicode character in UTF-8. The valid values should be 3 or 6 (or
* perhaps 1 if we want to support a non-unicode enabled core).
* If 3, then Tcl_UniChar must be 2-bytes in size (UCS-2). (default)
* If 6, then Tcl_UniChar must be 4-bytes in size (UCS-4).
* At this time UCS-2 mode is the default and recommended mode.
* UCS-4 is experimental and not recommended. It works for the core,
* but most extensions expect UCS-2.
*/
#if !TCL_UTF_MAX
//#define TCL_UTF_MAX 3
#endif
 
/*
* This represents a Unicode character. Any changes to this should
* also be reflected in regcustom.h.
*/
//#if TCL_UTF_MAX > 3
// /*
// * unsigned int isn't 100% accurate as it should be a strict 4-byte
// * value (perhaps wchar_t). 64-bit systems may have troubles. The
// * size of this value must be reflected correctly in regcustom.h and
// * in tclEncoding.c.
// * XXX: Tcl is currently UCS-2 and planning UTF-16 for the Unicode
// * XXX: string rep that Tcl_UniChar represents. Changing the size
// * XXX: of Tcl_UniChar is /not/ supported.
// */
//typedef unsigned int Tcl_UniChar;
//#else
//typedef unsigned short Tcl_UniChar;
//#endif
 
 
/*
* Deprecated Tcl procedures:
*/
#if !TCL_NO_DEPRECATED
//# define Tcl_EvalObj(interp,objPtr) \
// Tcl_EvalObjEx((interp),(objPtr),0)
//# define Tcl_GlobalEvalObj(interp,objPtr) \
// Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
#endif
 
 
/*
* These function have been renamed. The old names are deprecated, but we
* define these macros for backwards compatibilty.
*/
//#define Tcl_Ckalloc Tcl_Alloc
//#define Tcl_Ckfree Tcl_Free
//#define Tcl_Ckrealloc Tcl_Realloc
//#define Tcl_return TCL.TCL_SetResult
//#define Tcl_TildeSubst Tcl_TranslateFileName
//#define panic Tcl_Panic
//#define panicVA Tcl_PanicVA
 
 
/*
* The following constant is used to test for older versions of Tcl
* in the stubs tables.
*
* Jan Nijtman's plus patch uses 0xFCA1BACF, so we need to pick a different
* value since the stubs tables don't match.
*/
 
//#define TCL_STUB_MAGIC ((int)0xFCA3BACF)
 
/*
* The following function is required to be defined in all stubs aware
* extensions. The function is actually implemented in the stub
* library, not the main Tcl library, although there is a trivial
* implementation in the main library in case an extension is statically
* linked into an application.
*/
 
//EXTERN string Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp interp,
// string version, int exact));
 
#if !USE_TCL_STUBS
 
/*
* When not using stubs, make it a macro.
*/
 
//#define Tcl_InitStubs(interp, version, exact) \
// Tcl_PkgRequire(interp, "Tcl", version, exact)
 
#endif
 
 
/*
* Include the public function declarations that are accessible via
* the stubs table.
*/
 
//#include "tclDecls.h"
 
/*
* Include platform specific public function declarations that are
* accessible via the stubs table.
*/
 
/*
* tclPlatDecls.h can't be included here on the Mac, as we need
* Mac specific headers to define the Mac types used in this file,
* but these Mac haders conflict with a number of tk types
* and thus can't be included in the globally read tcl.h
* This header was originally added here as a fix for bug 5241
* (stub link error for symbols in TclPlatStubs table), as a work-
* around for the bug on the mac, tclMac.h is included immediately
* after tcl.h in the tcl precompiled header (with DLLEXPORT set).
*/
 
//#if !(MAC_TCL)
//#include "tclPlatDecls.h"
//#endif
 
/*
* Public functions that are not accessible via the stubs table.
*/
 
//EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv,
// Tcl_AppInitProc *appInitProc));
 
/*
* Convenience declaration of Tcl_AppInit for backwards compatibility.
* This function is not *implemented* by the tcl library, so the storage
* class is neither DLLEXPORT nor DLLIMPORT
*/
//#undef TCL_STORAGE_CLASS
//#define TCL_STORAGE_CLASS
 
//EXTERN int Tcl_AppInit _ANSI_ARGS_((Tcl_Interp interp));
 
//#undef TCL_STORAGE_CLASS
//#define TCL_STORAGE_CLASS DLLIMPORT
 
#endif // * RC_INVOKED */
 
/*
* end block for C++
*/
#if __cplusplus
//}
#endif
 
#endif // * _TCL */
}
}
/trunk/TCL/tcl.csproj
@@ -0,0 +1,235 @@
<Project DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003" ToolsVersion="3.5">
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProductVersion>9.0.30729</ProductVersion>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{5275CAE1-E902-44C8-9DA6-0FC33FC0B68C}</ProjectGuid>
<OutputType>Exe</OutputType>
<AppDesignerFolder>Properties</AppDesignerFolder>
<RootNamespace>tcl</RootNamespace>
<AssemblyName>tcl</AssemblyName>
<FileUpgradeFlags>
</FileUpgradeFlags>
<OldToolsVersion>2.0</OldToolsVersion>
<UpgradeBackupLocation>
</UpgradeBackupLocation>
<TargetFrameworkVersion>v3.5</TargetFrameworkVersion>
<PublishUrl>publish\</PublishUrl>
<Install>true</Install>
<InstallFrom>Disk</InstallFrom>
<UpdateEnabled>false</UpdateEnabled>
<UpdateMode>Foreground</UpdateMode>
<UpdateInterval>7</UpdateInterval>
<UpdateIntervalUnits>Days</UpdateIntervalUnits>
<UpdatePeriodically>false</UpdatePeriodically>
<UpdateRequired>false</UpdateRequired>
<MapFileExtensions>true</MapFileExtensions>
<ApplicationRevision>0</ApplicationRevision>
<ApplicationVersion>1.0.0.%2a</ApplicationVersion>
<IsWebBootstrapper>false</IsWebBootstrapper>
<UseApplicationTrust>false</UseApplicationTrust>
<BootstrapperEnabled>true</BootstrapperEnabled>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<Optimize>false</Optimize>
<OutputPath>bin\Debug\</OutputPath>
<DefineConstants>DEBUG;TRACE</DefineConstants>
<ErrorReport>prompt</ErrorReport>
<WarningLevel>4</WarningLevel>
<NoWarn>0168 ; 0169; 0414; 0618; 0649</NoWarn>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DefineConstants>TRACE</DefineConstants>
<ErrorReport>prompt</ErrorReport>
<WarningLevel>4</WarningLevel>
</PropertyGroup>
<ItemGroup>
<Reference Include="System" />
<Reference Include="System.Core">
<RequiredTargetFramework>3.5</RequiredTargetFramework>
</Reference>
<Reference Include="System.Data" />
<Reference Include="System.Xml" />
</ItemGroup>
<ItemGroup>
<Compile Include="Properties\AssemblyInfo.cs" />
<Compile Include="src\base\AssocData.cs" />
<Compile Include="src\base\BackSlashResult.cs" />
<Compile Include="src\base\BgErrorMgr.cs" />
<Compile Include="src\base\CallFrame.cs" />
<Compile Include="src\base\CharPointer.cs" />
<Compile Include="src\base\CObject.cs" />
<Compile Include="src\base\Command.cs" />
<Compile Include="src\base\CommandWithDispose.cs" />
<Compile Include="src\base\DebugInfo.cs" />
<Compile Include="src\base\Env.cs" />
<Compile Include="src\base\EventDeleter.cs" />
<Compile Include="src\base\EventuallyFreed.cs" />
<Compile Include="src\base\Expression.cs" />
<Compile Include="src\base\ExprValue.cs" />
<Compile Include="src\base\Extension.cs" />
<Compile Include="src\base\FindElemResult.cs" />
<Compile Include="src\base\IdleHandler.cs" />
<Compile Include="src\base\ImportedCmdData.cs" />
<Compile Include="src\base\ImportRef.cs" />
<Compile Include="src\base\InternalRep.cs" />
<Compile Include="src\base\Interp.cs" />
<Compile Include="src\base\JACL.cs" />
<Compile Include="src\base\Notifier.cs" />
<Compile Include="src\base\Parser.cs" />
<Compile Include="src\base\ParseResult.cs" />
<Compile Include="src\base\Procedure.cs" />
<Compile Include="src\base\QSort.cs" />
<Compile Include="src\base\Resolver.cs" />
<Compile Include="src\base\SearchId.cs" />
<Compile Include="src\base\TCL.cs" />
<Compile Include="src\base\TclBoolean.cs" />
<Compile Include="src\base\TclByteArray.cs" />
<Compile Include="src\base\TclDouble.cs" />
<Compile Include="src\base\TclEvent.cs" />
<Compile Include="src\base\TclException.cs" />
<Compile Include="src\base\TclIndex.cs" />
<Compile Include="src\base\TclInteger.cs" />
<Compile Include="src\base\TclList.cs" />
<Compile Include="src\base\TclLong.cs" />
<Compile Include="src\base\TclNumArgsException.cs" />
<Compile Include="src\base\TCLObj.cs" />
<Compile Include="src\base\TclObject.cs" />
<Compile Include="src\base\TclParse.cs" />
<Compile Include="src\base\TclPosixException.cs" />
<Compile Include="src\base\TclRegexp.cs" />
<Compile Include="src\base\TclRuntimeError.cs" />
<Compile Include="src\base\TclString.cs" />
<Compile Include="src\base\TclToken.cs" />
<Compile Include="src\base\TclVarException.cs" />
<Compile Include="src\base\TimerHandler.cs" />
<Compile Include="src\base\TraceRecord.cs" />
<Compile Include="src\base\Util.cs" />
<Compile Include="src\base\Var.cs" />
<Compile Include="src\base\VarTrace.cs" />
<Compile Include="src\base\WrappedCommand.cs" />
<Compile Include="src\commands\AfterCmd.cs" />
<Compile Include="src\commands\AppendCmd.cs" />
<Compile Include="src\commands\ArrayCmd.cs" />
<Compile Include="src\commands\BinaryCmd.cs" />
<Compile Include="src\commands\BreakCmd.cs" />
<Compile Include="src\commands\CaseCmd.cs" />
<Compile Include="src\commands\CatchCmd.cs" />
<Compile Include="src\commands\CdCmd.cs" />
<Compile Include="src\commands\ClockCmd.cs" />
<Compile Include="src\commands\CloseCmd.cs" />
<Compile Include="src\commands\ConcatCmd.cs" />
<Compile Include="src\commands\ContinueCmd.cs" />
<Compile Include="src\commands\EncodingCmd.cs" />
<Compile Include="src\commands\EofCmd.cs" />
<Compile Include="src\commands\ErrorCmd.cs" />
<Compile Include="src\commands\EvalCmd.cs" />
<Compile Include="src\commands\ExecCmd.cs" />
<Compile Include="src\commands\ExitCmd.cs" />
<Compile Include="src\commands\ExprCmd.cs" />
<Compile Include="src\commands\FblockedCmd.cs" />
<Compile Include="src\commands\FconfigureCmd.cs" />
<Compile Include="src\commands\FileCmd.cs" />
<Compile Include="src\commands\FlushCmd.cs" />
<Compile Include="src\commands\ForCmd.cs" />
<Compile Include="src\commands\ForeachCmd.cs" />
<Compile Include="src\commands\FormatCmd.cs" />
<Compile Include="src\commands\GetsCmd.cs" />
<Compile Include="src\commands\GlobalCmd.cs" />
<Compile Include="src\commands\GlobCmd.cs" />
<Compile Include="src\commands\IfCmd.cs" />
<Compile Include="src\commands\IncrCmd.cs" />
<Compile Include="src\commands\InfoCmd.cs" />
<Compile Include="src\commands\InterpAliasCmd.cs" />
<Compile Include="src\commands\InterpCmd.cs" />
<Compile Include="src\commands\InterpSlaveCmd.cs" />
<Compile Include="src\commands\JoinCmd.cs" />
<Compile Include="src\commands\LappendCmd.cs" />
<Compile Include="src\commands\LindexCmd.cs" />
<Compile Include="src\commands\LinsertCmd.cs" />
<Compile Include="src\commands\ListCmd.cs" />
<Compile Include="src\commands\LlengthCmd.cs" />
<Compile Include="src\commands\LrangeCmd.cs" />
<Compile Include="src\commands\LreplaceCmd.cs" />
<Compile Include="src\commands\LsearchCmd.cs" />
<Compile Include="src\commands\LsortCmd.cs" />
<Compile Include="src\commands\NamespaceCmd.cs" />
<Compile Include="src\commands\OpenCmd.cs" />
<Compile Include="src\commands\PackageCmd.cs" />
<Compile Include="src\commands\ParseAdaptor.cs" />
<Compile Include="src\commands\ProcCmd.cs" />
<Compile Include="src\commands\PutsCmd.cs" />
<Compile Include="src\commands\PwdCmd.cs" />
<Compile Include="src\commands\ReadCmd.cs" />
<Compile Include="src\commands\RegexpCmd.cs" />
<Compile Include="src\commands\RegsubCmd.cs" />
<Compile Include="src\commands\RenameCmd.cs" />
<Compile Include="src\commands\ReturnCmd.cs" />
<Compile Include="src\commands\ScanCmd.cs" />
<Compile Include="src\commands\SeekCmd.cs" />
<Compile Include="src\commands\SetCmd.cs" />
<Compile Include="src\commands\SocketChannel.cs" />
<Compile Include="src\commands\SourceCmd.cs" />
<Compile Include="src\commands\SplitCmd.cs" />
<Compile Include="src\commands\StdChannel.cs" />
<Compile Include="src\commands\StringCmd.cs" />
<Compile Include="src\commands\StrtodResult.cs" />
<Compile Include="src\commands\StrtoulResult.cs" />
<Compile Include="src\commands\SubstCmd.cs" />
<Compile Include="src\commands\SwitchCmd.cs" />
<Compile Include="src\commands\TellCmd.cs" />
<Compile Include="src\commands\TimeCmd.cs" />
<Compile Include="src\commands\TraceCmd.cs" />
<Compile Include="src\commands\UnsetCmd.cs" />
<Compile Include="src\commands\UpdateCmd.cs" />
<Compile Include="src\commands\UplevelCmd.cs" />
<Compile Include="src\commands\UpvarCmd.cs" />
<Compile Include="src\commands\VariableCmd.cs" />
<Compile Include="src\commands\VwaitCmd.cs" />
<Compile Include="src\commands\WhileCmd.cs" />
<Compile Include="src\csTCL.cs" />
<Compile Include="src\io\Channel.cs" />
<Compile Include="src\io\ChannelBuffer.cs" />
<Compile Include="src\io\FileChannel.cs" />
<Compile Include="src\io\FileUtil.cs" />
<Compile Include="src\io\TclInputStream.cs" />
<Compile Include="src\io\TclIO.cs" />
<Compile Include="src\io\TclOutputStream.cs" />
<Compile Include="src\regexp_brazil\Regexp.cs" />
<Compile Include="src\regexp_brazil\Regsub.cs" />
<Compile Include="src\SupportClass.cs" />
<Compile Include="src\tcl_h.cs" />
<Compile Include="src\_tcl_Conversions.cs" />
</ItemGroup>
<ItemGroup>
<BootstrapperPackage Include="Microsoft.Net.Framework.2.0">
<Visible>False</Visible>
<ProductName>.NET Framework 2.0 %28x86%29</ProductName>
<Install>true</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.0">
<Visible>False</Visible>
<ProductName>.NET Framework 3.0 %28x86%29</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.5">
<Visible>False</Visible>
<ProductName>.NET Framework 3.5</ProductName>
<Install>false</Install>
</BootstrapperPackage>
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Microsoft.CSharp.targets" />
<!-- To modify your build process, add your task inside one of the targets below and uncomment it.
Other similar extension points exist, see Microsoft.Common.targets.
<Target Name="BeforeBuild">
</Target>
<Target Name="AfterBuild">
</Target>
-->
</Project>
/trunk/TCL/tcl.sln
@@ -0,0 +1,20 @@

Microsoft Visual Studio Solution File, Format Version 10.00
# Visual Studio 2008
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "tcl", "tcl.csproj", "{5275CAE1-E902-44C8-9DA6-0FC33FC0B68C}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{5275CAE1-E902-44C8-9DA6-0FC33FC0B68C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{5275CAE1-E902-44C8-9DA6-0FC33FC0B68C}.Debug|Any CPU.Build.0 = Debug|Any CPU
{5275CAE1-E902-44C8-9DA6-0FC33FC0B68C}.Release|Any CPU.ActiveCfg = Release|Any CPU
{5275CAE1-E902-44C8-9DA6-0FC33FC0B68C}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
EndGlobal