wasCSharpSQLite – Blame information for rev

Subversion Repositories:
Rev:
Rev Author Line No. Line
1 office 1 #undef DEBUG
2 /*
3 * Interp.java --
4 *
5 * Implements the core Tcl interpreter.
6 *
7 * Copyright (c) 1997 Cornell University.
8 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
9 *
10 * See the file "license.terms" for information on usage and
11 * redistribution of this file, and for a DISCLAIMER OF ALL
12 * WARRANTIES.
13 *
14 * Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
15 *
16 * RCS @(#) $Id: Interp.java,v 1.44 2003/07/25 16:38:35 mdejong Exp $
17 *
18 */
19 using System;
20 using System.Collections;
21 using System.IO;
22 using System.Text;
23  
24 namespace tcl.lang
25 {
26  
27 /// <summary> The Tcl interpreter class.</summary>
28  
29 public class Interp : EventuallyFreed
30 {
31 private void InitBlock()
32 {
33 reflectObjTable = new Hashtable();
34 reflectConflictTable = new Hashtable();
35 importTable = new Hashtable[] { new Hashtable(), new Hashtable() };
36 }
37 /// <summary> Returns the name of the script file currently under execution.
38 ///
39 /// </summary>
40 /// <returns> the name of the script file currently under execution.
41 /// </returns>
42 internal string ScriptFile
43 {
44 get
45 {
46 return dbg.fileName;
47 }
48  
49 }
50  
51 // The following three variables are used to maintain a translation
52 // table between ReflectObject's and their string names. These
53 // variables are accessed by the ReflectObject class, they
54 // are defined here be cause we need them to be per interp data.
55  
56 // Translates Object to ReflectObject. This makes sure we have only
57 // one ReflectObject internalRep for the same Object -- this
58 // way Object identity can be done by string comparison.
59  
60 internal Hashtable reflectObjTable;
61  
62 // Number of reflect objects created so far inside this Interp
63 // (including those that have be freed)
64  
65 internal long reflectObjCount = 0;
66  
67 // Table used to store reflect hash index conflicts, see
68 // ReflectObject implementation for more details
69  
70 internal Hashtable reflectConflictTable;
71  
72 // The number of chars to copy from an offending command into error
73 // message.
74  
75 private const int MAX_ERR_LENGTH = 200;
76  
77  
78 // We pretend this is Tcl 8.0, patch level 0.
79  
80 internal const string TCL_VERSION = "8.0";
81 internal const string TCL_PATCH_LEVEL = "8.0";
82  
83  
84 // Total number of times a command procedure
85 // has been called for this interpreter.
86  
87 protected internal int cmdCount;
88  
89 // FIXME : remove later
90 // Table of commands for this interpreter.
91 //Hashtable cmdTable;
92  
93 // Table of channels currently registered in this interp.
94  
95 internal Hashtable interpChanTable;
96  
97 // The Notifier associated with this Interp.
98  
99 private Notifier notifier;
100  
101 // Hash table for associating data with this interpreter. Cleaned up
102 // when this interpreter is deleted.
103  
104 internal Hashtable assocData;
105  
106 // Current working directory.
107  
108 private FileInfo workingDir;
109  
110 // Points to top-most in stack of all nested procedure
111 // invocations. null means there are no active procedures.
112  
113 internal CallFrame frame;
114  
115 // Points to the call frame whose variables are currently in use
116 // (same as frame unless an "uplevel" command is being
117 // executed). null means no procedure is active or "uplevel 0" is
118 // being exec'ed.
119  
120 internal CallFrame varFrame;
121  
122 // The interpreter's global namespace.
123  
124 internal NamespaceCmd.Namespace globalNs;
125  
126 // Hash table used to keep track of hidden commands on a per-interp basis.
127  
128 internal Hashtable hiddenCmdTable;
129  
130 // Information used by InterpCmd.java to keep
131 // track of master/slave interps on a per-interp basis.
132  
133 // Keeps track of all interps for which this interp is the Master.
134 // First, slaveTable (a hashtable) maps from names of commands to
135 // slave interpreters. This hashtable is used to store information
136 // about slave interpreters of this interpreter, to map over all slaves, etc.
137  
138 internal Hashtable slaveTable;
139  
140 // Hash table for Target Records. Contains all Target records which denote
141 // aliases from slaves or sibling interpreters that direct to commands in
142 // this interpreter. This table is used to remove dangling pointers
143 // from the slave (or sibling) interpreters when this interpreter is deleted.
144  
145 internal Hashtable targetTable;
146  
147 // Information necessary for this interp to function as a slave.
148 internal InterpSlaveCmd slave;
149  
150 // Table which maps from names of commands in slave interpreter to
151 // InterpAliasCmd objects.
152  
153 internal Hashtable aliasTable;
154  
155 // FIXME : does globalFrame need to be replaced by globalNs?
156 // Points to the global variable frame.
157  
158 //CallFrame globalFrame;
159  
160 // The script file currently under execution. Can be null if the
161 // interpreter is not evaluating any script file.
162  
163 internal string scriptFile;
164  
165 // Number of times the interp.eval() routine has been recursively
166 // invoked.
167  
168 internal int nestLevel;
169  
170 // Used to catch infinite loops in Parser.eval2.
171  
172 internal int maxNestingDepth;
173  
174 // Flags used when evaluating a command.
175  
176 internal int evalFlags;
177  
178 // Flags used when evaluating a command.
179  
180 public int flags;
181  
182 // Is this interpreted marked as safe?
183  
184 internal bool isSafe;
185  
186 // Offset of character just after last one compiled or executed
187 // by Parser.eval2().
188  
189 internal int termOffset;
190  
191 // List of name resolution schemes added to this interpreter.
192 // Schemes are added/removed by calling addInterpResolver and
193 // removeInterpResolver.
194  
195 internal ArrayList resolvers;
196  
197 // The expression parser for this interp.
198  
199 internal Expression expr;
200  
201 // Used by the Expression class. If it is equal to zero, then the
202 // parser will evaluate commands and retrieve variable values from
203 // the interp.
204  
205 internal int noEval;
206  
207 // Used in the Expression.java file for the
208 // SrandFunction.class and RandFunction.class.
209 // Set to true if a seed has been set.
210  
211 internal bool randSeedInit;
212  
213 // Used in the Expression.java file for the SrandFunction.class and
214 // RandFunction.class. Stores the value of the seed.
215  
216 internal long randSeed;
217  
218 // If returnCode is TCL.CompletionCode.ERROR, stores the errorInfo.
219  
220 internal string errorInfo;
221  
222 // If returnCode is TCL.CompletionCode.ERROR, stores the errorCode.
223  
224 internal string errorCode;
225  
226 // Completion code to return if current procedure exits with a
227 // TCL_RETURN code.
228  
229 protected internal TCL.CompletionCode returnCode;
230  
231 // True means the interpreter has been deleted: don't process any
232 // more commands for it, and destroy the structure as soon as all
233 // nested invocations of eval() are done.
234  
235 protected internal bool deleted;
236  
237 // True means an error unwind is already in progress. False
238 // means a command proc has been invoked since last error occurred.
239  
240 protected internal bool errInProgress;
241  
242 // True means information has already been logged in $errorInfo
243 // for the current eval() instance, so eval() needn't log it
244 // (used to implement the "error" command).
245  
246 protected internal bool errAlreadyLogged;
247  
248 // True means that addErrorInfo has been called to record
249 // information for the current error. False means Interp.eval
250 // must clear the errorCode variable if an error is returned.
251  
252 protected internal bool errCodeSet;
253  
254 // When TCL_ERROR is returned, this gives the line number within
255 // the command where the error occurred (1 means first line).
256  
257  
258 internal int errorLine;
259  
260 // Stores the current result in the interpreter.
261  
262 private TclObject m_result;
263  
264 // Value m_result is set to when resetResult() is called.
265  
266 private TclObject m_nullResult;
267  
268 // Used ONLY by PackageCmd.
269  
270 internal Hashtable packageTable;
271 internal string packageUnknown;
272  
273  
274 // Used ONLY by the Parser.
275  
276 internal TclObject[][][] parserObjv;
277 internal int[] parserObjvUsed;
278  
279 internal TclToken[] parserTokens;
280 internal int parserTokensUsed;
281  
282  
283 // Used ONLY by JavaImportCmd
284 internal Hashtable[] importTable;
285  
286 // List of unsafe commands:
287  
288 internal static readonly string[] unsafeCmds = new string[] { "encoding", "exit", "load", "cd", "fconfigure", "file", "glob", "open", "pwd", "socket", "beep", "echo", "ls", "resource", "source", "exec", "source" };
289  
290 // Flags controlling the call of invoke.
291  
292 internal const int INVOKE_HIDDEN = 1;
293 internal const int INVOKE_NO_UNKNOWN = 2;
294 internal const int INVOKE_NO_TRACEBACK = 4;
295  
296 public Interp()
297 {
298 InitBlock();
299  
300 //freeProc = null;
301 errorLine = 0;
302  
303 // An empty result is used pretty often. We will use a shared
304 // TclObject instance to represent the empty result so that we
305 // don't need to create a new TclObject instance every time the
306 // interpreter result is set to empty.
307  
308 m_nullResult = TclString.newInstance( "" );
309 m_nullResult.preserve(); // Increment refCount to 1
310 m_nullResult.preserve(); // Increment refCount to 2 (shared)
311 m_result = TclString.newInstance( "" ); //m_nullResult; // correcponds to iPtr->objResultPtr
312 m_result.preserve();
313  
314 expr = new Expression();
315 nestLevel = 0;
316 maxNestingDepth = 1000;
317  
318 frame = null;
319 varFrame = null;
320  
321 returnCode = TCL.CompletionCode.OK;
322 errorInfo = null;
323 errorCode = null;
324  
325 packageTable = new Hashtable();
326 packageUnknown = null;
327 cmdCount = 0;
328 termOffset = 0;
329 resolvers = null;
330 evalFlags = 0;
331 scriptFile = null;
332 flags = 0;
333 isSafe = false;
334 assocData = null;
335  
336  
337 globalNs = null; // force creation of global ns below
338 globalNs = NamespaceCmd.createNamespace( this, null, null );
339 if ( globalNs == null )
340 {
341 throw new TclRuntimeError( "Interp(): can't create global namespace" );
342 }
343  
344  
345 // Init things that are specific to the Jacl implementation
346  
347 workingDir = new FileInfo( System.Environment.CurrentDirectory );
348 noEval = 0;
349  
350 notifier = Notifier.getNotifierForThread( System.Threading.Thread.CurrentThread );
351 notifier.preserve();
352  
353 randSeedInit = false;
354  
355 deleted = false;
356 errInProgress = false;
357 errAlreadyLogged = false;
358 errCodeSet = false;
359  
360 dbg = initDebugInfo();
361  
362 slaveTable = new Hashtable();
363 targetTable = new Hashtable();
364 aliasTable = new Hashtable();
365  
366 // init parser variables
367 Parser.init( this );
368 TclParse.init( this );
369  
370 // Initialize the Global (static) channel table and the local
371 // interp channel table.
372  
373 interpChanTable = TclIO.getInterpChanTable( this );
374  
375 // Sets up the variable trace for tcl_precision.
376  
377 Util.setupPrecisionTrace( this );
378  
379 // Create the built-in commands.
380  
381 createCommands();
382  
383 try
384 {
385 // Set up tcl_platform, tcl_version, tcl_library and other
386 // global variables.
387  
388 setVar( "tcl_platform", "platform", "windows", TCL.VarFlag.GLOBAL_ONLY );
389 setVar( "tcl_platform", "byteOrder", "bigEndian", TCL.VarFlag.GLOBAL_ONLY );
390  
391 setVar( "tcl_platform", "os", Environment.OSVersion.Platform.ToString(), TCL.VarFlag.GLOBAL_ONLY );
392 setVar( "tcl_platform", "osVersion", Environment.OSVersion.Version.ToString(), TCL.VarFlag.GLOBAL_ONLY );
393 setVar( "tcl_platform", "machine", Util.tryGetSystemProperty( "os.arch", "?" ), TCL.VarFlag.GLOBAL_ONLY );
394  
395 setVar( "tcl_version", TCL_VERSION, TCL.VarFlag.GLOBAL_ONLY );
396 setVar( "tcl_patchLevel", TCL_PATCH_LEVEL, TCL.VarFlag.GLOBAL_ONLY );
397 setVar( "tcl_library", "resource:/tcl/lang/library", TCL.VarFlag.GLOBAL_ONLY );
398 if ( Util.Windows )
399 {
400 setVar( "tcl_platform", "host_platform", "windows", TCL.VarFlag.GLOBAL_ONLY );
401 }
402 else if ( Util.Mac )
403 {
404 setVar( "tcl_platform", "host_platform", "macintosh", TCL.VarFlag.GLOBAL_ONLY );
405 }
406 else
407 {
408 setVar( "tcl_platform", "host_platform", "unix", TCL.VarFlag.GLOBAL_ONLY );
409 }
410  
411 // Create the env array an populated it with proper
412 // values.
413  
414 Env.initialize( this );
415  
416 // Register Tcl's version number. Note: This MUST be
417 // done before the call to evalResource, otherwise
418 // calls to "package require tcl" will fail.
419  
420 pkgProvide( "Tcl", TCL_VERSION );
421  
422 // Source the init.tcl script to initialize auto-loading.
423  
424 evalResource( "/tcl/lang/library/init.tcl" );
425 }
426 catch ( TclException e )
427 {
428 System.Diagnostics.Debug.WriteLine( getResult().ToString() );
429 SupportClass.WriteStackTrace( e, Console.Error );
430 throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
431 }
432 }
433 public override void eventuallyDispose()
434 {
435 if ( deleted )
436 {
437 return;
438 }
439  
440 deleted = true;
441  
442 if ( nestLevel > 0 )
443 {
444 //-- TODO -- Determine why this is an error throw new TclRuntimeError("dispose() called with active evals");
445 }
446  
447 // Remove our association with the notifer (if we had one).
448  
449 if ( notifier != null )
450 {
451 notifier.release();
452 notifier = null;
453 }
454  
455 // Dismantle everything in the global namespace except for the
456 // "errorInfo" and "errorCode" variables. These might be needed
457 // later on if errors occur while deleting commands. We are careful
458 // to destroy and recreate the "errorInfo" and "errorCode"
459 // variables, in case they had any traces on them.
460 //
461 // Dismantle the namespace here, before we clear the assocData. If any
462 // background errors occur here, they will be deleted below.
463  
464  
465 // FIXME : check impl of TclTeardownNamespace
466 NamespaceCmd.teardownNamespace( globalNs );
467  
468 // Delete all variables.
469  
470 TclObject errorInfoObj = null, errorCodeObj = null;
471  
472 try
473 {
474 errorInfoObj = getVar( "errorInfo", null, TCL.VarFlag.GLOBAL_ONLY );
475 }
476 catch ( TclException e )
477 {
478 // Do nothing when var does not exist.
479 }
480  
481 if ( errorInfoObj != null )
482 {
483 errorInfoObj.preserve();
484 }
485  
486 try
487 {
488 errorCodeObj = getVar( "errorCode", null, TCL.VarFlag.GLOBAL_ONLY );
489 }
490 catch ( TclException e )
491 {
492 // Do nothing when var does not exist.
493 }
494  
495 if ( errorCodeObj != null )
496 {
497 errorCodeObj.preserve();
498 }
499  
500 frame = null;
501 varFrame = null;
502  
503 try
504 {
505 if ( errorInfoObj != null )
506 {
507 setVar( "errorInfo", null, errorInfoObj, TCL.VarFlag.GLOBAL_ONLY );
508 errorInfoObj.release();
509 }
510 if ( errorCodeObj != null )
511 {
512 setVar( "errorCode", null, errorCodeObj, TCL.VarFlag.GLOBAL_ONLY );
513 errorCodeObj.release();
514 }
515 }
516 catch ( TclException e )
517 {
518 // Ignore it -- same behavior as Tcl 8.0.
519 }
520  
521 // Tear down the math function table.
522  
523 expr = null;
524  
525 // Remove all the assoc data tied to this interp and invoke
526 // deletion callbacks; note that a callback can create new
527 // callbacks, so we iterate.
528  
529 // ATK The java code was somethink strong
530 if ( assocData != null )
531 {
532 foreach ( AssocData data in assocData.Values )
533 {
534 data.disposeAssocData( this );
535 }
536 assocData.Clear();
537 }
538  
539 // Close any remaining channels
540  
541 for ( IDictionaryEnumerator e = interpChanTable.GetEnumerator(); e.MoveNext(); )
542 {
543 Object key = e.Key;
544 Channel chan = (Channel)e.Value;
545 try
546 {
547 chan.close();
548 }
549 catch ( IOException ex )
550 {
551 // Ignore any IO errors
552 }
553 }
554  
555 // Finish deleting the global namespace.
556  
557 // FIXME : check impl of Tcl_DeleteNamespace
558 NamespaceCmd.deleteNamespace( globalNs );
559 globalNs = null;
560  
561 // Free up the result *after* deleting variables, since variable
562 // deletion could have transferred ownership of the result string
563 // to Tcl.
564  
565 frame = null;
566 varFrame = null;
567 resolvers = null;
568  
569 resetResult();
570 }
571 ~Interp()
572 {
573 dispose();
574 }
575 protected internal void createCommands()
576 {
577 Extension.loadOnDemand( this, "after", "tcl.lang.AfterCmd" );
578 Extension.loadOnDemand( this, "append", "tcl.lang.AppendCmd" );
579 Extension.loadOnDemand( this, "array", "tcl.lang.ArrayCmd" );
580 Extension.loadOnDemand( this, "binary", "tcl.lang.BinaryCmd" );
581 Extension.loadOnDemand( this, "break", "tcl.lang.BreakCmd" );
582 Extension.loadOnDemand( this, "case", "tcl.lang.CaseCmd" );
583 Extension.loadOnDemand( this, "catch", "tcl.lang.CatchCmd" );
584 Extension.loadOnDemand( this, "cd", "tcl.lang.CdCmd" );
585 Extension.loadOnDemand( this, "clock", "tcl.lang.ClockCmd" );
586 Extension.loadOnDemand( this, "close", "tcl.lang.CloseCmd" );
587 Extension.loadOnDemand( this, "continue", "tcl.lang.ContinueCmd" );
588 Extension.loadOnDemand( this, "concat", "tcl.lang.ConcatCmd" );
589 Extension.loadOnDemand( this, "encoding", "tcl.lang.EncodingCmd" );
590 Extension.loadOnDemand( this, "eof", "tcl.lang.EofCmd" );
591 Extension.loadOnDemand( this, "eval", "tcl.lang.EvalCmd" );
592 Extension.loadOnDemand( this, "error", "tcl.lang.ErrorCmd" );
593 if ( !Util.Mac )
594 {
595 Extension.loadOnDemand( this, "exec", "tcl.lang.ExecCmd" );
596 }
597 Extension.loadOnDemand( this, "exit", "tcl.lang.ExitCmd" );
598 Extension.loadOnDemand( this, "expr", "tcl.lang.ExprCmd" );
599 Extension.loadOnDemand( this, "fblocked", "tcl.lang.FblockedCmd" );
600 Extension.loadOnDemand( this, "fconfigure", "tcl.lang.FconfigureCmd" );
601 Extension.loadOnDemand( this, "file", "tcl.lang.FileCmd" );
602 Extension.loadOnDemand( this, "flush", "tcl.lang.FlushCmd" );
603 Extension.loadOnDemand( this, "for", "tcl.lang.ForCmd" );
604 Extension.loadOnDemand( this, "foreach", "tcl.lang.ForeachCmd" );
605 Extension.loadOnDemand( this, "format", "tcl.lang.FormatCmd" );
606 Extension.loadOnDemand( this, "gets", "tcl.lang.GetsCmd" );
607 Extension.loadOnDemand( this, "global", "tcl.lang.GlobalCmd" );
608 Extension.loadOnDemand( this, "glob", "tcl.lang.GlobCmd" );
609 Extension.loadOnDemand( this, "if", "tcl.lang.IfCmd" );
610 Extension.loadOnDemand( this, "incr", "tcl.lang.IncrCmd" );
611 Extension.loadOnDemand( this, "info", "tcl.lang.InfoCmd" );
612 Extension.loadOnDemand( this, "interp", "tcl.lang.InterpCmd" );
613 Extension.loadOnDemand( this, "list", "tcl.lang.ListCmd" );
614 Extension.loadOnDemand( this, "join", "tcl.lang.JoinCmd" );
615 Extension.loadOnDemand( this, "lappend", "tcl.lang.LappendCmd" );
616 Extension.loadOnDemand( this, "lindex", "tcl.lang.LindexCmd" );
617 Extension.loadOnDemand( this, "linsert", "tcl.lang.LinsertCmd" );
618 Extension.loadOnDemand( this, "llength", "tcl.lang.LlengthCmd" );
619 Extension.loadOnDemand( this, "lrange", "tcl.lang.LrangeCmd" );
620 Extension.loadOnDemand( this, "lreplace", "tcl.lang.LreplaceCmd" );
621 Extension.loadOnDemand( this, "lsearch", "tcl.lang.LsearchCmd" );
622 Extension.loadOnDemand( this, "lset", "tcl.lang.LsetCmd" );
623 Extension.loadOnDemand( this, "lsort", "tcl.lang.LsortCmd" );
624 Extension.loadOnDemand( this, "namespace", "tcl.lang.NamespaceCmd" );
625 Extension.loadOnDemand( this, "open", "tcl.lang.OpenCmd" );
626 Extension.loadOnDemand( this, "package", "tcl.lang.PackageCmd" );
627 Extension.loadOnDemand( this, "proc", "tcl.lang.ProcCmd" );
628 Extension.loadOnDemand( this, "puts", "tcl.lang.PutsCmd" );
629 Extension.loadOnDemand( this, "pwd", "tcl.lang.PwdCmd" );
630 Extension.loadOnDemand( this, "read", "tcl.lang.ReadCmd" );
631 Extension.loadOnDemand( this, "regsub", "tcl.lang.RegsubCmd" );
632 Extension.loadOnDemand( this, "rename", "tcl.lang.RenameCmd" );
633 Extension.loadOnDemand( this, "return", "tcl.lang.ReturnCmd" );
634 Extension.loadOnDemand( this, "scan", "tcl.lang.ScanCmd" );
635 Extension.loadOnDemand( this, "seek", "tcl.lang.SeekCmd" );
636 Extension.loadOnDemand( this, "set", "tcl.lang.SetCmd" );
637 Extension.loadOnDemand( this, "socket", "tcl.lang.SocketCmd" );
638 Extension.loadOnDemand( this, "source", "tcl.lang.SourceCmd" );
639 Extension.loadOnDemand( this, "split", "tcl.lang.SplitCmd" );
640 Extension.loadOnDemand( this, "string", "tcl.lang.StringCmd" );
641 Extension.loadOnDemand( this, "subst", "tcl.lang.SubstCmd" );
642 Extension.loadOnDemand( this, "switch", "tcl.lang.SwitchCmd" );
643 Extension.loadOnDemand( this, "tell", "tcl.lang.TellCmd" );
644 Extension.loadOnDemand( this, "time", "tcl.lang.TimeCmd" );
645 Extension.loadOnDemand( this, "trace", "tcl.lang.TraceCmd" );
646 Extension.loadOnDemand( this, "unset", "tcl.lang.UnsetCmd" );
647 Extension.loadOnDemand( this, "update", "tcl.lang.UpdateCmd" );
648 Extension.loadOnDemand( this, "uplevel", "tcl.lang.UplevelCmd" );
649 Extension.loadOnDemand( this, "upvar", "tcl.lang.UpvarCmd" );
650 Extension.loadOnDemand( this, "variable", "tcl.lang.VariableCmd" );
651 Extension.loadOnDemand( this, "vwait", "tcl.lang.VwaitCmd" );
652 Extension.loadOnDemand( this, "while", "tcl.lang.WhileCmd" );
653  
654  
655 // Add "regexp" and related commands to this interp.
656 RegexpCmd.init( this );
657  
658  
659 // The Java package is only loaded when the user does a
660 // "package require java" in the interp. We need to create a small
661 // command that will load when "package require java" is called.
662  
663 Extension.loadOnDemand( this, "jaclloadjava", "tcl.lang.JaclLoadJavaCmd" );
664  
665 try
666 {
667 eval( "package ifneeded java 1.3.1 jaclloadjava" );
668 }
669 catch ( TclException e )
670 {
671 System.Diagnostics.Debug.WriteLine( getResult().ToString() );
672 SupportClass.WriteStackTrace( e, Console.Error );
673 throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
674 }
675  
676 }
677 public void setAssocData( string name, AssocData data )
678 // Object associated with the name.
679 {
680 if ( assocData == null )
681 {
682 assocData = new Hashtable();
683 }
684 SupportClass.PutElement( assocData, name, data );
685 }
686 public void deleteAssocData( string name )
687 // Name of association.
688 {
689 if ( assocData == null )
690 {
691 return;
692 }
693  
694 SupportClass.HashtableRemove( assocData, name );
695 }
696 public AssocData getAssocData( string name )
697 // Name of association.
698 {
699 if ( assocData == null )
700 {
701 return null;
702 }
703 else
704 {
705 return (AssocData)assocData[name];
706 }
707 }
708  
709 public void backgroundError()
710 {
711 BgErrorMgr mgr = (BgErrorMgr)getAssocData( "tclBgError" );
712 if ( mgr == null )
713 {
714 mgr = new BgErrorMgr( this );
715 setAssocData( "tclBgError", mgr );
716 }
717 mgr.addBgError();
718 }
719  
720 /*-----------------------------------------------------------------
721 *
722 * VARIABLES
723 *
724 *-----------------------------------------------------------------
725 */
726 public TclObject setVar( TclObject nameObj, TclObject value, TCL.VarFlag flags )
727 {
728 return Var.setVar( this, nameObj, value, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
729 }
730 public TclObject setVar( string name, TclObject value, TCL.VarFlag flags )
731 {
732 return Var.setVar( this, name, value, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
733 }
734 public TclObject setVar( string name1, string name2, TclObject value, TCL.VarFlag flags )
735 {
736 return Var.setVar( this, name1, name2, value, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
737 }
738 public void setVar( string name, string strValue, TCL.VarFlag flags )
739 {
740 Var.setVar( this, name, TclString.newInstance( strValue ), ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
741 }
742 public void setVar( string name1, string name2, string strValue, TCL.VarFlag flags )
743 {
744 Var.setVar( this, name1, name2, TclString.newInstance( strValue ), ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
745 }
746 public TclObject getVar( TclObject nameObj, TCL.VarFlag flags )
747 {
748 return Var.getVar( this, nameObj, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
749 }
750 public TclObject getVar( string name, TCL.VarFlag flags )
751 {
752 return Var.getVar( this, name, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
753 }
754 public TclObject getVar( string name1, string name2, TCL.VarFlag flags )
755 {
756 return Var.getVar( this, name1, name2, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
757 }
758 public void unsetVar( TclObject nameObj, TCL.VarFlag flags )
759 {
760 Var.unsetVar( this, nameObj, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
761 }
762 public void unsetVar( string name, TCL.VarFlag flags )
763 {
764 Var.unsetVar( this, name, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
765 }
766 public void unsetVar( string name1, string name2, TCL.VarFlag flags )
767 {
768 Var.unsetVar( this, name1, name2, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) );
769 }
770 public void traceVar( TclObject nameObj, VarTrace trace, TCL.VarFlag flags )
771 {
772 Var.traceVar( this, nameObj, flags, trace );
773 }
774 public void traceVar( string name, VarTrace trace, TCL.VarFlag flags )
775 {
776 Var.traceVar( this, name, flags, trace );
777 }
778 public void traceVar( string part1, string part2, VarTrace trace, TCL.VarFlag flags )
779 {
780 Var.traceVar( this, part1, part2, flags, trace );
781 }
782 public void untraceVar( TclObject nameObj, VarTrace trace, TCL.VarFlag flags )
783 // OR-ed collection of bits describing current
784 // trace, including any of TCL.VarFlag.TRACE_READS,
785 // TCL.VarFlag.TRACE_WRITES, TCL.VarFlag.TRACE_UNSETS,
786 // TCL.VarFlag.GLOBAL_ONLY and TCL.VarFlag.NAMESPACE_ONLY.
787 {
788 Var.untraceVar( this, nameObj, flags, trace );
789 }
790 public void untraceVar( string name, VarTrace trace, TCL.VarFlag flags )
791 // OR-ed collection of bits describing current
792 // trace, including any of TCL.VarFlag.TRACE_READS,
793 // TCL.VarFlag.TRACE_WRITES, TCL.VarFlag.TRACE_UNSETS,
794 // TCL.VarFlag.GLOBAL_ONLY and TCL.VarFlag.NAMESPACE_ONLY.
795 {
796 Var.untraceVar( this, name, flags, trace );
797 }
798 public void untraceVar( string part1, string part2, VarTrace trace, TCL.VarFlag flags )
799 // OR-ed collection of bits describing current
800 // trace, including any of TCL.VarFlag.TRACE_READS,
801 // TCL.VarFlag.TRACE_WRITES, TCL.VarFlag.TRACE_UNSETS,
802 // TCL.VarFlag.GLOBAL_ONLY and TCL.VarFlag.NAMESPACE_ONLY.
803 {
804 Var.untraceVar( this, part1, part2, flags, trace );
805 }
806 public void createCommand( string cmdName, Command cmdImpl )
807 // Command object to associate with
808 // cmdName.
809 {
810 ImportRef oldRef = null;
811 NamespaceCmd.Namespace ns;
812 WrappedCommand cmd, refCmd;
813 string tail;
814 ImportedCmdData data;
815  
816 if ( deleted )
817 {
818 // The interpreter is being deleted. Don't create any new
819 // commands; it's not safe to muck with the interpreter anymore.
820  
821 return;
822 }
823  
824 // Determine where the command should reside. If its name contains
825 // namespace qualifiers, we put it in the specified namespace;
826 // otherwise, we always put it in the global namespace.
827  
828 if ( cmdName.IndexOf( "::" ) != -1 )
829 {
830 // Java does not support passing an address so we pass
831 // an array of size 1 and then assign arr[0] to the value
832 NamespaceCmd.Namespace[] nsArr = new NamespaceCmd.Namespace[1];
833 NamespaceCmd.Namespace[] dummyArr = new NamespaceCmd.Namespace[1];
834 string[] tailArr = new string[1];
835  
836 NamespaceCmd.getNamespaceForQualName( this, cmdName, null, TCL.VarFlag.CREATE_NS_IF_UNKNOWN, nsArr, dummyArr, dummyArr, tailArr );
837  
838 ns = nsArr[0];
839 tail = tailArr[0];
840  
841 if ( ( ns == null ) || ( (System.Object)tail == null ) )
842 {
843 return;
844 }
845 }
846 else
847 {
848 ns = globalNs;
849 tail = cmdName;
850 }
851  
852 cmd = (WrappedCommand)ns.cmdTable[tail];
853 if ( cmd != null )
854 {
855 // Command already exists. Delete the old one.
856 // Be careful to preserve any existing import links so we can
857 // restore them down below. That way, you can redefine a
858 // command and its import status will remain intact.
859  
860 oldRef = cmd.importRef;
861 cmd.importRef = null;
862  
863 deleteCommandFromToken( cmd );
864  
865 // FIXME : create a test case for this condition!
866  
867 cmd = (WrappedCommand)ns.cmdTable[tail];
868 if ( cmd != null )
869 {
870 // If the deletion callback recreated the command, just throw
871 // away the new command (if we try to delete it again, we
872 // could get stuck in an infinite loop).
873  
874 SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
875 }
876 }
877  
878 cmd = new WrappedCommand();
879 ns.cmdTable.Add( tail, cmd );
880 cmd.table = ns.cmdTable;
881 cmd.hashKey = tail;
882 cmd.ns = ns;
883 cmd.cmd = cmdImpl;
884 cmd.deleted = false;
885 // FIXME : import feature not implemented
886 //cmd.importRef = null;
887  
888 // Plug in any existing import references found above. Be sure
889 // to update all of these references to point to the new command.
890  
891 if ( oldRef != null )
892 {
893 cmd.importRef = oldRef;
894 while ( oldRef != null )
895 {
896 refCmd = oldRef.importedCmd;
897 data = (ImportedCmdData)refCmd.cmd;
898 data.realCmd = cmd;
899 oldRef = oldRef.next;
900 }
901 }
902  
903 // There are no shadowed commands in Jacl because they are only
904 // used in the 8.0 compiler
905  
906 return;
907 }
908 /*
909 *----------------------------------------------------------------------
910 *
911 * Tcl_CreateObjCommand --
912 *
913 * Define a new object-based command in a command table.
914 *
915 * Results:
916 * The return value is a token for the command, which can
917 * be used in future calls to Tcl_GetCommandName.
918 *
919 * Side effects:
920 * If no command named "cmdName" already exists for interp, one is
921 * created. Otherwise, if a command does exist, then if the
922 * object-based Tcl_ObjCmdProc is TclInvokeStringCommand, we assume
923 * Tcl_CreateCommand was called previously for the same command and
924 * just set its Tcl_ObjCmdProc to the argument "proc"; otherwise, we
925 * delete the old command.
926 *
927 * In the future, during bytecode evaluation when "cmdName" is seen as
928 * the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
929 * Tcl_ObjCmdProc proc will be called. When the command is deleted from
930 * the table, deleteProc will be called. See the manual entry for
931 * details on the calling sequence.
932 *
933 *----------------------------------------------------------------------
934 */
935  
936 public delegate int dxObjCmdProc( object clientData, Interp interp, int argc, TclObject[] argv );
937 public delegate void dxCmdDeleteProc( ref object clientData );
938  
939 public void createObjCommand( string cmdName, dxObjCmdProc proc, object clientData, dxCmdDeleteProc deleteProc )
940 // Command object to associate with cmdName.
941 {
942 ImportRef oldRef = null;
943 NamespaceCmd.Namespace ns;
944 WrappedCommand cmd, refCmd;
945 string tail;
946 ImportedCmdData data;
947 int _new;
948  
949 if ( deleted )
950 {
951 // The interpreter is being deleted. Don't create any new
952 // commands; it's not safe to muck with the interpreter anymore.
953  
954 return;
955 }
956  
957 // Determine where the command should reside. If its name contains
958 // namespace qualifiers, we put it in the specified namespace;
959 // otherwise, we always put it in the global namespace.
960  
961 if ( cmdName.IndexOf( "::" ) != -1 )
962 {
963 // Java does not support passing an address so we pass
964 // an array of size 1 and then assign arr[0] to the value
965 NamespaceCmd.Namespace[] nsArr = new NamespaceCmd.Namespace[1];
966 NamespaceCmd.Namespace[] dummyArr = new NamespaceCmd.Namespace[1];
967 string[] tailArr = new string[1];
968  
969 NamespaceCmd.getNamespaceForQualName( this, cmdName, null, TCL.VarFlag.CREATE_NS_IF_UNKNOWN, nsArr, dummyArr, dummyArr, tailArr );
970  
971 ns = nsArr[0];
972 tail = tailArr[0];
973  
974 if ( ( ns == null ) || ( (System.Object)tail == null ) )
975 {
976 return;
977 }
978 }
979 else
980 {
981 ns = globalNs;
982 tail = cmdName;
983 }
984  
985 cmd = (WrappedCommand)ns.cmdTable[tail];
986 if ( cmd != null )
987 {
988 /*
989 * Command already exists. If its object-based Tcl_ObjCmdProc is
990 * TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the
991 * argument "proc". Otherwise, we delete the old command.
992 */
993 if ( cmd.objProc != null && cmd.objProc.GetType().Name == "TclInvokeStringCommand" )
994 {
995 cmd.objProc = proc;
996 cmd.objClientData = clientData;
997 cmd.deleteProc = deleteProc;
998 cmd.deleteData = clientData;
999 return;
1000 }
1001 /*
1002 * Otherwise, we delete the old command. Be careful to preserve
1003 * any existing import links so we can restore them down below.
1004 * That way, you can redefine a command and its import status
1005 * will remain intact.
1006 */
1007 oldRef = cmd.importRef;
1008 cmd.importRef = null;
1009  
1010 deleteCommandFromToken( cmd );
1011  
1012 // FIXME : create a test case for this condition!
1013  
1014 cmd = (WrappedCommand)ns.cmdTable[tail];
1015 if ( cmd != null )
1016 {
1017 // If the deletion callback recreated the command, just throw
1018 // away the new command (if we try to delete it again, we
1019 // could get stuck in an infinite loop).
1020  
1021 SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
1022 }
1023 }
1024  
1025 cmd = new WrappedCommand();
1026 ns.cmdTable.Add( tail, cmd );
1027 cmd.table = ns.cmdTable;
1028 cmd.hashKey = tail;
1029 cmd.ns = ns;
1030 cmd.cmd = null;
1031 cmd.deleted = false;
1032 // FIXME : import feature not implemented
1033 //cmd.importRef = null;
1034  
1035 // TODO -- Determine if this is all correct
1036 cmd.objProc = proc;
1037 cmd.objClientData = clientData;
1038 //cmd.proc = TclInvokeObjectCommand;
1039 cmd.clientData = (object)cmd;
1040 cmd.deleteProc = deleteProc;
1041 cmd.deleteData = clientData;
1042 cmd.flags = 0;
1043  
1044  
1045 // Plug in any existing import references found above. Be sure
1046 // to update all of these references to point to the new command.
1047  
1048 if ( oldRef != null )
1049 {
1050 cmd.importRef = oldRef;
1051 while ( oldRef != null )
1052 {
1053 refCmd = oldRef.importedCmd;
1054 data = (ImportedCmdData)refCmd.cmd;
1055 data.realCmd = cmd;
1056 oldRef = oldRef.next;
1057 }
1058 }
1059  
1060 // There are no shadowed commands in Jacl because they are only
1061 // used in the 8.0 compiler
1062  
1063 return;
1064 }
1065 internal string getCommandFullName( WrappedCommand cmd )
1066 // Token for the command.
1067 {
1068 Interp interp = this;
1069 StringBuilder name = new StringBuilder();
1070  
1071 // Add the full name of the containing namespace, followed by the "::"
1072 // separator, and the command name.
1073  
1074 if ( cmd != null )
1075 {
1076 if ( cmd.ns != null )
1077 {
1078 name.Append( cmd.ns.fullName );
1079 if ( cmd.ns != interp.globalNs )
1080 {
1081 name.Append( "::" );
1082 }
1083 }
1084 if ( cmd.table != null )
1085 {
1086 name.Append( cmd.hashKey );
1087 }
1088 }
1089  
1090 return name.ToString();
1091 }
1092 public int deleteCommand( string cmdName )
1093 // Name of command to remove.
1094 {
1095 WrappedCommand cmd;
1096  
1097 // Find the desired command and delete it.
1098  
1099 try
1100 {
1101 cmd = NamespaceCmd.findCommand( this, cmdName, null, 0 );
1102 }
1103 catch ( TclException e )
1104 {
1105 throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
1106 }
1107 if ( cmd == null )
1108 {
1109 return -1;
1110 }
1111 if ( cmd.deleteProc != null )
1112 cmd.deleteProc( ref cmd.deleteData );
1113 return deleteCommandFromToken( cmd );
1114 }
1115 protected internal int deleteCommandFromToken( WrappedCommand cmd )
1116 // Wrapper Token for command to delete.
1117 {
1118 if ( cmd == null )
1119 {
1120 return -1;
1121 }
1122  
1123 ImportRef ref_Renamed, nextRef;
1124 WrappedCommand importCmd;
1125  
1126 // The code here is tricky. We can't delete the hash table entry
1127 // before invoking the deletion callback because there are cases
1128 // where the deletion callback needs to invoke the command (e.g.
1129 // object systems such as OTcl). However, this means that the
1130 // callback could try to delete or rename the command. The deleted
1131 // flag allows us to detect these cases and skip nested deletes.
1132  
1133 if ( cmd.deleted )
1134 {
1135 // Another deletion is already in progress. Remove the hash
1136 // table entry now, but don't invoke a callback or free the
1137 // command structure.
1138  
1139 if ( (System.Object)cmd.hashKey != null && cmd.table != null )
1140 {
1141 SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
1142 cmd.table = null;
1143 cmd.hashKey = null;
1144 }
1145 return 0;
1146 }
1147  
1148 cmd.deleted = true;
1149 if ( cmd.cmd is CommandWithDispose )
1150 {
1151 ( (CommandWithDispose)cmd.cmd ).disposeCmd();
1152 }
1153 if ( cmd.deleteProc != null )
1154 {
1155 cmd.deleteProc( ref cmd.objClientData );
1156 }
1157 // If this command was imported into other namespaces, then imported
1158 // commands were created that refer back to this command. Delete these
1159 // imported commands now.
1160  
1161 for ( ref_Renamed = cmd.importRef; ref_Renamed != null; ref_Renamed = nextRef )
1162 {
1163 nextRef = ref_Renamed.next;
1164 importCmd = ref_Renamed.importedCmd;
1165 deleteCommandFromToken( importCmd );
1166 }
1167  
1168 // FIXME : what does this mean? Is this a mistake in the C comment?
1169  
1170 // Don't use hPtr to delete the hash entry here, because it's
1171 // possible that the deletion callback renamed the command.
1172 // Instead, use cmdPtr->hptr, and make sure that no-one else
1173 // has already deleted the hash entry.
1174  
1175 if ( cmd.table != null )
1176 {
1177 SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
1178 cmd.table = null;
1179 cmd.hashKey = null;
1180 }
1181  
1182 // Drop the reference to the Command instance inside the WrappedCommand
1183  
1184 cmd.cmd = null;
1185  
1186 // We do not need to cleanup the WrappedCommand because GC will get it.
1187  
1188 return 0;
1189 }
1190 protected internal void renameCommand( string oldName, string newName )
1191 {
1192 Interp interp = this;
1193 string newTail;
1194 NamespaceCmd.Namespace cmdNs, newNs;
1195 WrappedCommand cmd;
1196 Hashtable table, oldTable;
1197 string hashKey, oldHashKey;
1198  
1199 // Find the existing command. An error is returned if cmdName can't
1200 // be found.
1201  
1202 cmd = NamespaceCmd.findCommand( interp, oldName, null, 0 );
1203 if ( cmd == null )
1204 {
1205 throw new TclException( interp, "can't " + ( ( ( (System.Object)newName == null ) || ( newName.Length == 0 ) ) ? "delete" : "rename" ) + " \"" + oldName + "\": command doesn't exist" );
1206 }
1207 cmdNs = cmd.ns;
1208  
1209 // If the new command name is NULL or empty, delete the command. Do this
1210 // with Tcl_DeleteCommandFromToken, since we already have the command.
1211  
1212 if ( ( (System.Object)newName == null ) || ( newName.Length == 0 ) )
1213 {
1214 deleteCommandFromToken( cmd );
1215 return;
1216 }
1217  
1218 // Make sure that the destination command does not already exist.
1219 // The rename operation is like creating a command, so we should
1220 // automatically create the containing namespaces just like
1221 // Tcl_CreateCommand would.
1222  
1223 NamespaceCmd.Namespace[] newNsArr = new NamespaceCmd.Namespace[1];
1224 NamespaceCmd.Namespace[] dummyArr = new NamespaceCmd.Namespace[1];
1225 string[] newTailArr = new string[1];
1226  
1227 NamespaceCmd.getNamespaceForQualName( interp, newName, null, TCL.VarFlag.CREATE_NS_IF_UNKNOWN, newNsArr, dummyArr, dummyArr, newTailArr );
1228  
1229 newNs = newNsArr[0];
1230 newTail = newTailArr[0];
1231  
1232 if ( ( newNs == null ) || ( (System.Object)newTail == null ) )
1233 {
1234 throw new TclException( interp, "can't rename to \"" + newName + "\": bad command name" );
1235 }
1236 if ( newNs.cmdTable[newTail] != null )
1237 {
1238 throw new TclException( interp, "can't rename to \"" + newName + "\": command already exists" );
1239 }
1240  
1241 // Warning: any changes done in the code here are likely
1242 // to be needed in Tcl_HideCommand() code too.
1243 // (until the common parts are extracted out) --dl
1244  
1245 // Put the command in the new namespace so we can check for an alias
1246 // loop. Since we are adding a new command to a namespace, we must
1247 // handle any shadowing of the global commands that this might create.
1248  
1249 oldTable = cmd.table;
1250 oldHashKey = cmd.hashKey;
1251 newNs.cmdTable.Add( newTail, cmd );
1252 cmd.table = newNs.cmdTable;
1253 cmd.hashKey = newTail;
1254 cmd.ns = newNs;
1255  
1256 // FIXME : this is a nasty hack that fixes renaming for Procedures
1257 // that move from one namespace to another, but the real problem
1258 // is that a rename does not work for Command instances in general
1259  
1260 if ( cmd.cmd is Procedure )
1261 {
1262 Procedure p = (Procedure)cmd.cmd;
1263 p.ns = cmd.ns;
1264 }
1265  
1266 // Now check for an alias loop. If we detect one, put everything back
1267 // the way it was and report the error.
1268  
1269 try
1270 {
1271 interp.preventAliasLoop( interp, cmd );
1272 }
1273 catch ( TclException e )
1274 {
1275 newNs.cmdTable.Remove( newTail );
1276 cmd.table = oldTable;
1277 cmd.hashKey = oldHashKey;
1278 cmd.ns = cmdNs;
1279 throw;
1280 }
1281  
1282 // The new command name is okay, so remove the command from its
1283 // current namespace. This is like deleting the command, so bump
1284 // the cmdEpoch to invalidate any cached references to the command.
1285  
1286 SupportClass.HashtableRemove( oldTable, oldHashKey );
1287  
1288 return;
1289 }
1290 internal void preventAliasLoop( Interp cmdInterp, WrappedCommand cmd )
1291 {
1292 // If we are not creating or renaming an alias, then it is
1293 // always OK to create or rename the command.
1294  
1295 if ( !( cmd.cmd is InterpAliasCmd ) )
1296 {
1297 return;
1298 }
1299  
1300 // OK, we are dealing with an alias, so traverse the chain of aliases.
1301 // If we encounter the alias we are defining (or renaming to) any in
1302 // the chain then we have a loop.
1303  
1304 InterpAliasCmd alias = (InterpAliasCmd)cmd.cmd;
1305 InterpAliasCmd nextAlias = alias;
1306 while ( true )
1307 {
1308  
1309 // If the target of the next alias in the chain is the same as
1310 // the source alias, we have a loop.
1311  
1312 WrappedCommand aliasCmd = nextAlias.getTargetCmd( this );
1313 if ( aliasCmd == null )
1314 {
1315 return;
1316 }
1317 if ( aliasCmd.cmd == cmd.cmd )
1318 {
1319  
1320 throw new TclException( this, "cannot define or rename alias \"" + alias.name + "\": would create a loop" );
1321 }
1322  
1323 // Otherwise, follow the chain one step further. See if the target
1324 // command is an alias - if so, follow the loop to its target
1325 // command. Otherwise we do not have a loop.
1326  
1327 if ( !( aliasCmd.cmd is InterpAliasCmd ) )
1328 {
1329 return;
1330 }
1331 nextAlias = (InterpAliasCmd)aliasCmd.cmd;
1332 }
1333 }
1334 public Command getCommand( string cmdName )
1335 // String name of the command.
1336 {
1337 // Find the desired command and return it.
1338  
1339 WrappedCommand cmd;
1340  
1341 try
1342 {
1343 cmd = NamespaceCmd.findCommand( this, cmdName, null, 0 );
1344 }
1345 catch ( TclException e )
1346 {
1347 throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
1348 }
1349  
1350 return ( ( cmd == null ) ? null : cmd.cmd );
1351 }
1352 public WrappedCommand getObjCommand( string cmdName )
1353 // String name of the command.
1354 {
1355 // Find the desired command and return it.
1356  
1357 WrappedCommand cmd;
1358  
1359 try
1360 {
1361 cmd = NamespaceCmd.findCommand( this, cmdName, null, 0 );
1362 }
1363 catch ( TclException e )
1364 {
1365 throw new TclRuntimeError( "unexpected TclException: " + e.Message, e );
1366 }
1367  
1368 return ( ( cmd == null ) ? null : cmd );
1369 }
1370 public static bool commandComplete( string inString )
1371 // The string to check.
1372 {
1373 return Parser.commandComplete( inString, inString.Length );
1374 }
1375  
1376  
1377 /*-----------------------------------------------------------------
1378 *
1379 * EVAL
1380 *
1381 *-----------------------------------------------------------------
1382 */
1383  
1384 public TclObject getResult()
1385 {
1386 return m_result;
1387 }
1388 public void setResult( TclObject r )
1389 // A Tcl Object to be set as the result.
1390 {
1391 if ( r == null )
1392 {
1393 throw new System.NullReferenceException( "Interp.setResult() called with null TclObject argument." );
1394 }
1395  
1396 if ( r == m_result )
1397 {
1398 // Setting to current value (including m_nullResult) is a no-op.
1399 return;
1400 }
1401  
1402 if ( m_result != m_nullResult )
1403 {
1404 m_result.release();
1405 }
1406  
1407 m_result = r;
1408  
1409 if ( m_result != m_nullResult )
1410 {
1411 m_result.preserve();
1412 }
1413 }
1414 public void setResult( string r )
1415 // A string result.
1416 {
1417 if ( (System.Object)r == null )
1418 {
1419 resetResult();
1420 }
1421 else
1422 {
1423 setResult( TclString.newInstance( r ) );
1424 }
1425 }
1426 public void setResult( int r )
1427 // An int result.
1428 {
1429 setResult( TclInteger.newInstance( r ) );
1430 }
1431 public void setResult( double r )
1432 // A double result.
1433 {
1434 setResult( TclDouble.newInstance( r ) );
1435 }
1436 public void setResult( bool r )
1437 // A boolean result.
1438 {
1439 setResult( TclBoolean.newInstance( r ) );
1440 }
1441 public void resetResult()
1442 {
1443 if ( m_result != m_nullResult )
1444 {
1445 m_result.release();
1446 m_result = TclString.newInstance( "" ); //m_nullResult;
1447 m_result.preserve();
1448 if ( !m_nullResult.Shared )
1449 {
1450 throw new TclRuntimeError( "m_nullResult is not shared" );
1451 }
1452 }
1453 errAlreadyLogged = false;
1454 errInProgress = false;
1455 errCodeSet = false;
1456 returnCode = TCL.CompletionCode.OK;
1457 }
1458 public void appendElement( object Element )
1459 {
1460 TclObject result;
1461  
1462 result = getResult();
1463 if ( result.Shared )
1464 {
1465 result = result.duplicate();
1466 }
1467 TclList.append( this, result, TclObj.newInstance( Element ) );
1468 setResult( result );
1469 }
1470  
1471 public void appendElement(
1472 string Element )
1473 {
1474 TclObject result;
1475  
1476 result = getResult();
1477 if ( result.Shared )
1478 {
1479 result = result.duplicate();
1480 }
1481 TclList.append( this, result, TclString.newInstance( Element ) );
1482 setResult( result );
1483 }
1484 public void eval( string inString, int flags )
1485 {
1486 int evalFlags = this.evalFlags;
1487 this.evalFlags &= ~Parser.TCL_ALLOW_EXCEPTIONS;
1488  
1489 CharPointer script = new CharPointer( inString );
1490 try
1491 {
1492 Parser.eval2( this, script.array, script.index, script.length(), flags );
1493 }
1494 catch ( TclException e )
1495 {
1496  
1497 if ( nestLevel != 0 )
1498 {
1499 throw;
1500 }
1501  
1502 // Update the interpreter's evaluation level count. If we are again at
1503 // the top level, process any unusual return code returned by the
1504 // evaluated code. Note that we don't propagate an exception that
1505 // has a TCL.CompletionCode.RETURN error code when updateReturnInfo() returns TCL.CompletionCode.OK.
1506  
1507 TCL.CompletionCode result = e.getCompletionCode();
1508  
1509 if ( result == TCL.CompletionCode.RETURN )
1510 {
1511 result = updateReturnInfo();
1512 }
1513 if ( result != TCL.CompletionCode.EXIT && result != TCL.CompletionCode.OK && result != TCL.CompletionCode.ERROR && ( evalFlags & Parser.TCL_ALLOW_EXCEPTIONS ) == 0 )
1514 {
1515 processUnexpectedResult( result );
1516 }
1517 if ( result != TCL.CompletionCode.OK )
1518 {
1519 e.setCompletionCode( result );
1520 throw;
1521 }
1522 }
1523 }
1524 public void eval( string script )
1525 {
1526 eval( script, 0 );
1527 }
1528 public void eval( TclObject tobj, int flags )
1529 {
1530  
1531 eval( tobj.ToString(), flags );
1532 }
1533 public void recordAndEval( TclObject script, int flags )
1534 {
1535 // Append the script to the event list by calling "history add <script>".
1536 // We call the eval method with the command of type TclObject, so that
1537 // we don't have to deal with funny chars ("{}[]$\) in the script.
1538  
1539 TclObject cmd = null;
1540 try
1541 {
1542 cmd = TclList.newInstance();
1543 TclList.append( this, cmd, TclString.newInstance( "history" ) );
1544 TclList.append( this, cmd, TclString.newInstance( "add" ) );
1545 TclList.append( this, cmd, script );
1546 cmd.preserve();
1547 eval( cmd, TCL.EVAL_GLOBAL );
1548 }
1549 catch ( System.Exception e )
1550 {
1551 }
1552 finally
1553 {
1554 cmd.release();
1555 }
1556  
1557 // Execute the command.
1558  
1559 if ( ( flags & TCL.NO_EVAL ) == 0 )
1560 {
1561 eval( script, flags & TCL.EVAL_GLOBAL );
1562 }
1563 }
1564 public void evalFile( string sFilename )
1565 {
1566 string fileContent; // Contains the content of the file.
1567  
1568 fileContent = readScriptFromFile( sFilename );
1569  
1570 if ( (System.Object)fileContent == null )
1571 {
1572 throw new TclException( this, "couldn't read file \"" + sFilename + "\"" );
1573 }
1574  
1575 string oldScript = scriptFile;
1576 scriptFile = sFilename;
1577  
1578 try
1579 {
1580 pushDebugStack( sFilename, 1 );
1581 eval( fileContent, 0 );
1582 }
1583 catch ( TclException e )
1584 {
1585 if ( e.getCompletionCode() == TCL.CompletionCode.ERROR )
1586 {
1587 addErrorInfo( "\n (file \"" + sFilename + "\" line " + errorLine + ")" );
1588 }
1589 throw;
1590 }
1591 finally
1592 {
1593 scriptFile = oldScript;
1594 popDebugStack();
1595 }
1596 }
1597 internal void evalURL( System.Uri context, string s )
1598 {
1599 string fileContent; // Contains the content of the file.
1600  
1601 fileContent = readScriptFromURL( context, s );
1602 if ( (System.Object)fileContent == null )
1603 {
1604 throw new TclException( this, "cannot read URL \"" + s + "\"" );
1605 }
1606  
1607 string oldScript = scriptFile;
1608 scriptFile = s;
1609  
1610 try
1611 {
1612 eval( fileContent, 0 );
1613 }
1614 finally
1615 {
1616 scriptFile = oldScript;
1617 }
1618 }
1619 private string readScriptFromFile( string sFilename )
1620 // The name of the file.
1621 {
1622 FileInfo sourceFile;
1623 StreamReader fs;
1624 try
1625 {
1626 sourceFile = FileUtil.getNewFileObj( this, sFilename );
1627 }
1628 catch ( TclException e )
1629 {
1630 resetResult();
1631 return null;
1632 }
1633 catch ( FileNotFoundException e )
1634 {
1635 return null;
1636 }
1637 catch ( System.Security.SecurityException sec_e )
1638 {
1639 return null;
1640 }
1641 try
1642 {
1643 // HACK only UTF8 will be read
1644 using ( fs = new StreamReader( sourceFile.FullName, System.Text.Encoding.UTF8 ) )
1645 {
1646 // read all an do the new line conversations
1647 return fs.ReadToEnd().Replace( "\r\n", "\n" );
1648 }
1649 }
1650 catch ( IOException )
1651 {
1652 return null;
1653 }
1654 }
1655 private string readScriptFromURL( System.Uri context, string s )
1656 {
1657 Object content = null;
1658 System.Uri url;
1659  
1660 try
1661 {
1662 url = new System.Uri( context, s );
1663 }
1664 catch ( System.UriFormatException e )
1665 {
1666 return null;
1667 }
1668  
1669 try
1670 {
1671  
1672 // ATK content = url.getContent();
1673 content = url.ToString();
1674 }
1675 catch ( System.Exception e )
1676 {
1677 Type jar_class;
1678  
1679 try
1680 {
1681 jar_class = System.Type.GetType( "java.net.JarURLConnection" );
1682 }
1683 catch ( System.Exception e2 )
1684 {
1685 return null;
1686 }
1687  
1688 Object jar;
1689 try
1690 {
1691 jar = (System.Net.HttpWebRequest)System.Net.WebRequest.Create( url );
1692 }
1693 catch ( IOException e2 )
1694 {
1695 return null;
1696 }
1697  
1698 if ( jar == null )
1699 {
1700 return null;
1701 }
1702  
1703 // We must call JarURLConnection.getInputStream() dynamically
1704 // Because the class JarURLConnection does not exist in JDK1.1
1705  
1706 try
1707 {
1708 System.Reflection.MethodInfo m = jar_class.GetMethod( "openConnection", (System.Type[])null );
1709 content = m.Invoke( jar, (System.Object[])null );
1710 }
1711 catch ( System.Exception e2 )
1712 {
1713 return null;
1714 }
1715 }
1716 // HACK
1717 // catch (IOException e)
1718 // {
1719 // return null;
1720 // }
1721 // catch (System.Security.SecurityException e)
1722 // {
1723 // return null;
1724 // }
1725  
1726 if ( content is string )
1727 {
1728 return (string)content;
1729 }
1730 else if ( content is Stream )
1731 {
1732 // FIXME : use custom stream handler
1733 Stream fs = (Stream)content;
1734  
1735 try
1736 {
1737 // FIXME : read does not check return values
1738 long available;
1739 available = fs.Length - fs.Position;
1740 byte[] charArray = new byte[(int)available];
1741 SupportClass.ReadInput( fs, ref charArray, 0, charArray.Length );
1742 return new string( SupportClass.ToCharArray( charArray ) );
1743 }
1744 catch ( IOException e2 )
1745 {
1746 return null;
1747 }
1748 finally
1749 {
1750 closeInputStream( fs );
1751 }
1752 }
1753 else
1754 {
1755 return null;
1756 }
1757 }
1758 private void closeInputStream( Stream fs )
1759 {
1760 try
1761 {
1762 fs.Close();
1763 }
1764 catch ( IOException e )
1765 {
1766 ;
1767 }
1768 }
1769 internal void evalResource( string resName )
1770 {
1771 // Stream stream = null;
1772 //
1773 // try
1774 // {
1775 //
1776 // stream = typeof(Interp).getResourceAsStream(resName);
1777 // }
1778 // catch (System.Security.SecurityException e2)
1779 // {
1780 // // This catch is necessary if Jacl is to work in an applet
1781 // // at all. Note that java::new will not work from within Jacl
1782 // // in an applet.
1783 //
1784 // System.Console.Error.WriteLine("evalResource: Ignoring SecurityException, " + "it is likely we are running in an applet: " + "cannot read resource \"" + resName + "\"" + e2);
1785 //
1786 // return ;
1787 // }
1788 //
1789 // if (stream == null)
1790 // {
1791 // throw new TclException(this, "cannot read resource \"" + resName + "\"");
1792 // }
1793 //
1794 // try
1795 // {
1796 // // FIXME : ugly JDK 1.2 only hack
1797 // // Ugly workaround for compressed files BUG in JDK1.2
1798 // // this bug first showed up in JDK1.2beta4. I have sent
1799 // // a number of emails to Sun but they have deemed this a "feature"
1800 // // of 1.2. This is flat out wrong but I do not seem to change thier
1801 // // minds. Because of this, there is no way to do non blocking IO
1802 // // on a compressed Stream in Java. (mo)
1803 //
1804 //
1805 // if (System_Renamed.getProperty("java.version").StartsWith("1.2") && stream.GetType().FullName.Equals("java.util.zip.ZipFile$1"))
1806 // {
1807 //
1808 MemoryStream baos = new MemoryStream( 1024 );
1809 byte[] buffer = new byte[1024];
1810 // int numRead;
1811 //
1812 // // Read all data from the stream into a resizable buffer
1813 // while ((numRead = SupportClass.ReadInput(stream, ref buffer, 0, buffer.Length)) != - 1)
1814 // {
1815 // baos.Write(SupportClass.ToByteArray(buffer), 0, numRead);
1816 // }
1817 //
1818 // // Convert bytes into a String and eval them
1819 // eval(new string(SupportClass.ToCharArray(SupportClass.ToByteArray(SupportClass.ToSByteArray(baos.ToArray())))), 0);
1820 // }
1821 // else
1822 // {
1823 // // Other systems do not need the compressed jar hack
1824 //
1825 // long available;
1826 // available = stream.Length - stream.Position;
1827 // int num = (int) available;
1828 // byte[] byteArray = new byte[num];
1829 // int offset = 0;
1830 // while (num > 0)
1831 // {
1832 // int readLen = SupportClass.ReadInput(stream, ref byteArray, offset, num);
1833 // offset += readLen;
1834 // num -= readLen;
1835 // }
1836 //
1837 // eval(new string(SupportClass.ToCharArray(SupportClass.ToByteArray(byteArray))), 0);
1838 // }
1839 // }
1840 // catch (IOException e)
1841 // {
1842 // return ;
1843 // }
1844 // finally
1845 // {
1846 // closeInputStream(stream);
1847 // }
1848 }
1849 internal static BackSlashResult backslash( string s, int i, int len )
1850 {
1851 CharPointer script = new CharPointer( s.Substring( 0, ( len ) - ( 0 ) ) );
1852 script.index = i;
1853 return Parser.backslash( script.array, script.index );
1854 }
1855  
1856  
1857 public void setErrorCode( TclObject code )
1858 // The errorCode object.
1859 {
1860 try
1861 {
1862 setVar( "errorCode", null, code, TCL.VarFlag.GLOBAL_ONLY );
1863 errCodeSet = true;
1864 }
1865 catch ( TclException excp )
1866 {
1867 // Ignore any TclException's, possibly caused by variable traces on
1868 // the errorCode variable. This is compatible with the behavior of
1869 // the Tcl C API.
1870 }
1871 }
1872  
1873  
1874 public void addErrorInfo( string message )
1875 // The message to record.
1876 {
1877 if ( !errInProgress )
1878 {
1879 errInProgress = true;
1880  
1881 try
1882 {
1883  
1884 setVar( "errorInfo", null, getResult().ToString(), TCL.VarFlag.GLOBAL_ONLY );
1885 }
1886 catch ( TclException e1 )
1887 {
1888 // Ignore (see try-block above).
1889 }
1890  
1891 // If the errorCode variable wasn't set by the code
1892 // that generated the error, set it to "NONE".
1893  
1894 if ( !errCodeSet )
1895 {
1896 try
1897 {
1898 setVar( "errorCode", null, "NONE", TCL.VarFlag.GLOBAL_ONLY );
1899 }
1900 catch ( TclException e1 )
1901 {
1902 // Ignore (see try-block above).
1903 }
1904 }
1905 }
1906  
1907 try
1908 {
1909 setVar( "errorInfo", null, message, TCL.VarFlag.APPEND_VALUE | TCL.VarFlag.GLOBAL_ONLY );
1910 }
1911 catch ( TclException e1 )
1912 {
1913 // Ignore (see try-block above).
1914 }
1915 }
1916 internal void processUnexpectedResult( TCL.CompletionCode returnCode )
1917 {
1918 resetResult();
1919 if ( returnCode == TCL.CompletionCode.BREAK )
1920 {
1921 throw new TclException( this, "invoked \"break\" outside of a loop" );
1922 }
1923 else if ( returnCode == TCL.CompletionCode.CONTINUE )
1924 {
1925 throw new TclException( this, "invoked \"continue\" outside of a loop" );
1926 }
1927 else
1928 {
1929 throw new TclException( this, "command returned bad code: " + returnCode );
1930 }
1931 }
1932 public TCL.CompletionCode updateReturnInfo()
1933 {
1934 TCL.CompletionCode code;
1935  
1936 code = returnCode;
1937 returnCode = TCL.CompletionCode.OK;
1938  
1939 if ( code == TCL.CompletionCode.ERROR )
1940 {
1941 try
1942 {
1943 setVar( "errorCode", null, ( (System.Object)errorCode != null ) ? errorCode : "NONE", TCL.VarFlag.GLOBAL_ONLY );
1944 }
1945 catch ( TclException e )
1946 {
1947 // An error may happen during a trace to errorCode. We ignore it.
1948 // This may leave error messages inside Interp.result (which
1949 // is compatible with Tcl 8.0 behavior.
1950 }
1951 errCodeSet = true;
1952  
1953 if ( (System.Object)errorInfo != null )
1954 {
1955 try
1956 {
1957 setVar( "errorInfo", null, errorInfo, TCL.VarFlag.GLOBAL_ONLY );
1958 }
1959 catch ( TclException e )
1960 {
1961 // An error may happen during a trace to errorInfo. We
1962 // ignore it. This may leave error messages inside
1963 // Interp.result (which is compatible with Tcl 8.0
1964 // behavior.
1965 }
1966 errInProgress = true;
1967 }
1968 }
1969  
1970 return code;
1971 }
1972 protected internal CallFrame newCallFrame( Procedure proc, TclObject[] objv )
1973 {
1974 return new CallFrame( this, proc, objv );
1975 }
1976 protected internal CallFrame newCallFrame()
1977 {
1978 return new CallFrame( this );
1979 }
1980 internal FileInfo getWorkingDir()
1981 {
1982 if ( workingDir == null )
1983 {
1984 try
1985 {
1986  
1987 string dirName = getVar( "env", "HOME", 0 ).ToString();
1988 workingDir = FileUtil.getNewFileObj( this, dirName );
1989 }
1990 catch ( TclException e )
1991 {
1992 resetResult();
1993 }
1994 workingDir = new FileInfo( Util.tryGetSystemProperty( "user.home", "." ) );
1995 }
1996 return workingDir;
1997 }
1998 internal void setWorkingDir( string dirName )
1999 {
2000 FileInfo dirObj = FileUtil.getNewFileObj( this, dirName );
2001  
2002 // Use the canonical name of the path, if possible.
2003  
2004 try
2005 {
2006 dirObj = new FileInfo( dirObj.FullName );
2007 }
2008 catch ( IOException e )
2009 {
2010 }
2011  
2012  
2013 if ( Directory.Exists( dirObj.FullName ) )
2014 {
2015 workingDir = dirObj;
2016 }
2017 else
2018 {
2019 throw new TclException( this, "couldn't change working directory to \"" + dirObj.Name + "\": no such file or directory" );
2020 }
2021 }
2022  
2023 public Notifier getNotifier()
2024 {
2025 return notifier;
2026 }
2027 public void pkgProvide( string name, string version )
2028 {
2029 PackageCmd.pkgProvide( this, name, version );
2030 }
2031 public string pkgRequire( string pkgname, string version, bool exact )
2032 {
2033 return PackageCmd.pkgRequire( this, pkgname, version, exact );
2034 }
2035  
2036 /*
2037 * Debugging API.
2038 *
2039 * The following section defines two debugging API functions for
2040 * logging information about the point of execution of Tcl scripts:
2041 *
2042 * - pushDebugStack() is called when a procedure body is
2043 * executed, or when a file is source'd.
2044 * - popDebugStack() is called when the flow of control is about
2045 * to return from a procedure body, or from a source'd file.
2046 *
2047 * Two other API functions are used to determine the current point of
2048 * execution:
2049 *
2050 * - getScriptFile() returns the script file current being executed.
2051 * - getArgLineNumber(i) returns the line number of the i-th argument
2052 * of the current command.
2053 *
2054 * Note: The point of execution is automatically maintained for
2055 * control structures such as while, if, for and foreach,
2056 * as long as they use Interp.eval(argv[?]) to evaluate control
2057 * blocks.
2058 *
2059 * The case and switch commands need to set dbg.cmdLine explicitly
2060 * because they may evaluate control blocks that are not elements
2061 * inside the argv[] array. ** This feature not yet implemented. **
2062 *
2063 * The proc command needs to call getScriptFile() and
2064 * getArgLineNumber(3) to find out the location of the proc
2065 * body.
2066 *
2067 * The debugging API functions in the Interp class are just dummy stub
2068 * functions. These functions are usually implemented in a subclass of
2069 * Interp (e.g. DbgInterp) that has real debugging support.
2070 *
2071 */
2072  
2073 protected internal DebugInfo dbg;
2074  
2075 /// <summary> Initialize the debugging information.</summary>
2076 /// <returns> a DebugInfo object used by Interp in non-debugging mode.
2077 /// </returns>
2078 protected internal DebugInfo initDebugInfo()
2079 {
2080 return new DebugInfo( null, 1 );
2081 }
2082  
2083 /// <summary> Add more more level at the top of the debug stack.
2084 ///
2085 /// </summary>
2086 /// <param name="fileName">the filename for the new stack level
2087 /// </param>
2088 /// <param name="lineNumber">the line number at which the execution of the
2089 /// new stack level begins.
2090 /// </param>
2091 internal void pushDebugStack( string fileName, int lineNumber )
2092 {
2093 // do nothing.
2094 }
2095  
2096 /// <summary> Remove the top-most level of the debug stack.</summary>
2097 internal void popDebugStack()
2098 {
2099 // do nothing
2100 }
2101 /// <summary> Returns the line number where the given command argument begins. E.g, if
2102 /// the following command is at line 10:
2103 ///
2104 /// foo {a
2105 /// b } c
2106 ///
2107 /// getArgLine(0) = 10
2108 /// getArgLine(1) = 10
2109 /// getArgLine(2) = 11
2110 ///
2111 /// </summary>
2112 /// <param name="index">specifies an argument.
2113 /// </param>
2114 /// <returns> the line number of the given argument.
2115 /// </returns>
2116 internal int getArgLineNumber( int index )
2117 {
2118 return 0;
2119 }
2120 internal void transferResult( Interp sourceInterp, TCL.CompletionCode result )
2121 {
2122 if ( sourceInterp == this )
2123 {
2124 return;
2125 }
2126  
2127 if ( result == TCL.CompletionCode.ERROR )
2128 {
2129 TclObject obj;
2130  
2131 // An error occurred, so transfer error information from the source
2132 // interpreter to the target interpreter. Setting the flags tells
2133 // the target interp that it has inherited a partial traceback
2134 // chain, not just a simple error message.
2135  
2136 if ( !sourceInterp.errAlreadyLogged )
2137 {
2138 sourceInterp.addErrorInfo( "" );
2139 }
2140 sourceInterp.errAlreadyLogged = true;
2141  
2142 resetResult();
2143  
2144 obj = sourceInterp.getVar( "errorInfo", TCL.VarFlag.GLOBAL_ONLY );
2145 setVar( "errorInfo", obj, TCL.VarFlag.GLOBAL_ONLY );
2146  
2147 obj = sourceInterp.getVar( "errorCode", TCL.VarFlag.GLOBAL_ONLY );
2148 setVar( "errorCode", obj, TCL.VarFlag.GLOBAL_ONLY );
2149  
2150 errInProgress = true;
2151 errCodeSet = true;
2152 }
2153  
2154 returnCode = result;
2155 setResult( sourceInterp.getResult() );
2156 sourceInterp.resetResult();
2157  
2158 if ( result != TCL.CompletionCode.OK )
2159 {
2160  
2161 throw new TclException( this, getResult().ToString(), result );
2162 }
2163 }
2164 internal void hideCommand( string cmdName, string hiddenCmdToken )
2165 {
2166 WrappedCommand cmd;
2167  
2168 if ( deleted )
2169 {
2170 // The interpreter is being deleted. Do not create any new
2171 // structures, because it is not safe to modify the interpreter.
2172 return;
2173 }
2174  
2175 // Disallow hiding of commands that are currently in a namespace or
2176 // renaming (as part of hiding) into a namespace.
2177 //
2178 // (because the current implementation with a single global table
2179 // and the needed uniqueness of names cause problems with namespaces)
2180 //
2181 // we don't need to check for "::" in cmdName because the real check is
2182 // on the nsPtr below.
2183 //
2184 // hiddenCmdToken is just a string which is not interpreted in any way.
2185 // It may contain :: but the string is not interpreted as a namespace
2186 // qualifier command name. Thus, hiding foo::bar to foo::bar and then
2187 // trying to expose or invoke ::foo::bar will NOT work; but if the
2188 // application always uses the same strings it will get consistent
2189 // behavior.
2190 //
2191 // But as we currently limit ourselves to the global namespace only
2192 // for the source, in order to avoid potential confusion,
2193 // lets prevent "::" in the token too. --dl
2194  
2195 if ( hiddenCmdToken.IndexOf( "::" ) >= 0 )
2196 {
2197 throw new TclException( this, "cannot use namespace qualifiers as " + "hidden commandtoken (rename)" );
2198 }
2199  
2200 // Find the command to hide. An error is returned if cmdName can't
2201 // be found. Look up the command only from the global namespace.
2202 // Full path of the command must be given if using namespaces.
2203  
2204 cmd = NamespaceCmd.findCommand( this, cmdName, null, TCL.VarFlag.LEAVE_ERR_MSG | TCL.VarFlag.GLOBAL_ONLY );
2205  
2206 // Check that the command is really in global namespace
2207  
2208 if ( cmd.ns != globalNs )
2209 {
2210 throw new TclException( this, "can only hide global namespace commands" + " (use rename then hide)" );
2211 }
2212  
2213 // Initialize the hidden command table if necessary.
2214  
2215 if ( hiddenCmdTable == null )
2216 {
2217 hiddenCmdTable = new Hashtable();
2218 }
2219  
2220 // It is an error to move an exposed command to a hidden command with
2221 // hiddenCmdToken if a hidden command with the name hiddenCmdToken already
2222 // exists.
2223  
2224 if ( hiddenCmdTable.ContainsKey( hiddenCmdToken ) )
2225 {
2226 throw new TclException( this, "hidden command named \"" + hiddenCmdToken + "\" already exists" );
2227 }
2228  
2229 // Nb : This code is currently 'like' a rename to a specialy set apart
2230 // name table. Changes here and in TclRenameCommand must
2231 // be kept in synch untill the common parts are actually
2232 // factorized out.
2233  
2234 // Remove the hash entry for the command from the interpreter command
2235 // table. This is like deleting the command, so bump its command epoch;
2236 // this invalidates any cached references that point to the command.
2237  
2238 if ( cmd.table.ContainsKey( cmd.hashKey ) )
2239 {
2240 SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
2241 }
2242  
2243 // Now link the hash table entry with the command structure.
2244 // We ensured above that the nsPtr was right.
2245  
2246 cmd.table = hiddenCmdTable;
2247 cmd.hashKey = hiddenCmdToken;
2248 SupportClass.PutElement( hiddenCmdTable, hiddenCmdToken, cmd );
2249 }
2250 internal void exposeCommand( string hiddenCmdToken, string cmdName )
2251 {
2252 WrappedCommand cmd;
2253  
2254 if ( deleted )
2255 {
2256 // The interpreter is being deleted. Do not create any new
2257 // structures, because it is not safe to modify the interpreter.
2258 return;
2259 }
2260  
2261 // Check that we have a regular name for the command
2262 // (that the user is not trying to do an expose and a rename
2263 // (to another namespace) at the same time)
2264  
2265 if ( cmdName.IndexOf( "::" ) >= 0 )
2266 {
2267 throw new TclException( this, "can not expose to a namespace " + "(use expose to toplevel, then rename)" );
2268 }
2269  
2270 // Get the command from the hidden command table:
2271  
2272 if ( hiddenCmdTable == null || !hiddenCmdTable.ContainsKey( hiddenCmdToken ) )
2273 {
2274 throw new TclException( this, "unknown hidden command \"" + hiddenCmdToken + "\"" );
2275 }
2276 cmd = (WrappedCommand)hiddenCmdTable[hiddenCmdToken];
2277  
2278 // Check that we have a true global namespace
2279 // command (enforced by Tcl_HideCommand() but let's double
2280 // check. (If it was not, we would not really know how to
2281 // handle it).
2282  
2283 if ( cmd.ns != globalNs )
2284 {
2285  
2286 // This case is theoritically impossible,
2287 // we might rather panic() than 'nicely' erroring out ?
2288  
2289 throw new TclException( this, "trying to expose " + "a non global command name space command" );
2290 }
2291  
2292 // This is the global table
2293 NamespaceCmd.Namespace ns = cmd.ns;
2294  
2295 // It is an error to overwrite an existing exposed command as a result
2296 // of exposing a previously hidden command.
2297  
2298 if ( ns.cmdTable.ContainsKey( cmdName ) )
2299 {
2300 throw new TclException( this, "exposed command \"" + cmdName + "\" already exists" );
2301 }
2302  
2303 // Remove the hash entry for the command from the interpreter hidden
2304 // command table.
2305  
2306 if ( (System.Object)cmd.hashKey != null )
2307 {
2308 SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
2309 cmd.table = ns.cmdTable;
2310 cmd.hashKey = cmdName;
2311 }
2312  
2313 // Now link the hash table entry with the command structure.
2314 // This is like creating a new command, so deal with any shadowing
2315 // of commands in the global namespace.
2316  
2317 ns.cmdTable.Add( cmdName, cmd );
2318  
2319 // Not needed as we are only in the global namespace
2320 // (but would be needed again if we supported namespace command hiding)
2321  
2322 // TclResetShadowedCmdRefs(interp, cmdPtr);
2323 }
2324 internal void hideUnsafeCommands()
2325 {
2326 for ( int ix = 0; ix < unsafeCmds.Length; ix++ )
2327 {
2328 try
2329 {
2330 hideCommand( unsafeCmds[ix], unsafeCmds[ix] );
2331 }
2332 catch ( TclException e )
2333 {
2334 if ( !e.Message.StartsWith( "unknown command" ) )
2335 {
2336 throw;
2337 }
2338 }
2339 }
2340 }
2341 internal TCL.CompletionCode invokeGlobal( TclObject[] objv, int flags )
2342 {
2343 CallFrame savedVarFrame = varFrame;
2344  
2345 try
2346 {
2347 varFrame = null;
2348 return invoke( objv, flags );
2349 }
2350 finally
2351 {
2352 varFrame = savedVarFrame;
2353 }
2354 }
2355 internal TCL.CompletionCode invoke( TclObject[] objv, int flags )
2356 {
2357 if ( ( objv.Length < 1 ) || ( objv == null ) )
2358 {
2359 throw new TclException( this, "illegal argument vector" );
2360 }
2361  
2362  
2363 string cmdName = objv[0].ToString();
2364 WrappedCommand cmd;
2365 TclObject[] localObjv = null;
2366  
2367 if ( ( flags & INVOKE_HIDDEN ) != 0 )
2368 {
2369  
2370 // We never invoke "unknown" for hidden commands.
2371  
2372 if ( hiddenCmdTable == null || !hiddenCmdTable.ContainsKey( cmdName ) )
2373 {
2374 throw new TclException( this, "invalid hidden command name \"" + cmdName + "\"" );
2375 }
2376 cmd = (WrappedCommand)hiddenCmdTable[cmdName];
2377 }
2378 else
2379 {
2380 cmd = NamespaceCmd.findCommand( this, cmdName, null, TCL.VarFlag.GLOBAL_ONLY );
2381 if ( cmd == null )
2382 {
2383 if ( ( flags & INVOKE_NO_UNKNOWN ) == 0 )
2384 {
2385 cmd = NamespaceCmd.findCommand( this, "unknown", null, TCL.VarFlag.GLOBAL_ONLY );
2386 if ( cmd != null )
2387 {
2388 localObjv = new TclObject[objv.Length + 1];
2389 localObjv[0] = TclString.newInstance( "unknown" );
2390 localObjv[0].preserve();
2391 for ( int i = 0; i < objv.Length; i++ )
2392 {
2393 localObjv[i + 1] = objv[i];
2394 }
2395 objv = localObjv;
2396 }
2397 }
2398  
2399 // Check again if we found the command. If not, "unknown" is
2400 // not present and we cannot help, or the caller said not to
2401 // call "unknown" (they specified TCL_INVOKE_NO_UNKNOWN).
2402  
2403 if ( cmd == null )
2404 {
2405 throw new TclException( this, "invalid command name \"" + cmdName + "\"" );
2406 }
2407 }
2408 }
2409  
2410 // Invoke the command procedure. First reset the interpreter's string
2411 // and object results to their default empty values since they could
2412 // have gotten changed by earlier invocations.
2413  
2414 resetResult();
2415 cmdCount++;
2416  
2417 TCL.CompletionCode result = TCL.CompletionCode.OK;
2418 try
2419 {
2420 cmd.cmd.cmdProc( this, objv );
2421 }
2422 catch ( TclException e )
2423 {
2424 result = e.getCompletionCode();
2425 }
2426  
2427 // If we invoke a procedure, which was implemented as AutoloadStub,
2428 // it was entered into the ordinary cmdTable. But here we know
2429 // for sure, that this command belongs into the hiddenCmdTable.
2430 // So if we can find an entry in cmdTable with the cmdName, just
2431 // move it into the hiddenCmdTable.
2432  
2433 if ( ( flags & INVOKE_HIDDEN ) != 0 )
2434 {
2435 cmd = NamespaceCmd.findCommand( this, cmdName, null, TCL.VarFlag.GLOBAL_ONLY );
2436 if ( cmd != null )
2437 {
2438 // Basically just do the same as in hideCommand...
2439 SupportClass.HashtableRemove( cmd.table, cmd.hashKey );
2440 cmd.table = hiddenCmdTable;
2441 cmd.hashKey = cmdName;
2442 SupportClass.PutElement( hiddenCmdTable, cmdName, cmd );
2443 }
2444 }
2445  
2446 // If an error occurred, record information about what was being
2447 // executed when the error occurred.
2448  
2449 if ( ( result == TCL.CompletionCode.ERROR ) && ( ( flags & INVOKE_NO_TRACEBACK ) == 0 ) && !errAlreadyLogged )
2450 {
2451 StringBuilder ds;
2452  
2453 if ( errInProgress )
2454 {
2455 ds = new StringBuilder( "\n while invoking\n\"" );
2456 }
2457 else
2458 {
2459 ds = new StringBuilder( "\n invoked from within\n\"" );
2460 }
2461 for ( int i = 0; i < objv.Length; i++ )
2462 {
2463  
2464 ds.Append( objv[i].ToString() );
2465 if ( i < ( objv.Length - 1 ) )
2466 {
2467 ds.Append( " " );
2468 }
2469 else if ( ds.Length > 100 )
2470 {
2471 ds.Append( "..." );
2472 break;
2473 }
2474 }
2475 ds.Append( "\"" );
2476 addErrorInfo( ds.ToString() );
2477 errInProgress = true;
2478 }
2479  
2480 // Free any locally allocated storage used to call "unknown".
2481  
2482 if ( localObjv != null )
2483 {
2484 localObjv[0].release();
2485 }
2486  
2487 return result;
2488 }
2489 internal void allowExceptions()
2490 {
2491 evalFlags |= Parser.TCL_ALLOW_EXCEPTIONS;
2492 }
2493  
2494 internal class ResolverScheme
2495 {
2496 private void InitBlock( Interp enclosingInstance )
2497 {
2498 this.enclosingInstance = enclosingInstance;
2499 }
2500 private Interp enclosingInstance;
2501 public Interp Enclosing_Instance
2502 {
2503 get
2504 {
2505 return enclosingInstance;
2506 }
2507  
2508 }
2509  
2510 internal string name; // Name identifying this scheme.
2511 internal Resolver resolver;
2512  
2513 internal ResolverScheme( Interp enclosingInstance, string name, Resolver resolver )
2514 {
2515 InitBlock( enclosingInstance );
2516 this.name = name;
2517 this.resolver = resolver;
2518 }
2519 }
2520  
2521 public void addInterpResolver( string name, Resolver resolver )
2522 // Object to resolve commands/variables.
2523 {
2524 IEnumerator enum_Renamed;
2525 ResolverScheme res;
2526  
2527 // Look for an existing scheme with the given name.
2528 // If found, then replace its rules.
2529  
2530 if ( resolvers != null )
2531 {
2532 for ( enum_Renamed = resolvers.GetEnumerator(); enum_Renamed.MoveNext(); )
2533 {
2534 res = (ResolverScheme)enum_Renamed.Current;
2535 if ( name.Equals( res.name ) )
2536 {
2537 res.resolver = resolver;
2538 return;
2539 }
2540 }
2541 }
2542  
2543 if ( resolvers == null )
2544 {
2545 resolvers = new ArrayList( 10 );
2546 }
2547  
2548 // Otherwise, this is a new scheme. Add it to the FRONT
2549 // of the linked list, so that it overrides existing schemes.
2550  
2551 res = new ResolverScheme( this, name, resolver );
2552  
2553 resolvers.Insert( 0, res );
2554 }
2555 public Resolver getInterpResolver( string name )
2556 // Look for a scheme with this name.
2557 {
2558 //IEnumerator enum;
2559  
2560 // Look for an existing scheme with the given name. If found,
2561 // then return pointers to its procedures.
2562  
2563 if ( resolvers != null )
2564 {
2565 foreach ( ResolverScheme res in resolvers )
2566 {
2567 if ( name.Equals( res.name ) )
2568 {
2569 return res.resolver;
2570 }
2571 }
2572 }
2573  
2574 return null;
2575 }
2576 internal bool removeInterpResolver( string name )
2577 // Name of the scheme to be removed.
2578 {
2579 ResolverScheme res;
2580 IEnumerator enum_Renamed;
2581 bool found = false;
2582  
2583 // Look for an existing scheme with the given name.
2584  
2585 if ( resolvers != null )
2586 {
2587 enum_Renamed = resolvers.GetEnumerator();
2588 while ( !found && enum_Renamed.MoveNext() )
2589 {
2590 res = (ResolverScheme)enum_Renamed.Current;
2591 if ( name.Equals( res.name ) )
2592 {
2593 found = true;
2594 }
2595 }
2596 }
2597  
2598 // If we found the scheme, delete it.
2599  
2600 if ( found )
2601 {
2602 SupportClass.VectorRemoveElement( resolvers, name );
2603 }
2604  
2605 return found;
2606 }
2607  
2608 } // end Interp
2609 }