internal static void create(Interp interp, Interp slaveInterp, Interp masterInterp, TclObject name, TclObject targetName, int objIx, TclObject[] objv) { string inString = name.ToString(); InterpAliasCmd alias = new InterpAliasCmd(); alias.name = name; name.Preserve(); alias.slaveInterp = slaveInterp; alias.targetInterp = masterInterp; alias.prefix = TclList.NewInstance(); alias.prefix.Preserve(); TclList.Append(interp, alias.prefix, targetName); TclList.insert(interp, alias.prefix, 1, objv, objIx, objv.Length - 1); slaveInterp.CreateCommand(inString, alias); alias.slaveCmd = NamespaceCmd.findCommand(slaveInterp, inString, null, 0); try { interp.preventAliasLoop(slaveInterp, alias.slaveCmd); } catch (TclException e) { // Found an alias loop! The last call to Tcl_CreateObjCommand made // the alias point to itself. Delete the command and its alias // record. Be careful to wipe out its client data first, so the // command doesn't try to delete itself. slaveInterp.DeleteCommandFromToken(alias.slaveCmd); throw; } // Make an entry in the alias table. If it already exists delete // the alias command. Then retry. if (slaveInterp._aliasTable.ContainsKey(inString)) { InterpAliasCmd oldAlias = (InterpAliasCmd)slaveInterp._aliasTable[inString]; slaveInterp.DeleteCommandFromToken(oldAlias.slaveCmd); } alias.aliasEntry = inString; SupportClass.PutElement(slaveInterp._aliasTable, inString, alias); // Create the new command. We must do it after deleting any old command, // because the alias may be pointing at a renamed alias, as in: // // interp alias {} foo {} bar # Create an alias "foo" // rename foo zop # Now rename the alias // interp alias {} foo {} zop # Now recreate "foo"... SupportClass.PutElement(masterInterp._targetTable, alias.slaveCmd, slaveInterp); interp.SetResult(name); }
/// <summary> 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); }
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); }