{ -----------------------------------------------------------------------
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 uTslcIDE;

///////////////////////////////////////////////////////////////////////////////
//
//  TclDbTbl.pas
//	Copyright(c) 1996-1997 William Byrne
//		WilliamB@ByrneLitho.com
//		76262.13@CompuServe.com
//
//	All rights reserved.
//  	William Byrne makes no representations about the suitability of this
//    	software for any purpose.  It is provided "as is" without express or
//    	implied warranty.
//
//	Usage
//      I hereby grant to the legal purchasors of the source code contained
//      herein a non-exclusive license for the use of said source code in
//      developing compiled, executable software, and for the distribution of
//      said source code as part of said developed, compiled, executable software.
//
//  Purpose
//      Provides script commands that know how to communicate with IDE. Utilized by
//      by the primary TTcl component in TslcPad.pas via a TTclBridge. Macro emulation
//      is implemented by the MenuXXXX functions in TslcIDE.dcu
//
//      This file has not been groomed ???
//
//	Editor:
//		Tab stops = 4
//		Page width = 132 characters
//		Font = Courier New, 8pt
//
//  Misc:
//      ??? = Note to self


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Tslc, TslcPad, TclTk;

type
  TIDEMod = class(TDataModule)
    Tcl1: TTcl;
    TclCmd_IDE: TTclCommand;
    TclCmd_Macro: TTclCommand;
    TclCmd_Macro_c: TTclCmdSwitch;
    TclCmd_Macro_k: TTclCmdSwitch;
    TclCmd_Macro_s: TTclCmdSwitch;
    TclCmd_Macro_d: TTclCmdSwitch;
    TclCmd_Macro_i: TTclCmdSwitch;
    TclCmd_WarnActive: TTclCommand;
    TclCmd_Macro_f: TTclCmdSwitch;
    TclCmd_Macro_n: TTclCmdSwitch;
    TclCmd_IniFile: TTclCommand;
    TclCmd_Macro_v: TTclCmdSwitch;
    TclCmd_Macro_x: TTclCmdSwitch;
    procedure TclCmd_IDECommand(Sender: TTclCommand; var result: string;
      var success: Boolean);
    procedure TclCmd_MacroCommand(Sender: TTclCommand; var result: string;
      var success: Boolean);
    procedure TclCmd_MacroCreate(Sender: TTclCommand);
    procedure TclCmd_MacroDestroy(Sender: TTclCommand);
    procedure TclCmd_MacroPrepare(Sender: TTclCommand; var result: string; var success: boolean);
    procedure TclCmd_Macro_cSwitch(Sender: TTclCmdSwitch; ASwitch: string;
      var result: string; var success: Boolean);
    procedure TclCmd_Macro_kSwitch(Sender: TTclCmdSwitch; ASwitch: string;
      var result: string; var success: Boolean);
    procedure TclCmd_Macro_sSwitch(Sender: TTclCmdSwitch; ASwitch: string;
      var result: string; var success: Boolean);
    procedure TclCmd_Macro_dSwitch(Sender: TTclCmdSwitch; ASwitch: string;
      var result: string; var success: Boolean);
    procedure TclCmd_Macro_iSwitch(Sender: TTclCmdSwitch; ASwitch: string;
      var result: string; var success: Boolean);
    procedure TclCmd_WarnActiveCommand(Sender: TTclCommand;
      var result: string; var success: Boolean);
    procedure IDEModDestroy(Sender: TObject);
    procedure Tcl1BeforeOpen(Sender: TTcl);
    procedure Tcl1AfterInitInterp(Sender: TObject; AInterp: pTcl_Interp);
    procedure TclCmd_Macro_fSwitch(Sender: TTclCmdSwitch; ASwitch: string;
      var result: string; var success: Boolean);
    procedure TclCmd_Macro_nSwitch(Sender: TTclCmdSwitch; ASwitch: string;
      var result: string; var success: Boolean);
    procedure TclCmd_IniFileCommand(Sender: TTclCommand;
      var result: string; var success: Boolean);
    procedure TclCmd_Macro_vSwitch(Sender: TTclCmdSwitch; ASwitch: string;
      var result: string; var success: Boolean);
    procedure TclCmd_Macro_xSwitch(Sender: TTclCmdSwitch; ASwitch: string;
      var result: string; var success: Boolean);
    private
    { Private declarations }
        FPad: TScriptPad;
        FWhat: integer;
        FSplashForm: TForm;
        FClearPrinter: boolean;
        FTimeOpened: TDateTime;
        function EvalCallback(script: pChar): pChar;
        function QueryInterp(Sender: TObject): boolean;
        procedure CloseInterp(Sender: TObject);
        procedure ScriptDelete(Sender: TTclCommand; AInterp: pTcl_Interp);
        procedure BuildPad;
    public
        { Public declarations }
        procedure Execute;
    end;

procedure ExecuteScriptPad;
procedure EvalScript(script: string);
procedure EvalFile(filename: string);
procedure EvalIDEScript;
function ScriptPadShortCut(var caption: string; var key: word; var shift: TShiftState): boolean;
procedure SaveAllUnits;
function QueryInvocation: boolean;

var
    IDEMod: TIDEMod; // No need to initialize this. See LoadDataModule below.

const // Check top of TslcPad.pas for proper preprocessor definitions. This constant is simply a check.
	cCheckingTslcPadVersion = TslcPad.tslc_ide_compile;

	TSLC_IDE_VERSION_MAJOR = 1;
    TSLC_IDE_VERSION_MINOR = 0;
    TSLC_IDE_VERSION_ISSUE = 'a';
    TSLC_IDE_NAME = 'TslcIDE';

implementation
uses ToolIntf, ExptIntf, EditIntf, TslcPlat, TslcUtil, TslcIDE, StdCtrls, ExtCtrls, IniFiles;
{$R *.DFM}


function QueryInvocation: boolean;
begin
	result := TslcIDE.QueryInvocation;
end;


function VKStrToWord(value: string): word; forward;
function ScriptPadShortCut(var caption: string; var key: word; var shift: TShiftState): boolean;
begin
    caption := 'Scr&ipt';
    key := word('S');
    shift := [ssCtrl, ssAlt];
    result := True;
end;

procedure SaveAllUnits;
begin
	TslcIDE.SaveAllUnits;
end;


function LoadDataModule: boolean;
const
	UnrecoverableError: boolean = False;
var
    splashForm: TForm;
    panel: TPanel;
begin
	if UnrecoverableError then
    	raise Exception.Create('Unrecoverable Error Loading TslcIDE Scripting Module');
    result := IDEMod = nil;
    if result then
    begin
        splashForm := TForm.CreateNew(nil);
        with splashForm do
        try
            BorderStyle := bsNone;
            BorderIcons := [];
            Caption := '';
            FormStyle := fsStayOnTop;
            Position := poScreenCenter;
            Width := 150;
            Height := 50;
            panel := TPanel.Create(splashForm);
            with panel do
            begin
                Align := alClient;
                Caption := 'Initializing Tcl Engine...';
                BevelInner := bvLowered;
                BorderWidth := 4;
            end;
            InsertControl(panel);
            Show;
            Update;
            IDEMod := TIDEMod.Create(nil);
        except
			UnrecoverableError := True;
            splashForm.Free;
            raise;
        end;
        IDEMod.FSplashForm := splashForm;
    end;
end;

procedure InitDataModule;
begin
	if LoadDataModule then
    begin
    	IDEMod.FSplashForm.Free;
        IDEMod.FSplashForm := nil;
    end;
end;

// Safely wrapped by caller.
procedure ExecuteScriptPad;
begin
	LoadDataModule;
    IDEMod.Execute;
end;

procedure EvalScript(script: string);
var
	taskList: pointer;
begin
	InitDataModule;
    with IDEMod do
    begin
    	BuildPad;
    	taskList := DisableTaskWindows(FPad.Handle);
	    try
    	    if not FPad.Tcl1.Eval(script) then
        	    MessageBox(0, pChar(FPad.Tcl1.Result), 'Script Error', MB_OK or MB_ICONSTOP);
        finally
        	EnableTaskWindows(taskList);
        end;
    end;
end;

procedure EvalFile(filename: string);
var
	taskList: pointer;
begin
	InitDataModule;
    with IDEMod do
    begin
    	BuildPad;
    	taskList := DisableTaskWindows(FPad.Handle);
		try
	        if not FPad.Tcl1.EvalFile(filename) then
    	        MessageBox(0, pChar(FPad.Tcl1.Result), 'Script Error', MB_OK or MB_ICONSTOP);
        finally
        	EnableTaskWindows(taskList);
        end;
    end;
end;


//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
type
    TTclCommandIntf = class(TTclCommand)
    public
        destructor Destroy; override;
        procedure CleanUp; virtual; abstract;
    end;

    TTclCommandModIntf = class(TTclCommandIntf)
    private
        FModIntf: TIModuleInterface;
    protected
        procedure DoCommand(var newValue: string; var success: boolean); override;
    public
        constructor Create(AOwner: TComponent; mi: TIModuleInterface);
        procedure CleanUp; override;
    end;

    TTclCommandEditIntf = class(TTclCommandIntf)
    private
        FEditIntf: TIEditorInterface;
        FTabWidth: integer;
		// tab width for Strings
        procedure _t(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
    protected
        procedure DoCommand(var newValue: string; var success: boolean); override;
        procedure DoPrepare(var result: string; var success: boolean); override;
        function CalcPos(line, col: integer): integer; // components require 32bit so integer is ok for pos.
    public
        constructor Create(AOwner: TComponent; ei: TIEditorInterface);
        procedure CleanUp; override;
    end;

    TTclCommandReader = class(TTclCommandIntf)
    private
        FEditReader: TIEditReader;
        FAppend: boolean;
        // append Tcl variable
        procedure _a(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
    protected
        procedure DoCommand(var newValue: string; var success: boolean); override;
        procedure DoPrepare(var result: string; var success: boolean); override;
    public
        constructor Create(AOwner: TComponent; er: TIEditReader);
        procedure CleanUp; override;
    end;

    TTclCommandWriter = class(TTclCommandIntf)
    private
        FEditWriter: TIEditWriter;
    protected
        procedure DoCommand(var newValue: string; var success: boolean); override;
    public
        constructor Create(AOwner: TComponent; ew: TIEditWriter);
        procedure CleanUp; override;
    end;


    TTclCommandView = class(TTclCommandIntf)
    private
        FEditView: TIEditView;
        FView: boolean;
        procedure _v(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
    protected
        procedure DoCommand(var newValue: string; var success: boolean); override;
        procedure DoPrepare(var result: string; var success: boolean); override;
    public
        constructor Create(AOwner: TComponent; ev: TIEditView);
        procedure CleanUp; override;
    end;

    TTclCommandStrings = class(TTclCommand)
    private
    	FStrings: TStrings;
    protected
        procedure DoCommand(var newValue: string; var success: boolean); override;
        procedure DoPrepare(var result: string; var success: boolean); override;
	public
    	constructor Create(AOwner: TComponent; ei: TIEditorInterface; tabWidth: integer);
		destructor Destroy; override;
    end;

{~~~ TTclCommandIntf ~~~}
destructor TTclCommandIntf.Destroy;
begin
    CleanUp;
    inherited Destroy;
end;

{~~~ TTclCommandModIntf ~~~}
constructor TTclCommandModIntf.Create(AOwner: TComponent; mi: TIModuleInterface);
begin
    inherited Create(AOwner);
    FModIntf := mi;
    ErrorMsg := 'Syntax: ModIntf...';
end;

procedure TTclCommandModIntf.CleanUp;
begin
    FModIntf.Free;
    FModIntf := nil;
end;

procedure TTclCommandModIntf.DoCommand(var newValue: string; var success: boolean);
var
    cnt: integer;
    param: string;
begin
    cnt := ParamValuesCount;
    if cnt < 1 then
        TclError(ErrorMsg);
    param := ParamValues[0];
    if TslcTextEqual(param, 'Editor') then
    begin
        if cnt < 2 then
            TclError(ErrorMsg);
        with TTclCommandEditIntf.Create(Owner, FModIntf.GetEditorInterface) do
        begin
            Command := Self.ParamValues[1];
            Tcl := self.Tcl;
        end;
        exit;
    end;
    if TslcTextEqual(param, 'Free') then
    begin
        Free;
        exit;
    end;
    inherited DoCommand(newValue, success);
end;


{~~~ TTclCommandEditIntf ~~~}
constructor TTclCommandEditIntf.Create(AOwner: TComponent; ei: TIEditorInterface);
begin
    inherited Create(AOwner);
    FEditIntf := ei;
    ErrorMsg := 'Syntax: EditIntf...';
    with TTclCmdSwitch.Create(AOwner) do
    begin
        Switch := 't';
        OnSwitch := _t;
        Command := Self;
    end;
end;

procedure TTclCommandEditIntf.CleanUp;
begin
    FEditIntf.Free;
    FEditIntf := nil;
end;

function TTclCommandEditIntf.CalcPos(line, col: integer): integer;
var
    er: TIEditReader;
    buf: array[0..1023] of char;
    x, actual, pos, offset: integer;
begin
    dec(line);
    dec(col);
    er := FEditIntf.CreateReader;
    if er <> nil then
    try
        pos := 0;
        actual := 1024;
        offset := 1024;
        if line > 0 then
        repeat
            actual := er.GetText(pos, buf, 1024);
            for x:= 0 to actual - 1 do
                if buf[x] = #13 then
                begin
                    dec(line);
                    if line <= 0 then
                    begin
                        offset := x;
                        inc(offset);
                        if (offset < actual) and (buf[offset] = #10) then
                            inc(offset);
                        inc(pos, offset);
                        break;
                    end;
                end;
            if line <= 0 then
                break;
               inc(pos, actual);
        until actual < 1024;


        if line <= 0 then // if this logic is changed, watch out for value of offset.
        begin
            repeat
                dec(actual);
                while (offset <= actual) and (col > 0) and (buf[offset] <> #13) do
                begin
                    inc(offset);
                    inc(pos);
                    dec(col);
                 end;
                if col <= 0 then // don't test buf until we know offset is in buf range.
                    break
                else if offset >= actual then
                begin
                    actual := er.GetText(pos, buf, 1024);
                    offset := 0;
                end else // must of hit EOL
                    break;
            until actual <= 0;
        end;
        result := pos;
    finally
        er.Free;
    end;
end;

procedure TTclCommandEditIntf._t(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	FTabWidth := TslcStrToInt(Sender.SplitDef(ASwitch, '8'));
end;

procedure TTclCommandEditIntf.DoPrepare(var result: string; var success: boolean);
begin
	FTabWidth := 0;
end;

procedure TTclCommandEditIntf.DoCommand(var newValue: string; var success: boolean);
var
    cnt, n: integer;
    param: string;
begin
    cnt := ParamValuesCount;
    if cnt < 1 then
        TclError(ErrorMsg);
    param := ParamValues[0];
    if TslcTextEqual(param, 'Reader') then
    begin
        if cnt < 2 then
            TclError(ErrorMsg);
        with TTclCommandReader.Create(Owner, FEditIntf.CreateReader) do
        begin
            Command := Self.ParamValues[1];
            Tcl := self.Tcl;
        end;
        exit;
    end;
    if TslcTextEqual(param, 'Writer') then
    begin
        if cnt < 2 then
            TclError(ErrorMsg);
        with TTclCommandWriter.Create(Owner, FEditIntf.CreateWriter) do
        begin
            Command := Self.ParamValues[1];
            Tcl := self.Tcl;
        end;
        exit;
    end;
    if TslcTextEqual(param, 'CalcPos') then
    begin
        if cnt < 3 then
            TclError(ErrorMsg);
        newValue := inttostr(CalcPos(TslcStrToInt(ParamValues[1]), TslcStrToInt(ParamValues[2])));
        exit;
    end;
    if TslcTextEqual(param, 'ViewCount') then
    begin
        if cnt > 1 then
            TclError(ErrorMsg);
        newValue := inttostr(FEditIntf.GetViewCount);
        exit;
    end;
    if TslcTextEqual(param, 'View') then
    begin
        if cnt > 3 then
            TclError(ErrorMsg);
        if cnt > 2 then
            n := TslcStrToInt(ParamValues[2])
        else
            n := 0;
        with TTclCommandView.Create(Owner, FEditIntf.GetView(n)) do
        begin
            Command := Self.ParamValues[1];
            Tcl := self.Tcl;
        end;
        exit;
    end;
    if TslcTextEqual(param, 'Strings') then
    begin
    	if cnt < 2 then
        	TclError(ErrorMsg);
        with TTclCommandStrings.Create(Owner, FEditIntf, FTabWidth) do
        begin
        	Command := Self.ParamValues[1];
            Tcl := self.Tcl;
        end;
        exit;
    end;
    if TslcTextEqual(param, 'Free') then
    begin
        Free;
        exit;
    end;
    inherited DoCommand(newValue, success);
end;

{~~~ TTclCommandReader ~~~}
constructor TTclCommandReader.Create(AOwner: TComponent; er: TIEditReader);
begin
    inherited Create(AOwner);
    FEditReader := er;
    ErrorMsg := 'Syntax: EditReader...';
    with TTclCmdSwitch.Create(AOwner) do
    begin
        Switch := 'a';
        CanAppend := False;
        OnSwitch := _a;
        Command := Self;
    end;
end;

procedure TTclCommandReader.CleanUp;
begin
    FEditReader.Free;
    FEditReader := nil;
end;

procedure TTclCommandReader._a(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
var
    str: string;
begin
    str := Sender.Split(ASwitch);
    if str = '' then
        FAppend := True
    else
        FAppend := TslcStrTruth(str);
end;

procedure TTclCommandReader.DoCommand(var newValue: string; var success: boolean);
const
    MAX_BUF = 1023;
var
    cnt: integer;
    param: string;
    len: integer;
    buf: array[0..MAX_BUF] of char;
    pos: longint;
begin
    cnt := ParamValuesCount;
    if cnt < 1 then
        TclError(ErrorMsg);
    param := ParamValues[0];
    if TslcTextEqual(param, 'Text') or TslcTextEqual(param, 'Read') then
    begin
        if cnt < 4 then
            TclError(ErrorMsg);
           pos := TslcStrToInt(ParamValues[1]);
        len := TslcStrToInt(ParamValues[3]);
        if len > MAX_BUF then
            TclError('Reader: request too large...');
        len := FEditReader.GetText(pos, buf, len);
        buf[len] := #0;
        if FAppend then
            SetVar(Interp, ParamValues[2], '', buf, [tfAppendValue])
        else
            SetVar(Interp, ParamValues[2], '', buf, []);
        newValue := inttostr(len);
        exit;
    end;
    if TslcTextEqual(param, 'Free') then
    begin
        Free;
        exit;
    end;
    inherited DoCommand(newValue, success);
end;

procedure TTclCommandReader.DoPrepare(var result: string; var success: boolean);
begin
    FAppend := False;
end;

{~~~ TTclCommandWriter ~~~}
constructor TTclCommandWriter.Create(AOwner: TComponent; ew: TIEditWriter);
begin
    inherited Create(AOwner);
    FEditWriter := ew;
    ErrorMsg := 'Syntax: EditReader...';
end;

procedure TTclCommandWriter.CleanUp;
begin
    FEditWriter.Free;
    FEditWriter := nil;
end;

procedure TTclCommandWriter.DoCommand(var newValue: string; var success: boolean);
const
    BoolVal: array[False..True] of string[1] = ('0', '1');
var
    cnt: integer;
    param: string;
begin
    cnt := ParamValuesCount;
    if cnt < 1 then
        TclError(ErrorMsg);
    param := ParamValues[0];
    if TslcTextEqual(param, 'CopyTo') then
    begin
        if cnt < 2 then
            TclError(ErrorMsg);
        newValue := BoolVal[FEditWriter.CopyTo(TslcStrToInt(ParamValues[1]))];
        exit;
    end;
    if TslcTextEqual(param, 'DeleteTo') then
    begin
        if cnt < 2 then
            TclError(ErrorMsg);
        newValue := BoolVal[FEditWriter.DeleteTo(TslcStrToInt(ParamValues[1]))];
        exit;
    end;
    if TslcTextEqual(param, 'Insert') then
    begin
        if cnt < 2 then
            TclError(ErrorMsg);
        newValue := BoolVal[FEditWriter.Insert(pChar(ParamValues[1]))];
        exit;
    end;
    if TslcTextEqual(param, 'Pos') then
    begin
        newValue := inttostr(FEditWriter.Position);
        exit;
    end;
    if TslcTextEqual(param, 'Free') then
    begin
        Free;
        exit;
    end;
    inherited DoCommand(newValue, success);
end;


{~~~ TTclCommandView ~~~}
constructor TTclCommandView.Create(AOwner: TComponent; ev: TIEditView);
begin
    inherited Create(AOwner);
    FEditView := ev;
    ErrorMsg := 'Syntax: EditView...';
    with TTclCmdSwitch.Create(AOwner) do
    begin
        Switch := 'v';
        OnSwitch := _v;
        Command := self;
    end;
end;

procedure TTclCommandView._v(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
var
    str: string;
begin
    str := Sender.Split(ASwitch);
    if str = '' then
        FView := True
    else
        FView := TslcStrTruth(str);
end;

procedure TTclCommandView.CleanUp;
begin
    FEditView.Free;
    FEditView := nil;
end;

//  PSize = ^TSize;
//  TSize = record
//    cx: Longint;
//    cy: Longint;
//  end;

procedure TTclCommandView.DoCommand(var newValue: string; var success: boolean);
    function EditPos(col, line: integer): TEditPos;
    begin
        result.col := col;
        result.line := line;
    end;
var
    cnt, n: integer;
    param: string;
begin
    cnt := ParamValuesCount;
    if cnt < 1 then
        TclError(ErrorMsg);
    param := ParamValues[0];
    if TslcTextEqual(param, 'col') then
    begin
        if cnt > 2 then
            TclError(ErrorMsg);
        newValue := inttostr(FEditView.GetPos(integer(FView)).Col);
        if cnt > 1 then
            FEditView.SetPos(integer(FView), EditPos(TslcStrToInt(ParamValues[1]),FEditView.GetPos(integer(FView)).line));
        exit;
    end;
    if TslcTextEqual(param, 'line') then
    begin
        if cnt > 2 then
            TclError(ErrorMsg);
        newValue := inttostr(FEditView.GetPos(integer(FView)).line);
        if cnt > 1 then
            FEditView.SetPos(integer(FView), EditPos(FEditView.GetPos(integer(FView)).col,TslcStrToInt(ParamValues[1])));
        exit;
    end;
    if TslcTextEqual(param, 'viewsize') then
    begin
        if cnt > 2 then
            TclError(ErrorMsg);
        if cnt > 1 then
        begin
            if TslcTextEqual(ParamValues[1], 'x') then
                newValue := inttostr(FEditView.GetViewSize.cx)
            else if TslcTextEqual(ParamValues[1], 'y') then
                newValue := inttostr(FEditView.GetViewSize.cy)
            else
                TclError(ErrorMsg);
        end else
            newValue := Format('%d,%d',[FEditView.GetViewSize.cx, FEditView.GetViewSize.cy]);
        exit;
    end;
    if TslcTextEqual(param, 'Free') then
    begin
        Free;
        exit;
    end;
    inherited DoCommand(newValue, success);
end;

procedure TTclCommandView.DoPrepare(var result: string; var success: boolean);
begin
    FView := False;
end;

{~~~ TTclCommandStrings ~~~}

procedure TabSetString(var str: string; strLen: integer; buf: pChar; bufLen: integer; tabWidth: integer);
var
	p, q: pChar;
    t, x, y: integer;
begin
	if tabWidth < 1 then
    begin
    	SetString(str, buf, strLen);
        exit;
    end;
	SetString(str, nil, strLen);
    q := buf;
    p := pChar(str);
    t := tabWidth - 1;
    for x:= 0 to bufLen - 1 do
	begin
    	if q^ = #9 then
			for y := 0 to t do
            begin
            	p^ := ' ';
                inc(p);
            end
        else
        begin
        	p^ := q^;
	        inc(p);
        end;
        inc(q);
    end;
    SetLength(str, strLen); // Who writes the null
end;

constructor TTclCommandStrings.Create(AOwner: TComponent; ei: TIEditorInterface; tabWidth: integer);
const
	MAX_BUF_SIZE = 1024;
var
	er: TIEditReader;
    buf: array[0..MAX_BUF_SIZE - 1] of char; // this should always be large enough to hold the largest editor line or error will result.
    x, p, q, pos, actual, t: integer;
    lastBufChar13, eol: boolean;
    str: string;
    c: char;
begin
	inherited Create(AOwner);
    ErrorMsg := 'Syntax: <?Strings?> ...'; // too vague ???
    FStrings := TStringList.Create;
    er := ei.CreateReader;
    if er = nil then
    	TclError('Unable to create reader');
    try
		pos := 0;
        t := 0;
        lastBufChar13 := False;
        repeat
	        actual := er.GetText(pos, buf, MAX_BUF_SIZE);
			if lastBufChar13 and (actual > 0) and (buf[0] = #10) then
	            p := 1
	        else
	        	p := 0;
	        inc(pos, p);
	        lastBufChar13 := false;
	        repeat
			    eol := false;
	 	    	for x:= p to actual - 1 do
                begin
                	c := buf[x];
//		        	if buf[x] = #13 then
					if c in [#10,#13] then
		            begin
		            	eol := true;
						TabSetString(str, x - p + t, buf + p, x - p, tabWidth);
		                FStrings.AddObject(str, TObject(pos));
		                q := p;
	            	    p := x;
		                inc(p);
		                if p = actual then
                        begin
                        	if c = #13 then
			                	lastBufChar13 := true;
                        end else if (buf[p] = #10) and (c = #13) then
		                	inc(p);
		                inc(pos, p - q);
                        t := 0;
		                break;
		            end else if (c = #9) and (tabWidth > 0) then
                    	inc(t, tabWidth - 1);
				end;
			until not eol;
	    	if p <= 1 then
	        	TclError('Unable to string file - line too long');
		until actual < MAX_BUF_SIZE;
        if not eol then
        begin
        	TabSetString(str, actual - p + t,  buf + p, actual - p, tabWidth);
        	FStrings.addObject(str, TObject(pos));
        end;
	finally
    	er.free;
    end;
end;

destructor TTclCommandStrings.Destroy;
begin
	FStrings.Free;
	inherited Destroy;
end;

procedure TTclCommandStrings.DoCommand(var newValue: string; var success: boolean);
var
	cnt: integer;
    prm: string;
begin
	cnt := ParamValuesCount;
	if cnt < 1 then
    	TclError(ErrorMsg);
    prm := ParamValues[0];
	if TslcTextEqual(prm, 'LINE') then
    begin
		if cnt < 2 then
        	TclError(ErrorMsg);
        newValue := FStrings.strings[TslcStrToInt(ParamValues[1]) - 1];
        if cnt > 2 then // don't antipate. If common, assign index to var instead of two conversions
        	FStrings.strings[TslcStrToInt(ParamValues[1]) - 1] := ParamValues[2];
        exit;
    end;
    if TslcTextEqual(prm, 'Count') then
    begin
    	newValue := inttostr(FStrings.Count);
    	exit;
    end;
    if TslcTextEqual(prm, 'Pos') then
    begin
		if cnt < 2 then
        	TclError(ErrorMsg);
    	newValue := inttostr(integer(FStrings.objects[TslcStrToInt(ParamValues[1]) - 1]));
        exit;
    end;
    if TslcTextEqual(prm, 'Free') then
    begin
    	Free;
        exit;
    end;
    TclError(ErrorMsg);
end;

procedure TTclCommandStrings.DoPrepare(var result: string; var success: boolean);
begin
end;


{~~~ TIDEMod ~~~}
{$IFDEF TCL_ERRORLINE}
var
	ErrorBuffer: array[0..511] of char;

const
    cErrFormat = 'Error Line: %d' + #13;
    cErrAvailBuf = sizeof(ErrorBuffer) - (sizeof(cErrFormat) + 8);
{$ENDIF}

function TIDEMod.EvalCallback(script: pChar): pChar;
begin
    if FPad = nil then
    begin
    	result := 'No interpreter';
        exit;
    end;
    if not FPad.Tcl1.Eval(script) and (FPad.Tcl1.Result = '') then
        result := 'Error: No message returned'
{$IFDEF TCL_ERRORLINE}
    else if (FPad.Tcl1.Error <> 0) and (FPad.Tcl1.Interp.ErrorLine > 0) then
    begin
        result := FPad.Tcl1.Interp.Result;
        if strlen(result) <= cErrAvailBuf then
        begin
        	strpcopy(ErrorBuffer, format(cErrFormat, [FPad.Tcl1.Interp.ErrorLine]));
            result := strcat(ErrorBuffer, result);
        end;
    end
{$ENDIF}
    else
    	result := FPad.Tcl1.Interp.Result; // Gets a pChar instead of string that Tcl1.Result would return.
end;

procedure TIDEMod.BuildPad;
begin
	if FPad <> nil then
    	exit;
    try
        FPad := TScriptPad.Create(nil);
        FPad.BorderStyle := bsSizeToolWin;
    finally
        if FSplashForm <> nil then
        begin
            FSplashForm.Free;
            FSplashForm := nil;
        end;
    end;
    FPad.OnEvaluate := EvalCallback;
    FPad.OnQueryInterp := QueryInterp;
    FPad.OnCloseInterp := CloseInterp;
end;


procedure TIDEMod.Execute;
begin
	BuildPad;
    FPad.Show;
end;

function TIDEMod.QueryInterp(Sender: TObject): boolean;
begin
	if FPad <> nil then
		result := FPad.Tcl1.Active
    else
    	result := False;
end;

procedure TIDEMod.CloseInterp(Sender: TObject);
begin
	if FPad <> nil then
		FPad.Tcl1.Active := False;
end;

procedure TIDEMod.ScriptDelete(Sender: TTclCommand; AInterp: pTcl_Interp);
begin
    with Sender as TTclCommandIntf do
        CleanUp;
end;

function CheckGetModuleIndex(str: string): integer;
begin
    result := TslcStrToInt(str);
    if (result < 0) or (result >= ToolServices.GetModuleCount) then
        TclError('Module index out of range');
end;

function CheckGetUnitIndex(str: string): integer;
begin
    result := TslcStrToInt(str);
    if (result < 0) or (result >= ToolServices.GetUnitCount) then
        TclError('Unit index out of range');
end;

function CreateStreamModule(str: string): TMemoryStream;
var
    buf:array[0..511] of char;
    actual: integer;
    pos: longint;
    mi: TIModuleInterface;
    ei: TIEditorInterface;
    fi: TIFormInterface;
    er: TIEditReader;
begin
    result := nil;
    if not ToolServices.IsFileOpen(str) then
        exit;
    result := TMemoryStream.Create;
    try
        mi := ToolServices.GetModuleInterface(str);
        if mi <> nil then
        try
              ei := mi.GetEditorInterface;
            if ei <> nil then
            try
                er := ei.CreateReader;
                if er <> nil then
                try
                    pos := 0;
                    repeat
                        actual := er.GetText(pos, buf, 512);
                        inc(pos, actual);
                        result.write(buf, actual);
                    until actual < 512;
                finally
                    er.free;
                end;
            finally
                ei.free;
            end;
        finally
            mi.free;
        end;
    except
        on E:Exception do
        begin
            result.free;
            TclError(E.Message);
        end;
    end;
end;

procedure MenuAction(values: array of word);
var
	hwnd: integer;
    x: integer;
   	procedure stroke(value: word);
    begin
        PostMessage(hwnd, WM_KEYDOWN, value, 0);
		if (value < 48) or (value > 90) then
//		if x < high(values) then
	        PostMessage(hwnd, WM_KEYUP, value, 0);
    end;
begin
	hwnd := DelphiHandle;
    if hwnd = 0 then
    	TclError('Unable to get window handle');
    SetActiveWindow(hwnd);
	for x:= 0 to high(values) do
    	if values[x] = 0 then
        	break
        else
	    	stroke(values[x]);
end;

{~~~ IDE ~~~}
procedure TIDEMod.TclCmd_IDECommand(Sender: TTclCommand;
  var result: string; var success: Boolean);
const
    doShow: boolean = false; // MessageBox for Result var ?Y/N?
    cMaxWords = 25;
var
    cnt, idx, code, x: integer;
    prm, str: string;
    strm: TMemoryStream;
    mi: TIModuleInterface;
    wordbuf: array[0..cMaxWords - 1] of word;
begin

// The next statement deals with problems between ToolIntf and top editor file in form view mode.
// Limited documentation/support.
// The workaround is to close or swap active form to a dfm view using TslcIDE.SwapActiveForm
	if not SwapActiveForm then
    	TclError('Aborting at IDE:SwapActiveForm');


    cnt := Sender.ParamValuesCount;
    prm := Sender.ParamValues[0];
    if TslcTextEqual(prm, 'PROMPT') then
        doShow := not doShow
    else if TslcTextEqual(prm, 'TOOLS') then
    begin
        if cnt < 2 then
            TclError(Sender.ErrorMsg);
        prm := Sender.ParamValues[1];
        if TslcTextEqual(prm, 'CURRENTNAME') then
            try
                result := ToolServices.GetCurrentFile;
            except
                on Exception do
                    TclError('Unable to get filename');
            end
        else if TslcTextEqual(prm, 'UNITCOUNT') then
            result := inttostr(ToolServices.GetUnitCount)
        else if TslcTextEqual(prm, 'UNITNAME') then
        begin
            if cnt <> 3 then
                TclError(Sender.ErrorMsg);
            idx := CheckGetUnitIndex(Sender.ParamValues[2]);
            result := ToolServices.GetUnitName(idx);
        end else if TslcTextEqual(prm, 'OPEN') then
        begin
        	if cnt <> 3 then
            	TclError(Sender.ErrorMsg);
            ToolServices.OpenFile(Sender.ParamValues[2]);
        end else if TslcTextEqual(prm, 'CLOSE') then
        begin
        	if cnt <> 3 then
            	TclError(Sender.ErrorMsg);
            ToolServices.CloseFile(Sender.ParamValues[2]);
	    end else if TslcTextEqual(prm, 'MODULECOUNT') then
            result := inttostr(ToolServices.GetModuleCount)
        else if TslcTextEqual(prm, 'MODULENAME') then
        begin
            if cnt < 3 then
                TclError(Sender.ErrorMsg);
            idx := CheckGetModuleIndex(Sender.ParamValues[2]);
            result := ToolServices.GetModuleName(idx);
//        end else if TslcTextEqual(prm, 'EnumModules') then
//        begin
        end else if TslcTextEqual(prm, 'PROJECTNAME') then
        	result := ToolServices.GetProjectName
        else if TslcTextEqual(prm, 'LOADCURRENT') then
        begin
            if cnt < 3 then
                TclError(Sender.ErrorMsg);
            try
                str := ToolServices.GetCurrentFile;
            except
                on Exception do
                    TclError('Unable to open file')
            end;
             strm := CreateStreamModule(str);
            if strm <> nil then
               try
                SetVar(Sender.Interp, Sender.ParamValues[2], '', pChar(strm.Memory), []);
                result := inttostr(strm.size);
            finally
                strm.free;
            end else
                TclErrorFmt('Unable to load %s', [str]);
        end else if TslcTextEqual(prm, 'MODULE') then
        begin
            if cnt < 3 then
                TclError(Sender.ErrorMsg);
            try
                str := ToolServices.GetCurrentFile;
            except
                on Exception do
                    TclError('Unable to open file')
            end;
			if not ToolServices.IsFileOpen(str) then
            	TclErrorFmt('Unable to open file: %s', [str]);
            mi := ToolServices.GetModuleInterface(str);
            if mi = nil then
                TclErrorFmt('Unable to open module: %s', [str]);
            with TTclCommandModIntf.Create(Sender.Owner, mi) do
            begin
                Command := Sender.ParamValues[2];
                Tcl := Sender.Tcl;
                OnScriptDelete := ScriptDelete;
            end;
            exit;
        end else if TslcTextEqual(prm, 'CREATEMODULE') then // This could be expanded
        begin
            if cnt < 3 then
                TclError(Sender.ErrorMsg);
            ToolServices.CreateModule(Sender.ParamValues[2], nil, nil, [cmExisting, cmAddToProject]);
            exit;
        end else if TslcTextEqual(prm, 'OPENFORM') then
        begin
            if cnt <> 4 then
                TclError(Sender.ErrorMsg);
            OpenForm(Sender.ParamValues[2], TslcStrTruth(Sender.ParamValues[3]));
            exit;
        end else
            TclError(Sender.ErrorMsg);
    end else if TslcTextEqual(prm, 'FOCUSEDITOR') then
		FocusEditor
	else if TslcTextEqual(prm, 'FOCUSPAD') then
    begin
    	if FPad <> nil then
        	FPad.Show;
	end else if TslcTextEqual(prm, 'MENU') then
    begin
        for x:= 1 to cMaxWords do
        	if x < cnt then
            	wordbuf[x-1] := VKStrToWord(Sender.ParamValues[x])
            else
            begin
            	wordbuf[x-1] := 0; // zero value stops MenuAction processing
                break;
            end;
        MenuAction(wordbuf);
	end else if TslcTextEqual(prm, 'PROCESSMESSAGES') then
    	ProcessMessages
    else if TslcTextEqual(prm, 'APPHANDLE') then
		result := inttostr(DelphiHandle)
    else if TslcTextEqual(prm, 'OPENPROJECT') then
    begin
        if cnt <> 2 then
        	TclError(Sender.ErrorMsg);
        ToolServices.OpenProject(Sender.ParamValues[1]);
    end else
        TclError(Sender.ErrorMsg);
    if  DoShow then
        MessageBox(0, pChar(result), '', MB_OK);
end;


{~~~ Macro ~~~}
type
    TMacroData = class
        shift: TShiftState;
        caption: string;
        key: word;
        formSensitive, formSensitiveSet: boolean;
		subCommand: boolean;
    end;

procedure TIDEMod.TclCmd_MacroCommand(Sender: TTclCommand;
  var result: string; var success: Boolean);
var
	cnt, idx: integer;
    data: TMacroData;
begin
	cnt := Sender.ParamValuesCount;
	with Sender do
    begin
		data := ClientData as TMacroData;
        if data.subCommand then
        begin
        	if cnt < 2 then
            	TclError(ErrorMsg);
            if TslcTextEqual(ParamValues[0], 'INDEXOFCAPTION') then
            begin
            	result := inttostr(MacroIndexOfCaption(ParamValues[1]));
                exit;
            end;
            TclError(ErrorMsg);
        end;
    end;

    if cnt > 0 then
    with data do
    begin
        if (key = 0) or (caption = '') or (shift = []) then
            TclError(Sender.ErrorMsg);
		idx := MacroAdd(key, shift, caption, Sender.ParamValues[0]);
        result := inttostr(idx);
        if formSensitiveSet (* and not formSensitive *) then // Macros are form sensitive by default
        	MacroFormSensitive(idx, formSensitive); // If a script interacts with the IDE Editor, it
            // is very important that formSensitive is set. There are undocumented problems when
            // attempting to stream editor files that have an associated and active form. MacroFormSensitive
            // provides the means to make scripts *Form Aware* and will prompt the user under certain conditions.
            // Macros/scripts that do not interact with the IDE Editor can call MacroFormSensitive(idx, False)
            // to bypass checking of top level editor files and forms.
    end;
end;

procedure TIDEMod.TclCmd_MacroCreate(Sender: TTclCommand);
begin
    Sender.ClientData := TMacroData.Create;
end;

procedure TIDEMod.TclCmd_MacroDestroy(Sender: TTclCommand);
begin
    Sender.ClientData.Free;
end;

procedure TIDEMod.TclCmd_MacroPrepare(Sender: TTclCommand; var result: string; var success: boolean);
begin
    with Sender.ClientData as TMacroData do
    begin
        shift := [];
        caption := '';
        key := 0;
        formSensitiveSet := False;
        subCommand := False;
    end;
end;

procedure TIDEMod.TclCmd_Macro_cSwitch(Sender: TTclCmdSwitch;
  ASwitch: string; var result: string; var success: Boolean);
begin
    with Sender.Command.ClientData as TMacroData do
        caption := Sender.Split(ASwitch);
end;

procedure TIDEMod.TclCmd_Macro_fSwitch(Sender: TTclCmdSwitch;
  ASwitch: string; var result: string; var success: Boolean);
begin
	with Sender.Command.ClientData as TMacroData do
    begin
    	formSensitiveSet := True;
        formSensitive := TslcStrTruth(Sender.SplitDef(ASwitch, '+'));
    end;
end;

procedure TIDEMod.TclCmd_Macro_kSwitch(Sender: TTclCmdSwitch;
  ASwitch: string; var result: string; var success: Boolean);
var
    val: string;
begin
    with Sender.Command.ClientData as TMacroData do
    begin
        val := Sender.Split(ASwitch);
        if val = '' then
            TclError(Sender.Command.ErrorMsg);
        key := VKStrToWord(UpperCase(val));
    end;
end;

procedure TIDEMod.TclCmd_Macro_sSwitch(Sender: TTclCmdSwitch;
  ASwitch: string; var result: string; var success: Boolean);
var
    val: string;
begin
    with Sender.Command.ClientData as TMacroData do
    begin
        val := Sender.Split(ASwitch);
        if TslcTextEqual(val, 'SHIFT') then
            include(shift, ssShift)
        else if TslcTextEqual(val, 'CTRL') then
            include(shift, ssCtrl)
        else if TslcTextEqual(val, 'ALT') then
            include(shift, ssAlt)
        else
            TclError(Sender.Command.ErrorMsg);
    end;
end;

procedure TIDEMod.TclCmd_Macro_dSwitch(Sender: TTclCmdSwitch;
  ASwitch: string; var result: string; var success: Boolean);
begin
    MacroDelete( TslcStrToInt(Sender.Split(ASwitch)));
end;

procedure TIDEMod.TclCmd_Macro_iSwitch(Sender: TTclCmdSwitch;
  ASwitch: string; var result: string; var success: Boolean);
var
    str: string;
    idx: integer;
begin
    str := Sender.Split(ASwitch);
    if str = '' then
        result := inttostr(MacroCount)
    else
    begin
        idx := TslcStrToInt(str);
        if idx >= MacroCount then
            TclError('Macro index out of range');
        result := Format('ShortCut: %s, Caption: %s, Script: %s', [MacroShortCutStr(idx), MacroCaption(idx), MacroScript(idx)]);
    end;
end;

procedure TIDEMod.TclCmd_Macro_nSwitch(Sender: TTclCmdSwitch;
  ASwitch: string; var result: string; var success: Boolean);
begin
	result := inttostr(MacroCount);
end;

procedure EvalIDEScript;
var
	script: string;
begin
	if Application <> nil then
    begin
	   	script := ChangeFileExt(Application.ExeName, '.tcl');
   		if FileExists(script) then
   			EvalFile(script);
    end;
end;

procedure TIDEMod.TclCmd_WarnActiveCommand(Sender: TTclCommand;
  var result: string; var success: Boolean);
begin
	WarnActiveForm(TslcStrTruth(Sender.ParamValues[0])); // MinMax props guarantee one parameter
end;

procedure TIDEMod.IDEModDestroy(Sender: TObject);
begin
	FPad.Free;
    FPad := nil;
end;


const
	// ??? Hash these values ???
	vkListCount = 91;
	vkList: array[0..vkListCount-1,0..1] of pChar = (
	('VK_LBUTTON'	, pChar(1)),
	('VK_RBUTTON'	, pChar(2)),
	('VK_CANCEL'	, pChar(3)),
	('VK_MBUTTON'	, pChar(4)),
	('VK_BACK'	, pChar(8)),
	('VK_TAB'	, pChar(9)),
	('VK_CLEAR'	, pChar(12)),
	('VK_RETURN'	, pChar(13)),
	('VK_SHIFT'	, pChar($10)),
	('VK_CONTROL'	, pChar(17)),
	('VK_MENU'	, pChar(18)),
	('VK_PAUSE'	, pChar(19)),
	('VK_CAPITAL'	, pChar(20)),
	('VK_ESCAPE'	, pChar(27)),
	('VK_SPACE'	, pChar($20)),
	('VK_PRIOR'	, pChar(33)),
	('VK_NEXT'	, pChar(34)),
	('VK_END'	, pChar(35)),
	('VK_HOME'	, pChar(36)),
	('VK_LEFT'	, pChar(37)),
	('VK_UP'	, pChar(38)),
	('VK_RIGHT'	, pChar(39)),
	('VK_DOWN'	, pChar(40)),
	('VK_SELECT'	, pChar(41)),
	('VK_PRINT'	, pChar(42)),
	('VK_EXECUTE'	, pChar(43)),
	('VK_SNAPSHOT'	, pChar(44)),
	('VK_INSERT'	, pChar(45)),
	('VK_DELETE'	, pChar(46)),
	('VK_HELP'	, pChar(47)),
	('VK_LWIN'	, pChar(91)),
	('VK_RWIN'	, pChar(92)),
	('VK_APPS'	, pChar(93)),
	('VK_NUMPAD0'	, pChar(96)),
	('VK_NUMPAD1'	, pChar(97)),
	('VK_NUMPAD2'	, pChar(98)),
	('VK_NUMPAD3'	, pChar(99)),
	('VK_NUMPAD4'	, pChar(100)),
	('VK_NUMPAD5'	, pChar(101)),
	('VK_NUMPAD6'	, pChar(102)),
	('VK_NUMPAD7'	, pChar(103)),
	('VK_NUMPAD8'	, pChar(104)),
	('VK_NUMPAD9'	, pChar(105)),
	('VK_MULTIPLY'	, pChar(106)),
	('VK_ADD'	, pChar(107)),
	('VK_SEPARATOR'	, pChar(108)),
	('VK_SUBTRACT'	, pChar(109)),
	('VK_DECIMAL'	, pChar(110)),
	('VK_DIVIDE'	, pChar(111)),
	('VK_F1'	, pChar(112)),
	('VK_F2'	, pChar(113)),
	('VK_F3'	, pChar(114)),
	('VK_F4'	, pChar(115)),
	('VK_F5'	, pChar(116)),
	('VK_F6'	, pChar(117)),
	('VK_F7'	, pChar(118)),
	('VK_F8'	, pChar(119)),
	('VK_F9'	, pChar(120)),
	('VK_F10'	, pChar(121)),
	('VK_F11'	, pChar(122)),
	('VK_F12'	, pChar(123)),
	('VK_F13'	, pChar(124)),
	('VK_F14'	, pChar(125)),
	('VK_F15'	, pChar(126)),
	('VK_F16'	, pChar(127)),
	('VK_F17'	, pChar(128)),
	('VK_F18'	, pChar(129)),
	('VK_F19'	, pChar(130)),
	('VK_F20'	, pChar(131)),
	('VK_F21'	, pChar(132)),
	('VK_F22'	, pChar(133)),
	('VK_F23'	, pChar(134)),
	('VK_F24'	, pChar(135)),
	('VK_NUMLOCK'	, pChar(144)),
	('VK_SCROLL'	, pChar(145)),
	('VK_LSHIFT'	, pChar(160)),
	('VK_RSHIFT'	, pChar(161)),
	('VK_LCONTROL'	, pChar(162)),
	('VK_RCONTROL'	, pChar(163)),
	('VK_LMENU'	, pChar(164)),
	('VK_RMENU'	, pChar(165)),
	('VK_PROCESSKEY'	, pChar(229)),
	('VK_ATTN'	, pChar(246)),
	('VK_CRSEL'	, pChar(247)),
	('VK_EXSEL'	, pChar(248)),
	('VK_EREOF'	, pChar(249)),
	('VK_PLAY'	, pChar(250)),
	('VK_ZOOM'	, pChar(251)),
	('VK_NONAME'	, pChar(252)),
	('VK_PA1'	, pChar(253)),
	('VK_OEM_CLEAR'	, pChar(254)));


function VKStrToWord(value: string): word;
var
	x: integer;
begin
	result := 0;
	if length(value) = 1 then
    	result := Word(value[1])
    else for x:= 0 to vkListCount - 1 do
    	if TslcTextEqual(value, vkList[x,0]) then
        begin
        	result := word(vkList[x,1]);
            break;
        end;
end;

procedure TIDEMod.Tcl1BeforeOpen(Sender: TTcl);
begin
	TclError('Should not be using this interpreter');
end;

procedure TIDEMod.Tcl1AfterInitInterp(Sender: TObject;
  AInterp: pTcl_Interp);
var
	script: string;
	ver: string;
begin
	ver := format('%d.%d', [TSLC_IDE_VERSION_MAJOR, TSLC_IDE_VERSION_MINOR]);
	Tcl_PkgProvide(AInterp, TSLC_IDE_NAME, pChar(ver));
	if Application <> nil then
    begin
	   	script := ExtractFilePath(Application.ExeName) + 'NewInterp.tcl';
   		if FileExists(script) then
   			EvalFile(script);
    end;
end;

procedure OnClose;
begin
	if (IDEMod <> nil) and (IDEMod.FPad <> nil) then
    begin
		IDEMod.FPad.Free;
        IDEMod.FPad := nil;
    end;
end;

type
    TTclCommandIniFile = class(TTclCommand)
    private
		FIniFile: TIniFile;
//        procedure _?Template?(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
    protected
        procedure DoCommand(var result: string; var success: boolean); override;
        procedure DoPrepare(var result: string; var success: boolean); override;
    public
        constructor Create(AOwner: TComponent; filename: string);
        destructor Destroy; override;
    end;


constructor TTclCommandIniFile.Create(AOwner: TComponent; filename: string);
begin
    inherited Create(AOwner);
	FIniFile := TIniFile.Create(filename);
    ErrorMsg := 'Syntax: <?IniFileCmd?> <ReadString|WriteString|ReadSection|ReadSections|ReadSectionValues|EraseSection|DeleteKey|Free>';
    MinArgs := 1;
    MaxArgs := 99;
end;

destructor TTclCommandIniFile.Destroy;
begin
	FIniFile.Free;
    inherited Destroy;
end;

procedure TTclCommandIniFile.DoCommand(var result: string; var success: boolean);
var
	cnt: integer;
    prm: string;
    list: TStringList;
begin
	cnt := ParamValuesCount;
	prm := ParamValues[0]; // MinArgs in Constructor guarantees at least one arg

    if TslcTextEqual(prm, 'READSTRING') then
    begin
    	if (cnt < 3) or (cnt > 4) then
        	TclError('<?IniFileCmd?> ReadString <?Section?> <?Key?> [?Default?]');
		if cnt > 3 then
	        result := FIniFile.ReadString(ParamValues[1], ParamValues[2], ParamValues[3])
        else
        	result := FIniFile.ReadString(ParamValues[1], ParamValues[2], '');
		exit;
    end;
    if TslcTextEqual(prm, 'WRITESTRING') then
    begin
    	if cnt <> 4 then
        	TclError('<?IniFileCmd?> WriteString <?Section?> <?Key?> <?Value?>');
		FIniFile.WriteString(ParamValues[1], ParamValues[2], ParamValues[3]);
		exit;
    end;
	if TslcTextEqual(prm, 'READSECTION') then
    begin
    	if cnt <> 2 then
        	TclError('<?IniFileCmd?> ReadSection <?Section?>');
		list := TStringList.Create;
        try
            FIniFile.ReadSection(ParamValues[1], list);
            result := MergeList(list);
		finally
        	list.Free;
        end;
		exit;
    end;
	if TslcTextEqual(prm, 'READSECTIONS') then
    begin
    	if cnt <> 1 then
        	TclError('<?IniFileCmd?> ReadSections');
		list := TStringList.Create;
        try
            FIniFile.ReadSections(list);
            result := MergeList(list);
		finally
        	list.Free;
        end;
		exit;
    end;
	if TslcTextEqual(prm, 'READSECTIONVALUES') then
    begin
    	if cnt <> 2 then
        	TclError('<?IniFileCmd?> ReadSectionValues <?Section?>');
		list := TStringList.Create;
        try
            FIniFile.ReadSectionValues(ParamValues[1], list);
            result := MergeList(list);
		finally
        	list.Free;
        end;
		exit;
    end;
	if TslcTextEqual(prm, 'ERASESECTION') then
    begin
    	if cnt <> 2 then
        	TclError('<?IniFileCmd?> EraseSection <?Section?>');
        FIniFile.EraseSection(ParamValues[1]);
        exit;
    end;
    if TslcTextEqual(prm, 'DELETEKEY') then
    begin
    	if cnt <> 3 then
        	TclError('<?IniFileCmd?> DeleteKey <?Section?> <?Key?>');
        FIniFile.DeleteKey(ParamValues[1], ParamValues[2]);
		exit;
    end;
    if TslcTextEqual(prm, 'FREE') then
    begin
    	if cnt <> 1 then
        	TclError('<?IniFileCmd?> Free');
        Free;
        exit;
    end;
    TclError(ErrorMsg);
end;

procedure TTclCommandIniFile.DoPrepare(var result: string; var success: boolean);
begin
end;

procedure TIDEMod.TclCmd_IniFileCommand(Sender: TTclCommand;
  var result: string; var success: Boolean);
begin
    with TTclCommandIniFile.Create(Sender.Owner, Sender.ParamValues[1]) do
    begin
		Command := Sender.ParamValues[0];
        if Install(Sender.Interp) <> TCL_OK then
        begin
        	Free;
            TclError('Unable to create IniFile Command');
        end;
    end;
end;

procedure TIDEMod.TclCmd_Macro_vSwitch(Sender: TTclCmdSwitch;
  ASwitch: string; var result: string; var success: Boolean);
begin
	MacroInvoke(TslcStrToInt(Sender.Split(ASwitch)));
end;

procedure TIDEMod.TclCmd_Macro_xSwitch(Sender: TTclCmdSwitch;
  ASwitch: string; var result: string; var success: Boolean);
begin
    with Sender.Command.ClientData as TMacroData do
        subCommand := TslcStrTruth(Sender.SplitDef(ASwitch, '+'));
end;

initialization
	TslcIDE.OnShutDown(OnClose);

finalization
    IDEMod.Free;
    IDEMod := nil;
end.

