{ -----------------------------------------------------------------------
Tcl Scripting Language Components (Tslc)
Copyright (C) 1996-2002 William Byrne

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

WilliamB@ByrneLitho.com
------------------------------------------------------------------------}
unit TslcEmul;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Tslc, ComCtrls, ExtCtrls, ToolIntf, DsgnIntf, EditIntf,
{$IFDEF VER100}
  Menus;
{$ENDIF}
{$IFDEF VER120}
  Menus, ToolsAPI;
{$ENDIF}
{$IFDEF VER130}
  Menus, ToolsAPI;
{$ENDIF}


type
{$IFDEF VER120}
  TFormDesigner = IFormDesigner;
{$ENDIF}
{$IFDEF VER130}
  TFormDesigner = IFormDesigner;
{$ENDIF}

  TEmulationForm = class(TForm)
    BtnEval: TButton;
    Panel1: TPanel;
    Label1: TLabel;
    EditExpr: TEdit;
    Panel2: TPanel;
    PageControl1: TPageControl;
    SheetResults: TTabSheet;
    MemoResults: TMemo;
    SheetSettings: TTabSheet;
    LabelInit: TLabel;
    Label4: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    EditValue: TEdit;
    CheckOnCommand: TCheckBox;
    CheckOnSwitch: TCheckBox;
    CheckOnParam: TCheckBox;
    ComboSwitches: TComboBox;
    ComboParams: TComboBox;
    CheckEnter: TCheckBox;
    CheckReturn: TCheckBox;
    CheckDestroy: TCheckBox;
    CheckPrepare: TCheckBox;
    CheckCreate: TCheckBox;
    Bevel1: TBevel;
    Bevel2: TBevel;
    CheckLong: TCheckBox;
    EditForm: TEdit;
    Label10: TLabel;
    BtnCopy: TButton;
    PageControl2: TPageControl;
    SheetNewValue: TTabSheet;
    Label3: TLabel;
    EditOnCommand: TEdit;
    Label5: TLabel;
    EditOnSwitch: TEdit;
    Label6: TLabel;
    EditOnParam: TEdit;
    CheckClearParam: TCheckBox;
    CheckClearSwitch: TCheckBox;
    CheckClearCommand: TCheckBox;
    Label9: TLabel;
    SheetRaise: TTabSheet;
    Label11: TLabel;
    EditRaiseCommand: TEdit;
    Label12: TLabel;
    EditRaiseSwitch: TEdit;
    Label13: TLabel;
    EditRaiseParam: TEdit;
    CheckRaiseParam: TCheckBox;
    CheckRaiseSwitch: TCheckBox;
    CheckRaiseCommand: TCheckBox;
    Label14: TLabel;
    CheckInvoke: TCheckBox;
    SheetScript: TTabSheet;
    MemoScript: TMemo;
    CheckPrint: TCheckBox;
    CheckSafe: TCheckBox;
    CheckPrompt: TCheckBox;
    SheetMini: TTabSheet;
    Label2: TLabel;
    EditScriptCommand: TEdit;
    Label15: TLabel;
    EditScriptSwitch: TEdit;
    Label16: TLabel;
    EditScriptParam: TEdit;
    Label17: TLabel;
    CheckAssignCommand: TCheckBox;
    CheckAssignSwitch: TCheckBox;
    CheckAssignParam: TCheckBox;
    BtnHelp: TButton;
    EditPrefix: TEdit;
    Label18: TLabel;
    CheckForce: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BtnEvalClick(Sender: TObject);
    procedure ComboSwitchesChange(Sender: TObject);
    procedure ComboParamsChange(Sender: TObject);
    procedure CheckOnParamClick(Sender: TObject);
    procedure CheckOnSwitchClick(Sender: TObject);
    procedure CheckClearSwitchClick(Sender: TObject);
    procedure CheckClearParamClick(Sender: TObject);
    procedure EditOnSwitchChange(Sender: TObject);
    procedure EditOnParamChange(Sender: TObject);
    procedure CheckClearCommandClick(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure BtnCopyClick(Sender: TObject);
    procedure CheckRaiseSwitchClick(Sender: TObject);
    procedure CheckRaiseParamClick(Sender: TObject);
    procedure EditRaiseSwitchChange(Sender: TObject);
    procedure EditRaiseParamChange(Sender: TObject);
    procedure CheckInvokeClick(Sender: TObject);
    procedure CheckPrintClick(Sender: TObject);
    procedure CheckPromptClick(Sender: TObject);
    procedure CheckSafeClick(Sender: TObject);
    procedure EditScriptSwitchChange(Sender: TObject);
    procedure EditScriptParamChange(Sender: TObject);
    procedure CheckAssignSwitchClick(Sender: TObject);
    procedure CheckAssignParamClick(Sender: TObject);
    procedure EditScriptCommandChange(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BtnHelpClick(Sender: TObject);
    procedure EditPrefixChange(Sender: TObject);
  private
    { Private declarations }
        EW : TIEditWriter;
    	FCommand: TTclCommand;
        FOnCreate:  TTclCmdEvent;
      	FOnCommand: TTclCommandEvent;
      	FOnDestroy: TTclCmdEvent;
        FOnPrepare: TTclPrepareEvent;
        FSwitchList: TStringList; //TTclCmdSwitchEvent
        FParamList: TStringList; //TTclCmdParamEvent;
		FHasOnCreate: boolean;
        FHasOnDestroy: boolean;
        FHasOnPrepare: boolean;
        FHasOnCommand: boolean;
        FAdvisedExit: boolean;
        FOnCreateName: string;
        FOnCommandName: string;
        FOnDestroyName: string;
        FOnPrepareName: string;
        FInputStr: string;
		FArgList: TStringList;
        FMethodList: TStringList;
        FDesigner: TFormDesigner;
		FPrintCommand: TTclCommand;
        FPromptCommand: TTclCommand;
        SettingParams, SettingSwitches: boolean;
        ToolServices: TIToolServices;
		function BtnEvalHit: boolean;
        procedure CheckCancel;
        function CurrentHelpTopic: string;
        procedure DoHelp(ctx: string);
    	procedure DoCommand(cmd: TTclCommand; var newValue: string; var success: boolean);
        procedure DoCreate(cmd: TTclCommand);
        procedure DoDestroy(cmd: TTclCommand);
        procedure DoPrepare(cmd: TTclCommand; var newValue: string; var success: boolean);
        procedure DoParam(param: TTclCmdParam; APos: integer; AParam: string; var newValue: string; var success: boolean);
        procedure DoSwitch(switch: TTclCmdSwitch; ASwitch: string; var newValue: string; var success: boolean);

        procedure DoPrint(cmd: TTclCommand; var newValue: string; var success: boolean);
        procedure DoPrompt(cmd: TTclCommand; var newValue: string; var success: boolean);
        procedure DoPromptPrepare(cmd: TTclCommand; var newValue: string; var success: boolean);
        procedure DoClear(switch: TTclCmdSwitch; ASwitch: string; var newValue: string; var success: boolean);
        procedure DoInput(switch: TTclCmdSwitch; ASwitch: string; var newValue: string; var success: boolean);

		procedure ParseExpression;
		procedure OnGetMethodName(const value: string);
		procedure Stats(str: string);
        procedure StatsFmt(const str: string; const args: array of const);
  public
    { Public declarations }
		procedure Emulate(cmd: TTclCommand; ADesigner: TFormDesigner);
  end;

var
  EmulationForm: TEmulationForm;

implementation
uses ExptIntf, IStreams, TypInfo, TclTk;
{$R *.DFM}

//var
//	ims: TIMemoryStream;
type
	TEvalData = class
    public
    	success: boolean;
        clearNewValue: boolean;
        newValue: string;
        _raise: boolean;
        raiseMsg: string;
        Script: string;
        Assign: boolean;
        constructor Create;
    end;

    TEvalParam = class(TEvalData)
    public
        OnParam: TTclCmdParamEvent;
        Param: TTclCmdParam;
        OnParamName: string;
        HasOnParam: boolean;
        constructor Create(AParam: TTclCmdParam; Proc: TTclCmdParamEvent; AOnParamName: string);
    end;

    TEvalSwitch = class(TEvalData)
    public
    	OnSwitch: TTclCmdSwitchEvent;
        Switch: TTclCmdSwitch;
        OnSwitchName: string;
        HasOnSwitch: boolean;
        constructor Create(ASwitch: TTclCmdSwitch; Proc: TTclCmdSwitchEvent; AOnSwitchName: string);
    end;

constructor TEvalData.Create;
begin
	newValue := '';
    clearNewValue := False;
    success := True;
end;

constructor TEvalParam.Create(AParam: TTclCmdParam; Proc: TTclCmdParamEvent; AOnParamName: string);
begin
	inherited Create;
    Param := AParam;
    OnParam := Proc;
    OnParamName := AOnParamName;
    HasOnParam := @proc <> nil;
end;

constructor TEvalSwitch.Create(ASwitch: TTclCmdSwitch; Proc: TTclCmdSwitchEvent; AOnSwitchName: string);
begin
	inherited Create;
    Switch := ASwitch;
    OnSwitch := Proc;
    OnSwitchName := AOnSwitchName;
    HasOnSwitch := @proc <> nil;
end;


procedure TEmulationForm.OnGetMethodName(const value: string);
begin
//	MethodList.add(value);
	MemoResults.Lines.add(value);
end;

procedure TEmulationForm.Emulate(cmd: TTclCommand; ADesigner: TFormDesigner);
const
	Force: boolean = False;//True;
var
	x: integer;
	p: pointer;
    pf: TTclCmdParamEvent;
    sf: TTclCmdSwitchEvent;
    test: pointer;
	ti: pTypeInfo;


   	function CommandName(c: TTclCommand; AName: string): string;
    begin
		if FDesigner = nil then
        	result := ''
        else
        	result := FDesigner.GetMethodName(GetMethodProp(c, GetPropInfo(TypeInfo(TTclCommand), AName)));
	end;
   	function ParamName(p: TTclCmdParam): string;
    begin
		if FDesigner = nil then
        	result := ''
        else
        	result := FDesigner.GetMethodName(GetMethodProp(p, GetPropInfo(TypeInfo(TTclCmdParam), 'OnParam')));
	end;
   	function SwitchName(s: TTclCmdSwitch): string;
    begin
		if FDesigner = nil then
        	result := ''
        else
        	result := FDesigner.GetMethodName(GetMethodProp(s, GetPropInfo(TypeInfo(TTclCmdSwitch), 'OnSwitch')));
	end;
begin
	FDesigner := ADesigner;
	EditExpr.Text := cmd.Command;
    MemoResults.Clear;
{	if FDesigner <> nil then
    begin
		ti := TypeInfo(TTclCommand);
        td := GetTypeData(ti);
        ShowMessage();
  	end;
}
    FSwitchList.clear;
    FParamList.clear;
    FCommand := cmd;
    if FCommand.Command = 'Print' then
    	FPrintCommand.Command := 'DoPrint'
    else
	    FPrintCommand.Command := 'Print';
	CheckPrint.Caption := 'En&able ' + FPrintCommand.Command;

    if FCommand.Command = 'Prompt' then
    	FPromptCommand.Command := 'DoPrompt'
    else
	    FPromptCommand.Command := 'Prompt';
	CheckPrompt.Caption := 'Ena&ble ' + FPromptCommand.Command;

    EditForm.Text := cmd.Owner.ClassName;
    Caption := format('Emulation - %s.%s', [cmd.Owner.Name, cmd.Name]);
	EditValue.Text := 'Emulating ' + FCommand.Command;

	FOnCreate	:= cmd.OnCreate;
	FOnCreateName := CommandName(cmd, 'OnCreate');
    FHasOnCreate := (@cmd.OnCreate <> nil) or Force;
   	cmd.OnCreate := DoCreate;

    FOnCommand	:= cmd.OnCommand;
    FOnCommandName := CommandName(cmd, 'OnCommand');
    FHasOnCommand := (@cmd.OnCommand <> nil) or Force;
   	cmd.OnCommand := DoCommand;

    FOnDestroy	:= cmd.OnDestroy;
    FOnDestroyName := CommandName(cmd, 'OnDestroy');
    FHasOnDestroy := (@cmd.OnDestroy <> nil) or Force;
   	cmd.OnDestroy := DoDestroy;

    FOnPrepare	:= cmd.OnPrepare;
    FOnPrepareName := CommandName(cmd, 'OnPrepare');
    FHasOnPrepare := (@cmd.OnPrepare <> nil) or Force;
   	cmd.OnPrepare := DoPrepare;

	with cmd do
    for x:= 0 to ParamCount - 1 do
    begin
    	FParamList.addObject(Params[x].Name, TEvalParam.Create(Params[x], Params[x].OnParam, ParamName(Params[x])));
//		HasOnParam := (@Params[x].OnParam <> nil) or Force;
       	Params[x].OnParam := DoParam;
    end;
    with cmd do
    for x:= 0 to SwitchCount - 1 do
    begin
    	FSwitchList.addObject(Switches[x].Name, TEvalSwitch.Create(Switches[x], Switches[x].OnSwitch, SwitchName(Switches[x])));
 //       HasOnSwitch :=  (@Switches[x].OnSwitch <> nil) or Force;
       	Switches[x].OnSwitch := DoSwitch;
    end;
    ComboSwitches.Items.Assign(FSwitchList);
    ComboParams.Items.Assign(FParamList);
    if FSwitchList.Count > 0 then
    	ComboSwitches.ItemIndex := 0;
    if FParamList.Count > 0 then
    	ComboParams.ItemIndex := 0;
    ComboSwitchesChange(nil);
    ComboParamsChange(nil);
    CheckSafe.Checked := FCommand.Tcl.Safe;
    EditPrefix.Enabled := FCommand.SwitchPrefix = spOther;

    try
		ShowModal;
    finally
		cmd.OnCreate := FOnCreate;
        cmd.OnCommand := FOnCommand;
        cmd.OnDestroy := FOnDestroy;
        cmd.OnPrepare := FOnPrepare;
        with cmd do
        for x:= 0 to ParamCount - 1 do
        begin
//			p := FOnParamList.items[x];
//			Move(p, pf, sizeof(pointer));
        	Params[x].OnParam := TEvalParam(FParamList.objects[x]).OnParam;
        end;
        with cmd do
        for x:= 0 to SwitchCount - 1 do
        begin
//			p := FOnSwitchList.items[x];
//            Move(p, sf, sizeof(pointer));
        	Switches[x].OnSwitch := TEvalSwitch(FSwitchList.objects[x]).OnSwitch;
        end;
        with FParamList do
        for x:= 0 to count - 1 do
        	objects[x].free;
        with FSwitchList do
        for x:= 0 to count - 1 do
        	objects[x].free;
        FPrintCommand.Tcl := nil;
	end;
end;

procedure TEmulationForm.FormCreate(Sender: TObject);
var
	sw: TTclCmdSwitch;
begin
	EW := nil;
	ToolServices := ExptIntf.ToolServices;
	FSwitchList := TStringList.Create;
    FParamList := TStringList.Create;
    FArgList := TStringList.Create;
    FMethodList := TStringList.Create;
    SettingParams := False;
    SettingSwitches := False;
    EditOnCommand.Text := '';
    EditOnSwitch.Text := '';
    EditOnParam.Text := '';
    PageControl1.ActivePage := SheetSettings;
   	PageControl2.ActivePage := SheetNewValue;

	FPromptCommand := nil;
// Setup Print Command
    FPrintCommand := TTclCommand.Create(self);
    with FPrintCommand do
    begin
    	Command := 'Print';
        ErrorMsg := 'Syntax: Print [-c|-h] [?text?]';
        OnCommand := DoPrint;
    end;
	sw := TTclCmdSwitch.Create(self);
	sw.switch := 'c';
    sw.CanAppend := False;
    sw.OnSwitch := DoClear;
    sw.Command := FPrintCommand;
    sw := TTclCmdSwitch.Create(self);
    sw.switch := 'h';
    sw.CanAppend := False;
    sw.OnSwitch := DoClear;
    sw.Command := FPrintCommand;

// Setup Prompt Command
	FPromptCommand := TTclCommand.Create(Self);
    with FPromptCommand do
    begin
    	Command := 'Prompt';
        ErrorMsg := 'Syntax: Prompt [-i[?input?]] <?message?> <info|confirm|warn|error> [*ok|yes|no|cancel]';
        MinArgs := 2;
        MaxArgs := 6;
		OnPrepare := DoPromptPrepare;
        OnCommand := DoPrompt;
    end;
    sw := TTclCmdSwitch.Create(self);
    sw.switch := 'i';
    sw.OnSwitch := DoInput;
    sw.Command := FPromptCommand;

end;

procedure TEmulationForm.FormDestroy(Sender: TObject);
begin
	EW.Free;
	FSwitchList.Free;
    FParamList.Free;
    FArgList.Free;
    FMethodList.Free;
    try
//		ims.free;

    except
    	on E:Exception do
        	ShowMessage(E.Message);
    end;
end;


procedure TEmulationForm.DoHelp(ctx: string);
var
	prevHelp: string;
begin
    prevHelp := Application.HelpFile;
    try
    	Application.HelpFile := 'Tslc.hlp';
        Application.HelpJump(ctx);
    finally
    	Application.HelpFile := prevHelp;
    end;
end;

function TEmulationForm.BtnEvalHit: boolean;
var
	msg: TMsg;
begin
	result := PeekMessage(msg, BtnEval.handle, WM_LBUTTONDOWN, WM_LBUTTONDOWN, PM_REMOVE) or
    	PeekMessage(msg, BtnEval.handle, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE);
end;

procedure TEmulationForm.CheckCancel;
begin
	if BtnEvalHit then
    	TclError('Emulation Aborted');
end;

procedure TEmulationForm.Stats(str: string);
begin
	CheckCancel;
	MemoResults.lines.add(str);
end;

procedure TEmulationForm.StatsFmt(const str: string; const args: array of const);
begin
	Stats(Format(str, args));
end;

const
	BoolStr: array[False..True] of string[5] = ('False', 'True');
	ForceStr: array[False..True] of string[6] =('', 'FORCED');



procedure TEmulationForm.DoPrint(cmd: TTclCommand; var newValue: string; var success: boolean);
var
	str: string;
    x: integer;
begin
	for x:= 0 to cmd.ParamValuesCount - 1 do
    	if x = 0 then
			str := cmd.ParamValues[0]
        else
        	str := str + ' ' + cmd.ParamValues[x];
	Stats(str);
end;

procedure TEmulationForm.DoPromptPrepare(cmd:TTclCommand; var newValue: string; var success: boolean);
begin
	cmd.ClientData := nil;
end;

procedure TEmulationForm.DoPrompt(cmd: TTclCommand; var newValue: string; var success: boolean);
var
	str: string;
    btns: TMsgDlgButtons;
    typ: TMsgDlgType;
    x: integer;
begin
	if cmd.ClientData <> nil then
    begin
    	if not InputQuery('Emulation Prompt', cmd.ParamValues[0], FInputStr) then
        	TclError('User cancel in Emulation Prompt');
        newValue := FInputStr;
    end else
    begin
    	str := cmd.ParamValues[1];
        if CompareText(str, 'info') = 0 then
        	typ := mtInformation
        else if CompareText(str, 'warn') = 0 then
        	typ := mtWarning
        else if CompareText(str, 'confirm') = 0 then
        	typ := mtConfirmation
        else if CompareText(str, 'error') = 0 then
        	typ := mtError
        else
        	TclError(cmd.ErrorMsg);
		if cmd.ParamValuesCount > 2 then
        begin
    	    btns := [];
            for x:= 2 to cmd.ParamValuesCount - 1 do
            begin
				str := cmd.ParamValues[x];
	        	if CompareText(str, 'ok') = 0 then
	            	include(btns, mbOK)
	            else if CompareText(str, 'yes') = 0 then
	            	include(btns, mbYes)
	            else if CompareText(str, 'no') = 0 then
	            	include(btns, mbNo)
				else if CompareText(str, 'cancel') = 0 then
	            	include(btns, mbCancel)
	            else
	            	TclError(cmd.ErrorMsg);
            end;
		end else
        	btns := [mbOK];
        case MessageDlg(cmd.ParamValues[0], typ, btns, 0) of
            mrOk: 	newValue := 'ok';
        	mrYes:	newValue := 'yes';
            mrNo:	newValue := 'no';
        else
        	newValue := 'cancel';
        end;
    end;
end;

procedure TEmulationForm.DoInput(switch: TTclCmdSwitch; ASwitch: string; var newValue: string; var success: boolean);
begin
	FInputStr := switch.Split(ASwitch);
    switch.Command.ClientData := TObject(1);
end;

procedure TEmulationForm.DoClear(switch: TTclCmdSwitch; ASwitch: string; var newValue: string; var success: boolean);
begin
	if UpperCase(ASwitch) = 'H' then
    	TclError(Switch.Command.ErrorMsg)
    else
		MemoResults.Clear;
end;

function _F(Force: boolean; cmdName: string): string;
begin
	if Force then
    	result := '_F_O_R_C_E_D_'
    else
    	result := cmdName;
end;

procedure TEmulationForm.DoCommand(cmd: TTclCommand; var newValue: string; var success: boolean);
procedure DoIt(Force: boolean);

	function Opts(o: TTclCommandOptions): string;
    begin
    	result := '';
        if o = [] then
        	exit;
        if coCallParams in o then result := ', coCallParams';
        if coCallSwitches in o then result := result + ', coCallSwitches';
        if coCountSwitches in o then result := result + ', coCountSwitches';
        if coParse in o then result := result + ', coParse';
        if coRaiseInvalidSwitch in o then result := result + ', coRaiseInvalidSwitch';
		delete(result, 1, 2);
    end;
const
	PfxStr: array[spDash..spOther] of string[12] = ('spDash', 'spSlash', 'spDashSlash', 'spNone', 'spOther');
	ModeStr: array[cmBoth..cmSafe] of string[8] = ('cmBoth', 'cmNormal', 'cbSafe');

var
	script: string;
    long: boolean;
begin
	long := CheckLong.Checked;
    if long then
    begin
    	StatsFmt('procedure %s.%s(Sender: TTclCommand;', [EditForm.Text, _F(Force,FOnCommandName)]);
        Stats   ('  var result: string; var success: boolean);');
		Stats   ('begin');
        StatsFmt('//  %s.OnCommand Event', [cmd.Name]);
        Stats   ('');
	end;

	if CheckEnter.Checked then
    if long then
    begin
        Stats   ('//  E N T E R   V A L U E S');
		Stats   ('//    Sender Properties');
        StatsFmt('//        Command      = ''%s''', [cmd.Command]);
        StatsFmt('//        ErrorMsg     = ''%s''', [cmd.ErrorMsg]);
        StatsFmt('//        MaxArgs      = %d', [cmd.MaxArgs]);
        StatsFmt('//        MinArgs      = %d', [cmd.MinArgs]);
        StatsFmt('//        Mode         = %s', [ModeStr[cmd.Mode]]);
        StatsFmt('//        Name         = %s', [cmd.Name]);
        StatsFmt('//        Options      = [%s]', [Opts(cmd.Options)]);
        StatsFmt('//        SwitchPrefix = %s', [PfxStr[cmd.SwitchPrefix]]);
        StatsFmt('//    result  = ''%s''', [newValue]);
        StatsFmt('//    success = %s', [BoolStr[success]]);
	end else
		Stats(format('%s.%s(%s.Command=%s, var newValue=%s, var success=%s) - ENTER',
    		[EditForm.text, _F(Force,FOnCommandName), cmd.Name, cmd.Command, newValue, BoolStr[success]]));

	if CheckClearCommand.Checked then
    	newValue := ''
    else if EditOnCommand.Text <> '' then
    	newValue := EditOnCommand.Text;

    success := CheckOnCommand.Checked;
    script := Trim(EditScriptCommand.Text);
    if success and (script <> '') and CheckInvoke.Checked then
    begin
       	Stats   ('');
		StatsFmt('    success := %s.Tcl.Eval(''%s'');', [FCommand.Name, script]);
		success := FCommand.Tcl.Eval(script);
        if not success or CheckAssignCommand.Checked then
        begin
        	StatsFmt('    newValue := %s.InterpResult;', [FCommand.Name]);
        	newValue := FCommand.InterpResult;
        end;
    end;

    if CheckRaiseCommand.Checked then
    begin
		if long then
        begin
			if CheckEnter.Checked then
    	    	Stats('');
        	Stats   ('//  R A I S E   E X C E P T I O N');
        end;
        StatsFmt('    TclError(''%s'')', [EditRaiseCommand.text]);
    end else if CheckReturn.Checked then
    if long then
    begin
    	if CheckEnter.Checked then
        	Stats('');
        Stats   ('//  R E T U R N   V A L U E S');
        StatsFmt('//    result  := ''%s'';', [newValue]);
        StatsFmt('//    success := %s;', [BoolStr[success]]);
	end else
		Stats(format('%s.%s(%s.Command=%s, var newValue=%s, var success=%s) - RETURN',
    		[EditForm.Text,  _F(Force,FOnCommandName),cmd.Name, cmd.Command, newValue, BoolStr[success]]));
	if long then
    begin
    	Stats('end;');
		Stats('');
	end;
    if CheckRaiseCommand.Checked then
    	TclError(EditRaiseCommand.text);
end;
begin
	try
    	if FHasOnCommand then
        	DoIt(False)
        else if CheckForce.Checked then
        	DoIt(true);
    finally
        Stats(Copy(Format('// **************** RETURN FROM ''%s'' COMMAND EMULATION ******************', [cmd.Command]),1,75));
    	if CheckLong.Checked then
	        Stats('');
	end;
end;

procedure TEmulationForm.DoCreate(cmd: TTclCommand);
var
	Force: boolean;
begin
	Force := False;
	if not FHasOnCreate then
    	if CheckForce.Checked then
        	Force := True
        else
        	exit;
	if CheckCreate.Checked then
    if CheckLong.Checked then
    begin
    	StatsFmt('procedure %s.%s(Sender: TTclCommand);',[EditForm.Text, _F(Force,FOnCreateName)]); //cmd.Name
		Stats   ('begin');
        StatsFmt('//  %s.OnCreate - Called within Constructor TTclCommand.Create', [cmd.Name]);
        Stats	('end;');
		Stats('');
	end else
		Stats(format('%s.%s(Sender=%s)',[EditForm.Text, _F(Force,FOnCreateName), cmd.Name])); //cmd.Name
end;

procedure TEmulationForm.DoDestroy(cmd: TTclCommand);
var
	Force: boolean;
begin
	Force := False;
	if not FHasOnDestroy then
    	if CheckForce.Checked then
        	Force := True
        else
        	exit;
	if CheckDestroy.Checked then
    if CheckLong.Checked then
    begin
		StatsFmt('procedure %s.%s(Sender: TTclCommand);',[EditForm.Text, _F(Force,FOnDestroyName)]);
		Stats   ('begin');
       	StatsFmt('//   %s.OnDestroy - Called within Destructor TTclCommand.Destroy', [cmd.Name]);
       	Stats	('end;');
		Stats('');
	end else
		Stats(format('%s.%s(Sender=%s)', [EditForm.Text, _F(Force,FOnDestroyName), cmd.Name]));
end;

procedure TEmulationForm.DoPrepare(cmd: TTclCommand; var newValue: string; var success: boolean);
procedure DoIt(Force: boolean);
begin
	if CheckPrepare.Checked then
    if CheckLong.Checked then
    begin
    	StatsFmt('procedure %s.%s(Sender: TTclCommand);',[EditForm.Text, _F(Force,FOnPrepareName)]);
		Stats   ('begin');
        StatsFmt('//   %s.OnPrepare Event - Prepare for Command processing', [cmd.Name]);
        if CheckInvoke.Checked then
	       	StatsFmt('    Sender.InterpResult := ''%s'';', [EditValue.Text]);
        Stats	('end;');
		Stats('');
	end else
    begin
		Stats(format('%s.%s(Sender=%s)',[EditForm.Text, _F(Force,FOnPrepareName), cmd.Name]));
        if CheckInvoke.Checked then
	       	StatsFmt('    Sender.InterpResult := %s;', [EditValue.Text]);
    end;
    if CheckInvoke.Checked then
    	cmd.InterpResult := EditValue.Text;
end;
begin
	Stats(Copy(Format('// ***************** ENTER INTO ''%s'' COMMAND EMULATION ******************', [cmd.Command]),1,75));
	if CheckLong.Checked then
	    Stats   ('');
	if FHasOnPrepare then
		DoIt(false)
    else if CheckForce.Checked then
    	DoIt(true);
end;


procedure TEmulationForm.DoParam(param: TTclCmdParam; APos: integer; AParam: string; var newValue: string; var success: boolean);

	function PosElems(p: integer): string;
    var
    	x: integer;
    begin
		if p = -1 then
        begin
        	result := '1..32';
            exit;
        end;
    	if p = 0 then
        begin
        	result := 'N/A';
            exit;
        end;
		result := '';
    	for x:= 0 to 31 do
			if (p and (1 shl x)) <> 0 then
            	if length(result) = 0 then
                	result := inttostr(x+1)
                else
                	result := result + ',' + inttostr(x+1);
    end;

var
	idx: integer;
    ep: TEvalParam;
    OnName, script: string;
    Force, long: boolean;
begin
	idx := FParamList.indexOf(Param.Name);
    if idx < 0 then
    	TclErrorFmt('Error indexing %s', [Param.Name]);

    Force := False;
    ep := FParamList.objects[idx] as TEvalParam;
    if not ep.HasOnParam then
    	if CheckForce.Checked then
        	Force := True
        else
        	exit;

    OnName := ep.OnParamName;
    long := CheckLong.Checked;

    if long then
    begin
    	StatsFmt('procedure %s.%s(Sender: TTclCmdParam; APos: integer;', [EditForm.Text, _F(Force,OnName)]);
		Stats   ('  AParam: string; var newValue: string; var success: boolean);');
		Stats   ('begin');
        StatsFmt('//   %s.OnParam Event', [param.Name]);
        Stats   ('');
	end;
	if CheckEnter.Checked then
    if long then
    begin
        Stats   ('//  E N T E R   V A L U E S');
		Stats   ('//    Sender Properties');
		StatsFmt('//        CaseSensitive = %s', [BoolStr[param.CaseSensitive]]);
        StatsFmt('//        Default       = %s', [BoolStr[param.Default]]);
        StatsFmt('//        Name          = %s', [param.Name]);
        StatsFmt('//        Param         = ''%s''', [param.param]);
        StatsFmt('//        Position      = %d (%s)', [param.position, PosElems(param.Position)]);
        StatsFmt('//    APos    = %d', [APos]);
        StatsFmt('//    AParam  = ''%s''', [AParam]);
        StatsFmt('//    newValue= ''%s''', [newValue]);
        StatsFmt('//    success = %s', [BoolStr[success]]);
    end else
		Stats(format('%s.%s(%s.Param=%s, APos=%d, AParam=%s, var newValue=%s, var success=%s) - ENTER',
    		[EditForm.Text, _F(Force,OnName), param.Name, param.Param, APos, AParam, newValue, BoolStr[success]]));

	if ep.ClearNewValue then
    begin
    	newValue := '';
        Stats   ('    newValue := '''';');
    end else if ep.newValue <> '' then
    begin
    	newValue := ep.newValue;
        StatsFmt('    newValue := ''%s'';', [newValue]);
    end;
    success := ep.success;


    if not success then
    	Stats	('    success := False;');
    script := Trim(ep.Script);
    if success and (script <> '') and CheckInvoke.Checked then
    begin
		if long then
	    	Stats   ('');
        StatsFmt('    success := %s.Tcl.Eval(''%s'');', [FCommand.Name, script]);
        success := FCommand.Tcl.Eval(script);

        if not success or ep.Assign then
        begin
        	StatsFmt('    newValue := %s.InterpResult;', [FCommand.Tcl.Name]);
            newValue := FCommand.InterpResult;
	    end;
    end;

    if ep._raise then
    begin
    	if long then
        begin
			if CheckEnter.Checked then
    	    	Stats('');
        	Stats   ('//  R A I S E   E X C E P T I O N');
        end;
        StatsFmt('    TclError(''%s'')', [ep.raiseMsg]);
	end else if CheckReturn.Checked then
    if long then
    begin
    	if CheckEnter.Checked then
        	Stats('');
        Stats   ('//  R E T U R N   V A L U E S');
        StatsFmt('//    newValue:= ''%s'';', [newValue]);
        StatsFmt('//    success := %s;', [BoolStr[success]]);
    end else
		Stats(format('%s.%s(%s.Param=%s, APos=%d, AParam=%s, var newValue=%s, var success=%s) - RETURN',
	     	[EditForm.Text, _F(Force,OnName),param.Name, param.Param, APos, AParam, newValue, BoolStr[success]]));

	if long then
    begin
    	Stats('end;');
		Stats('');
	end;

    if ep._raise then
    	TclError(ep.raiseMsg);

end;

procedure TEmulationForm.DoSwitch(switch: TTclCmdSwitch; ASwitch: string; var newValue: string; var success: boolean);

	function Opts(o: TTclCmdSwitchOptions): string;
    begin
    	result := '';
        if o = [] then exit;
        if soHaltSwitchParsing in o then result := ', soHaltSwitchParsing';
        if soIgnoreDuplicate in o then result := result + ', soIgnoreDuplicate';
        if soRaiseDuplicate in o then result := result + ', soRaiseDuplicate';
        Delete(result, 1, 2);
    end;
var
	idx: integer;
    es: TEvalSwitch;
    OnName, script: string;
    Force, long, enter: boolean;
begin
	Force := False;
	idx := FSwitchList.indexOf(Switch.Name);
    if idx < 0 then
    	TclErrorFmt('Error indexing %s', [Switch.Name]);
    es := FSwitchList.objects[idx] as TEvalSwitch;
    if not es.HasOnSwitch then
    	if CheckForce.Checked then
        	Force := True
        else
        	exit;
    OnName := es.OnSwitchName;
	long := CheckLong.Checked;
    enter:= CheckEnter.Checked;

    if long then
    begin
    	StatsFmt('procedure %s.%s(Sender: TTclCmdSwitch;', [EditForm.Text, _F(Force,OnName)]);
        Stats   ('  ASwitch: string; var newValue: string; var success: boolean);');
		Stats   ('begin');
        StatsFmt('//  %s.OnSwitch Event', [switch.Name]);
        Stats   ('');
    end;

	if enter then
    if long then
    begin
        Stats   ('//  E N T E R   V A L U E S');
		Stats   ('//    Sender Properties');
        StatsFmt('//        CanAppend     = %s', [BoolStr[switch.CanAppend]]);
        StatsFmt('//        CaseSensitive = %s', [BoolStr[switch.CaseSensitive]]);
        StatsFmt('//        Name          = %s', [switch.Name]);
		StatsFmt('//        Options       = [%s]', [Opts(switch.Options)]);
        StatsFmt('//        Switch        = ''%s''', [switch.switch]);
        StatsFmt('//        Hits          = %d', [switch.Hits]);
		if switch.CanAppend then
        StatsFmt('//        Split(ASwitch)= ''%s''', [switch.Split(ASwitch)])
        else
       	Stats   ('//        Split(ASwitch)= N/A');
        StatsFmt('//    ASwitch        = ''%s''', [ASwitch]);
        StatsFmt('//    newValue       = ''%s''', [newValue]);
        StatsFmt('//    success        = %s', [BoolStr[success]]);
    end else
		Stats(format('%s.%s(%s.Switch=%s, ASwitch=%s, var newValue=%s, var success=%s) - ENTER %s',
    		[EditForm.Text, _F(Force,OnName), switch.name, switch.switch, ASwitch, newValue, BoolStr[success],ForceStr[Force]]));

    if es.ClearNewValue then
    begin
    	newValue := '';
        Stats   ('    newValue := '''';');
    end else if es.newValue <> '' then
    begin
    	newValue := es.newValue;
		StatsFmt('    newValue := ''%s'';', [newValue]);
    end;
    success := es.success;
    if not success then
    	Stats	('    success := False;');
    script := Trim(es.Script);
    if success and (script <> '') and CheckInvoke.Checked then
    begin
		if long then
	    	Stats   ('');
        StatsFmt('    success := %s.Tcl.Eval(''%s'');', [FCommand.Name, script]);
        success := FCommand.Tcl.Eval(script);
        if not success or es.Assign then
        begin
        	StatsFmt('    newValue := %s.InterpResult;', [FCommand.Name]);
            newValue := FCommand.InterpResult;
        end;
    end;

    if es._raise then
    begin
    	if long then
        begin
			if enter then
    	    	Stats('');
        	Stats   ('//  R A I S E   E X C E P T I O N');
        end;
        StatsFmt('    TclError(''%s'')', [es.raiseMsg]);
    end else if CheckReturn.Checked then
    if long then
    begin
    	if enter then
        	Stats('');
        Stats   ('//  R E T U R N   V A L U E S');
        StatsFmt('//  newValue:= ''%s'';', [newValue]);
        StatsFmt('//  success := %s;', [BoolStr[success]]);
    end else
		Stats(format('%s.%s(%s.Switch=%s, ASwitch=%s, var newValue=%s, var success=%s) - RETURN %s',
    		[EditForm.Text, _F(Force,OnName), switch.name,switch.switch, ASwitch, newValue, BoolStr[success],ForceStr[Force]]));

	if long then
    begin
    	Stats('end;');
		Stats('');
	end;

    if es._raise then
    	TclError(es.raiseMsg);
end;

procedure TEmulationForm.ParseExpression;
var
	buf, p, pQuote: pChar;
	tok: string;
    openQuote: boolean;
    len: integer;


	function NumTh(num: integer): string;
    var
    	d: integer;
        th: string;
    begin
    	d := num mod 10;
    	if not (d in [1,2,3]) or (d in [11, 12, 13]) then
        	th := 'th'
        else
        	case d of
            	1: th := 'st';
                2: th := 'nd';
                3: th := 'rd';
            else
            	th := 'th';
            end;
		result := inttostr(num) + th;
    end;



    function GetToken: string;
    var
    	quote: boolean;
        q: pChar;
    begin
        q := p;
		pQuote := nil;
        quote := p^ = '"';
        while ((p^ <> ' ') or quote) and (p^ <> #0) do
        begin
        	if (p^ = '"') and (pQuote = nil) then
            	pQuote := p  ;
        	inc(p);
            if p^ = '"' then
            	quote := not quote;
        end;
		if (pQuote <> nil) and (p > pQuote + 1) and ((p - 1)^ = '"') then
        	pQuote := nil;
		if p^ = #0 then
        	result := strpas(q)
        else
        begin
	        p^ := #0;
			inc(p);
    	    result := strpas(q);
	       	while p^ = ' ' do inc(p);
        end;
	end;
begin
    FArgList.Clear;
    len := length(EditExpr.text);
    if len = 0 then
    	exit;
    GetMem(buf, len + 1);
    strpcopy(buf, EditExpr.text);
    try
	    p := buf;
	    while p^ = ' ' do inc(p);
		while p^ <> #0 do
        begin
       		FArgList.add(GetToken);
            CheckCancel;
            if pQuote <> nil then
            	Stats(format('Open quote in %s argument', [NumTh(FArgList.Count)]));
        end;
    finally
    	FreeMem(buf);
    end;
end;


procedure TEmulationForm.BtnEvalClick(Sender: TObject);
var
	command: string;
    emulResult, expr: string;
    ok: boolean;
    str: string;
begin
	sleep(500);
    while BtnEvalHit do;
	MemoResults.Clear;
    if CheckInvoke.Checked then
    begin
    	command := FCommand.Command;
    end else
    begin
		ParseExpression;
    	if FArgList.count < 1 then
	    begin
    		Stats('No Expression');
        	exit;
	    end;
    	command := FArgList.strings[0];
	    if CompareText(command, FCommand.Command) <> 0 then
    	begin
    		Stats(format('Expression must begin with command name: %s', [FCommand.Command]));
	        exit;
    	end;
	    if command <> FCommand.Command then
    		Stats(format('// Tcl is case sensitive. %s will not call %s.', [command, FCommand.Command]));
		FArgList.delete(0);
        expr := EditExpr.text;
    end;
    BtnEval.Caption := '&Abort';
    BtnCopy.Enabled := False;
	try try
		emulResult := format('Emulating %s', [command]);
        if CheckInvoke.Checked then
    		Stats   ('// ************************ BEGIN TCL INVOCATION **************************')
        else
	        Stats(Copy(Format('// ********************** BEGIN EMULATION - %s ***************************', [command]), 1, 75));
        if CheckLong.Checked then
        	Stats('');
        if Assigned(FCommand.OnCreate) then
        	FCommand.OnCreate(FCommand);
        if CheckLong.Checked then
        begin
			Stats('////////////////  EXECUTE FUNCTION ///////////////////');
			if CheckInvoke.Checked then
            begin
            	if MemoScript.Lines.Count > 0 then
       				str := MemoScript.Lines.Strings[0]
                else
                	str := '!EMPTY SCRIPT!';
            	StatsFmt('//   %s.Eval(''%s...'')', [FCommand.Tcl.Name, Copy(str, 1, 40)]);
            end else
	        	StatsFmt('//   %s.Emulate(''%s'', ''%s'')',[FCommand.Name, emulResult, expr]);
        	Stats('');
        end;


		if CheckInvoke.Checked then
        	ok := FCommand.Tcl.Eval(MemoScript.text)
        else
	        ok := FCommand.EmulateList(emulResult, FArgList);


        if CheckLong.Checked then
        begin
			Stats('////////////////  FUNCTION RETURNS ///////////////////');
			if CheckInvoke.Checked then
                StatsFmt('//   %s.Eval() = %s', [FCommand.Tcl.Name, BoolStr[ok]])
            else
            	StatsFmt('//   %s.Emulate() = %s',[FCommand.Name, BoolStr[ok]]);
//        	Stats('');
        end;

        if CheckInvoke.Checked then
        begin
			if ok then
            	Stats('// Tcl Invocation Returned Success: ')
            else
            	Stats('// Tcl Invocation Returned Error: ');
			FCommand.Tcl.ResultStrings(MemoResults.lines);
		end else
        begin
        	if ok then
            	Stats('// Emulation Returned Success: ')
            else
            	Stats('// Emulation Returned Error: ');
			TslcAddTextToStrings(pChar(emulResult), MemoResults.lines);                
        end;

		if CheckLong.Checked then
        	Stats('');
		if Assigned(FCommand.OnDestroy) then
        	FCommand.OnDestroy(FCommand);
		if CheckInvoke.Checked then
        	Stats   ('// ************************** END TCL INVOCATION **************************')
        else
			Stats(Copy(Format('// ************************ END EMULATION - %s ***************************', [command]),1,75));
		BtnCopy.Enabled := True;
    except
    	on E: Exception do
        	Stats('EXCEPTION: ' + E.Message);
    end;
    finally
    	BtnEval.Caption := '&Evaluate';
    end;

end;

procedure TEmulationForm.ComboSwitchesChange(Sender: TObject);
var
	switch: TTclCmdSwitch;
    idx: integer;
begin
	settingSwitches := True;
    try
	idx := ComboSwitches.itemIndex;
    EditOnSwitch.Enabled := idx <> -1;
    CheckClearSwitch.Enabled := idx <> -1;
    CheckOnSwitch.Enabled := idx <> -1;
    if idx < 0 then
    	exit;
	with FSwitchList.objects[idx] as TEvalSwitch do
    begin
    	EditOnSwitch.Text := newValue;
        CheckClearSwitch.Checked := clearNewValue;
        CheckOnSwitch.Checked := success;
        CheckRaiseSwitch.Checked := _raise;
        EditRaiseSwitch.text := raiseMsg;
    end;
    finally
    settingSwitches := False;
	end;
end;

procedure TEmulationForm.ComboParamsChange(Sender: TObject);
var
	Param: TTclCmdParam;
    idx: integer;
begin
	settingParams := True;
	try
	idx := ComboParams.itemIndex;
    EditOnParam.Enabled := idx <> -1;
    CheckClearParam.Enabled := idx <> -1;
    CheckOnParam.Enabled := idx <> -1;
    if idx < 0 then
    	exit;
	with FParamList.objects[idx] as TEvalParam do
    begin
    	EditOnParam.Text := newValue;
        CheckClearParam.Checked := clearNewValue;
        CheckOnParam.Checked := success;
        CheckRaiseParam.Checked := _raise;
        EditRaiseParam.Text := raiseMsg;
    end;
    finally
    settingParams := False;
	end;
end;

procedure TEmulationForm.CheckOnParamClick(Sender: TObject);
var
	idx: integer;
begin
	idx := ComboParams.itemIndex;
    if idx < 0 then
    	exit;
	with FParamList.objects[idx] as TEvalParam do
		success := CheckOnParam.Checked;
end;

procedure TEmulationForm.CheckOnSwitchClick(Sender: TObject);
var
	idx: integer;
begin
	idx := ComboSwitches.itemIndex;
    if idx < 0 then
    	exit;
    with FSwitchList.objects[idx] as TEvalSwitch do
    	success := CheckOnSwitch.Checked;
end;

procedure TEmulationForm.CheckClearSwitchClick(Sender: TObject);
var
	idx: integer;
begin
	idx := ComboSwitches.itemIndex;
    if idx < 0 then
    	exit;
    with FSwitchList.objects[idx] as TEvalSwitch do
    	clearNewValue := CheckClearSwitch.Checked;
    if CheckClearSwitch.Checked then
    	EditOnSwitch.text := '';
end;

procedure TEmulationForm.CheckClearParamClick(Sender: TObject);
var
	idx: integer;
begin
	idx := ComboParams.itemIndex;
    if idx < 0 then
    	exit;
	with FParamList.objects[idx] as TEvalParam do
		clearNewValue := CheckClearParam.Checked;
    if CheckClearParam.Checked then
    	EditOnParam.text := '';
end;

procedure TEmulationForm.EditOnSwitchChange(Sender: TObject);
var
	idx: integer;
begin
	if SettingSwitches then
    	exit;
	idx := ComboSwitches.itemIndex;
    if idx < 0 then
    	exit;
    with FSwitchList.objects[idx] as TEvalSwitch do
    	newValue := EditOnSwitch.text;
end;

procedure TEmulationForm.EditOnParamChange(Sender: TObject);
var
	idx: integer;
begin
	if SettingParams then
    	exit;
    idx := ComboParams.itemIndex;
    if idx < 0 then
    	exit;
    with FParamList.objects[idx] as TEvalParam do
    	newValue := EditOnParam.text;
end;

procedure TEmulationForm.CheckClearCommandClick(Sender: TObject);
begin
	if CheckClearCommand.Checked then
    	EditOnCommand.Text := '';
end;

procedure TEmulationForm.PageControl1Change(Sender: TObject);
begin
	BtnEval.Enabled := PageControl1.ActivePage = SheetResults;
    BtnCopy.Enabled := BtnEval.Enabled and (MemoResults.Lines.Count > 0);
end;
                         
procedure TEmulationForm.BtnCopyClick(Sender: TObject);
var
	ims: TIMemoryStream;
    strm: TMemoryStream;
    u, f: string;
begin
	if ToolServices = nil then
    	exit;
    strm := TMemoryStream.Create;
    try
    ims := TIMemoryStream.Create(strm);
    except
    	strm.free;
        raise;
    end;
	try
		MemoResults.Lines.SaveToStream(ims.MemoryStream);
//		ShowMessage(inttostr(ims.MemoryStream.Size));
		u := 'Emul';
        f := 'Emul';
        ims.MemoryStream.Seek(0, 0);
        if ToolServices.GetNewModuleName(u, f) then
	       ToolServices.CreateModule(f,ims, nil, [cmShowSource, cmUnNamed, cmMarkModified])
        else
        	ims.Free;
	finally
    	strm.free;
    end;

//    function CreateModule(const ModuleName: string;
//      Source, Form: TIStream; CreateFlags: TCreateModuleFlags): Boolean;

end;

procedure TEmulationForm.CheckRaiseSwitchClick(Sender: TObject);
var
	idx: integer;
begin
	idx := ComboSwitches.itemIndex;
    if idx < 0 then
    	exit;
    with FSwitchList.objects[idx] as TEvalSwitch do
    	_raise := CheckRaiseSwitch.Checked;
    if not CheckRaiseSwitch.Checked then
    	EditRaiseSwitch.text := '';
end;

procedure TEmulationForm.CheckRaiseParamClick(Sender: TObject);
var
	idx: integer;
begin
	idx := ComboParams.itemIndex;
    if idx < 0 then
    	exit;
	with FParamList.objects[idx] as TEvalParam do
		_raise := CheckRaiseParam.Checked;
    if not CheckRaiseParam.Checked then
    	EditRaiseParam.text := '';
end;

procedure TEmulationForm.EditRaiseSwitchChange(Sender: TObject);
var
	idx: integer;
begin
	if SettingSwitches then
    	exit;
	idx := ComboSwitches.itemIndex;
    if idx < 0 then
    	exit;
    with FSwitchList.objects[idx] as TEvalSwitch do
    	raiseMsg := EditRaiseSwitch.text;
end;

procedure TEmulationForm.EditRaiseParamChange(Sender: TObject);
var
	idx: integer;
begin
	if SettingParams then
    	exit;
    idx := ComboParams.itemIndex;
    if idx < 0 then
    	exit;
    with FParamList.objects[idx] as TEvalParam do
    	raiseMsg := EditRaiseParam.text;

end;

procedure TEmulationForm.CheckInvokeClick(Sender: TObject);
var
	ok: boolean;
begin
	if CheckInvoke.Checked then
    begin
    	ok := False;
    	if Assigned(FCommand.Tcl) and (MessageDlg(
			'It is recommended that all work is saved prior to invoking the Tcl engine since it''s ' +
            'possible to perform virtually any operation with Tcl script. Errors such as an infinite ' +
            'loop generated in a script will compromise any unsaved work. Continue with Tcl invocation?',
            mtWarning, mbYesNoCancel, 0) = mrYes) then
        try
        	FCommand.Tcl.Active := True;
			FCommand.Tcl.DeleteTclCommand('exit');
            if not FAdvisedExit then
	            MemoScript.lines.add('# The "exit" command has been deleted to prevent accidental termination of the current process');
    		FAdvisedExit := true;
            ok := True;
        except
        	on E:Exception do
				MessageDlg(E.Message, mtError, [mbOK], 0);
        end;
        if not ok then
        begin
	        CheckInvoke.OnClick := nil;
            try
    	    	CheckInvoke.Checked := False;
        	finally
        		CheckInvoke.OnClick := CheckInvokeClick;
	        end;
            exit;
        end;
    end else
    	PageControl2.ActivePage := SheetNewValue;

	EditExpr.Enabled := not CheckInvoke.Checked;
    if CheckInvoke.Checked then
    begin
    	Label1.Font.Color := clInactiveCaption;
        LabelInit.Caption := 'OnPrepare &InterpResult value';
    end else
    begin
    	Label1.Font.Color := clWindowText;
        LabelInit.Caption := '&Initial newValue';
    end;
	SheetScript.Enabled := CheckInvoke.Checked;
	SheetScript.TabVisible := CheckInvoke.Checked;
    SheetMini.TabVisible := CheckInvoke.Checked;
    CheckPrint.Enabled := CheckInvoke.Checked;
    CheckPrompt.Enabled := CheckPrint.Enabled;
{    EditScriptCommand.Enabled := CheckInvoke.Checked;
    CheckAssignCommand.Enabled := CheckInvoke.Checked and (Length(EditScriptCommand.text) > 0);
    EditScriptSwitch.Enabled := CheckInvoke.Checked;
    CheckAssignSwitch.Enabled := CheckInvoke.Checked and (Length(EditScriptSwitch.text) > 0);
    EditScriptParam.Enabled := CheckInvoke.Checked;
    CheckAssignParam.Enabled := CheckInvoke.Checked and (Length(EditScriptParam.text) > 0);
}
    CheckSafe.Enabled := CheckPrint.Enabled and not CheckSafe.Checked;
    if CheckInvoke.Checked then
    begin
    	CheckPrintClick(nil);
        CheckPromptClick(nil);
    end;

end;


procedure TEmulationForm.CheckPrintClick(Sender: TObject);
begin
	if CheckPrint.Checked then
    	FPrintCommand.Tcl := FCommand.Tcl
    else
    	FPrintCommand.Tcl := nil;
end;

procedure TEmulationForm.CheckPromptClick(Sender: TObject);
begin
	if CheckPrompt.Checked then
    	FPromptCommand.Tcl := FCommand.Tcl
    else
    	FPromptCommand.Tcl := nil;
end;

procedure TEmulationForm.CheckSafeClick(Sender: TObject);
var
	ok: boolean;
begin
	if CheckSafe.Checked then
    begin
    	ok := False;
    	if Assigned(FCommand.Tcl) and (MessageDlg(
        	'You are about to remove native Tcl commands that are catagorized as unsafe ' +
     format('from the current interpreter owned by %s. Unsafe commands are typically ', [FCommand.Tcl.Name]) +
        	'those that may harm the application or violate security policies. The TTcl.Safe ' +
            'property will not be toggled. To reactivate the full native Tcl command set ' +
            'for the current interpreter, it will be necessary to reopen the TTcl component. ' +
            'Continue to make the current interpreter safe?',
            mtInformation, mbYesNoCancel, 0) = mrYes) then
        try
			Tcl_MakeSafe(FCommand.Tcl.Interp);
		    CheckSafe.Enabled := False;
            ok := True;
        except
        	on E:Exception do
				MessageDlg(E.Message, mtError, [mbOK], 0);
        end;
        if not ok then
        begin
	        CheckSafe.OnClick := nil;
            try
    	    	CheckSafe.Checked := False;
        	finally
        		CheckSafe.OnClick := CheckSafeClick;
	        end;
            exit;
        end;
    end;
end;

procedure TEmulationForm.EditScriptSwitchChange(Sender: TObject);
var
	idx: integer;
begin
	if SettingSwitches then
    	exit;
	idx := ComboSwitches.itemIndex;
    if idx < 0 then
    	exit;
    with FSwitchList.objects[idx] as TEvalSwitch do
    	Script := EditScriptSwitch.text;
    CheckAssignSwitch.Enabled := Length(EditScriptSwitch.text) > 0;
end;

procedure TEmulationForm.EditScriptParamChange(Sender: TObject);
var
	idx: integer;
begin
	if SettingSwitches then
    	exit;
	idx := ComboParams.itemIndex;
    if idx < 0 then
    begin
    	CheckAssignParam.Enabled := False;
    	exit;
    end;
    with FParamList.objects[idx] as TEvalParam do
    	Script := EditScriptParam.text;
    CheckAssignParam.Enabled := Length(EditScriptParam.text) > 0;
end;

procedure TEmulationForm.CheckAssignSwitchClick(Sender: TObject);
var
	idx: integer;
begin
	if SettingSwitches then
    	exit;
	idx := ComboSwitches.itemIndex;
    if idx < 0 then
    begin
		CheckAssignSwitch.Enabled := False;
    	exit;
    end;
    with FSwitchList.objects[idx] as TEvalSwitch do
    	Assign := CheckAssignSwitch.Checked;
end;

procedure TEmulationForm.CheckAssignParamClick(Sender: TObject);
var
	idx: integer;
begin
	if SettingSwitches then
    	exit;
	idx := ComboParams.itemIndex;
    if idx < 0 then
    	exit;
    with FParamList.objects[idx] as TEvalParam do
    	Assign := CheckAssignParam.Checked;
end;

procedure TEmulationForm.EditScriptCommandChange(Sender: TObject);
begin
	CheckAssignCommand.Enabled := Length(EditScriptCommand.text) > 0;
end;

function TEmulationForm.CurrentHelpTopic: string;
begin
	if PageControl1.ActivePage = SheetResults then
    	result := 'Emulation'
    else if PageControl1.ActivePage = SheetSettings then
        result := 'Emulation'
    else if PageControl1.ActivePage = SheetScript then
        result := 'Emulation'
	else
    	result := 'Emulation';
end;

procedure TEmulationForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
	if Key = VK_F1 then
    	DoHelp(CurrentHelpTopic);
end;

procedure TEmulationForm.BtnHelpClick(Sender: TObject);
begin
	DoHelp(CurrentHelpTopic);
end;

procedure TEmulationForm.EditPrefixChange(Sender: TObject);
begin
	if length(EditPrefix.Text) < 1 then
    	EditPrefix.Text := '-';
	FCommand.SwitchPrefixOther := EditPrefix.text[1];
end;

function EnumProc(Param: pointer; const FileName, UnitName, FormName: string): boolean; stdcall;
begin
	if ToolServices.GetModuleInterface(FileName) <> nil then
    	ShowMessage('Yes ' + FileName)
    else
    	ShowMessage('No ' + FileName + ' ' + UnitName + ' ' + FormName);
    result := True;

end;

end.
