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

// ************* READ ************ READ ************** READ ************** READ *****************
// Select only one of the following five. Note that TSLC_IDE or TSLC_IDE_PLUS are NOT suitable for the ScriptPd.dpr project.
// Select none for smallest exe (an init error may occur, the Tcl engine will still function.)
//{$DEFINE TSLC_IDE} // Necessary for including into the IDE lib; e.g., cmplib32.dcl. Comment in or out for IDE builds
//{$DEFINE TSLC_IDE_PLUS} // Includes TSLC_IDE define plus DES and Compression
{$DEFINE TSLC_NORMAL} // Comment out to exclude BDE, DES, & Compression extensions.
//{$DEFINE TSLC_INTRABDE} // External Script Engine Required; build the IntraBDE project and place in DLL search path.
//{$DEFINE TSLC_SLIM} // Preferred for slim Script Engine when none of the above defines are uncommented
//{$DEFINE TSLC_SERVER} // Implements TslcSvr - Tslc socket driven service - excellent for remote

///////////////////////////////////////////////////////////////////////////////
//
//  TslcPad.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 simple interface for the Tslc components and Tcl Engine. Preprocessor
//      symbols determine the context in which this unit is to be used. TSLC_IDE and
//      TSLC_NORMAL are currently the only two defines tested since significant
//      alterations were made to the distribution. Note at the beginning of the unit
//      is a define for TSLC_IDE which may or may not be commented. It's necessary to
//      invoke the preprocessor in order to compile for usage within the IDE. When
//      rebuilding the component library, this units object file, *.dcu, must have
//      been created with TSLC_IDE defined.  See below for more information.
//
//	Editor:
//		Tab stops = 4
//		Page width = 132 characters
//		Font = Courier New, 8pt
//
//  Misc:
//      ??? = Note to self

// Looking to slim down? Here's a cross reference between units and defines.
// TSLC_DES_COMPRESS	-> uTslcCmp.pas
// TSLC_BDE				-> uTslcBde.pas
// TSLC_UTILITY			-> uTslcUti.pas
// TSLC_SOCKETS			-> uTslcSox.pas
// TSLC_RESOURCE		-> uTslcLib.pas
//
// A more ambitious preprocessor scheme could provide appropriate unit exclusion.
// Deselecting TSLC_NORMAL, TSLC_INTRABDE, TSLC_SLIM will cut the compiled exe size in half.

{$IFDEF TSLC_IDE} // W Byrne - 1/13/2002
{$UNDEF TSLC_NORMAL}
{$ENDIF}

{$IFDEF TSLC_IDE_PLUS} // W Byrne - 1/13/2002
{$UNDEF TSLC_NORMAL}
{$ENDIF}


// ------------- Normal Attributes --------------- //
{$IFDEF TSLC_NORMAL}
{$DEFINE TSLC_DES_COMPRESS}
{$DEFINE TSLC_BDE}
{$DEFINE TSLC_UTILITY}
{$DEFINE TSLC_SOCKETS}
{$DEFINE TSLC_RESOURCE}
{$DEFINE TSLC_SECURE}
{$ENDIF}

// -------------- Slim Attributes ---------------- //
{$IFDEF TSLC_SLIM}
{$DEFINE TSLC_RESOURCE}
{$DEFINE TSLC_SECURE}
{$ENDIF}

// ----------- IDE Plus Attributes --------------- //
{$IFDEF TSLC_IDE_PLUS}
{$DEFINE TSLC_IDE}
{$DEFINE TSLC_RESOURCE}
{$DEFINE TSLC_DES_COMPRESS}
{$DEFINE TSLC_BDE}
{$DEFINE TSLC_UTILITY}
{$DEFINE TSLC_SOCKETS}
{$ENDIF}

// ----------- IDE Normal Attributes ------------- //
{$IFDEF TSLC_IDE}
{$DEFINE TSLC_RESOURCE}
{$IFDEF TSLC_PAD} // Project->Options->Conditionals
?PRAGMA? 'ERROR - TSLC_IDE should not be defined when building ScriptPd.dpr project. See top of file.'
{$ENDIF}
{$ELSE}
{$IFNDEF TSLC_PAD}
?PRAGMA? 'ERROR - Unknown usage of unit. If rebuilding TslcIDE in component lib, TSLC_IDE must be defined. See top of file.'
         'It''s best not to install TslcReg.dcu and TslcIDE.dcu at the same time. Install TslcReg.dcu first.'
{$ENDIF}
{$ENDIF}

{$IFNDEF TSLC_INTRABDE}
{$IFNDEF TSLC_SERVER}
{$DEFINE TSLC_WAIT_BRIDGE}
{$DEFINE TSLC_LOCAL}
{$ENDIF}
{$ENDIF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Tslc, TclTk, TslcUtil, TslcRsrc, TslcHash, StdCtrls, ExtCtrls, ComCtrls, Menus, Phantom, RichEdit,
  TkPanel, DBCtrls, TslcPlat;

type
  TEvalEvent = function(script: pChar): pChar of object;
  TQueryInterpEvent = function(Sender: TObject): boolean of object;
  TScriptPad = class(TForm)
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    LabelScript: TLabel;
    MemoScript: TMemo;
    Panel2: TPanel;
    Panel3: TPanel;
    BtnEval: TButton;
    BtnOpen: TButton;
    BtnSave: TButton;
    PopupResults: TPopupMenu;
    MenuItemClearResults: TMenuItem;
    MenuItemPrintResults: TMenuItem;
    PopupScript: TPopupMenu;
    MenuItemClearScript: TMenuItem;
    MenuItemPrintScript: TMenuItem;
    PrinterSetupDialog1: TPrinterSetupDialog;
    MenuItemPrintSetup: TMenuItem;
    PrintSetup2: TMenuItem;
    BtnSaveAs: TButton;
    MenuItemAutoClear: TMenuItem;
    N1: TMenuItem;
    MenuItemUndo: TMenuItem;
    N2: TMenuItem;
    MenuItemCut: TMenuItem;
    MenuItemPaste: TMenuItem;
    MenuItemCopy: TMenuItem;
    MenuItemDelete: TMenuItem;
    N3: TMenuItem;
    MenuItemSelectAll: TMenuItem;
    N4: TMenuItem;
    MenuItemUndoResults: TMenuItem;
    N5: TMenuItem;
    MenuItemCutResults: TMenuItem;
    MenuItemCopyResults: TMenuItem;
    MenuItemPasteResults: TMenuItem;
    MenuItemDeleteResults: TMenuItem;
    N6: TMenuItem;
    MenuItemSelectAllResults: TMenuItem;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;
    Tcl1: TTcl;
    TclCmd_Status: TTclCommand;
    TclSwitch_Status_p: TTclCmdSwitch;
    TclSwitch_Status_f: TTclCmdSwitch;
    TclBridgeWait: TTclBridge;
    TclBridgeIDE: TTclBridge;
    TclChannel1: TTclChannel;
    TclChannel2: TTclChannel;
    TclChannel3: TTclChannel;
    PanelPop: TPanel;
    ProgressPop: TProgressBar;
    LabelPop: TLabel;
    BtnPop: TButton;
    MenuItemShowErrorInfo: TMenuItem;
    MenuItemTabs: TMenuItem;
    MenuItemResultsTabs: TMenuItem;
    N7: TMenuItem;
    MenuItemUnix: TMenuItem;
    StaticPassword1: TMenuItem;
    Pages: TPageControl;
    SheetResults: TTabSheet;
    MemoResults: TMemo;
    SheetTk: TTabSheet;
    TclCmd_TkPad: TTclCommand;
    SheetScroll: TTabSheet;
    ScrollBox1: TScrollBox;
    TkPanel: TTkPanel;
    TkScroll: TTkPanel;
    TclCmd_TkPanel_focus: TTclCmdSwitch;
    TclCmd_exit: TTclCommand;
    TclBridgeUtility: TTclBridge;
    Label2: TLabel;
    procedure BtnEvalClick(Sender: TObject);
    procedure BtnOpenClick(Sender: TObject);
    procedure BtnSaveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure MenuItemClearResultsClick(Sender: TObject);
    procedure MenuItemPrintResultsClick(Sender: TObject);
    procedure MenuItemClearScriptClick(Sender: TObject);
    procedure MenuItemPrintScriptClick(Sender: TObject);
    procedure MenuItemPrintSetupClick(Sender: TObject);
    procedure PopupScriptPopup(Sender: TObject);
    procedure BtnSaveAsClick(Sender: TObject);
    procedure MenuItemUndoClick(Sender: TObject);
    procedure MenuItemCutClick(Sender: TObject);
    procedure MenuItemCopyClick(Sender: TObject);
    procedure MenuItemPasteClick(Sender: TObject);
    procedure MenuItemDeleteClick(Sender: TObject);
    procedure MenuItemSelectAllClick(Sender: TObject);
    procedure MenuItemUndoResultsClick(Sender: TObject);
    procedure MenuItemCutResultsClick(Sender: TObject);
    procedure MenuItemCopyResultsClick(Sender: TObject);
    procedure MenuItemPasteResultsClick(Sender: TObject);
    procedure MenuItemDeleteResultsClick(Sender: TObject);
    procedure MenuItemSelectAllResultsClick(Sender: TObject);
    procedure PopupResultsPopup(Sender: TObject);
    procedure Panel3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TclCmd_StatusPrepare(Sender: TTclCommand; var result: string; var success: boolean);
    procedure TclCmd_StatusCommand(Sender: TTclCommand; var result: string;
      var success: Boolean);
    procedure TclSwitch_Status_fSwitch(Sender: TTclCmdSwitch;
      ASwitch: string; var result: string; var success: Boolean);
    procedure TclSwitch_Status_pSwitch(Sender: TTclCmdSwitch;
      ASwitch: string; var result: string; var success: Boolean);
    procedure TclChannel1Output(Sender: TTclChannel; buf: PChar;
      toWrite: Integer; var errorCodePtr, result: Integer);
    procedure MenuItemAutoClearClick(Sender: TObject);
    procedure Tcl1AfterInitInterp(Sender: TObject; AInterp: pTcl_Interp);
    procedure MemoScriptKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TclChannel3Input(Sender: TTclChannel; buf: PChar;
      toRead: Integer; var errorCodePtr, result: Integer);
    procedure PanelPopDblClick(Sender: TObject);
    procedure LabelScriptDblClick(Sender: TObject);
    procedure MenuItemShowErrorInfoClick(Sender: TObject);
    procedure MenuItemTabsClick(Sender: TObject);
    procedure MenuItemResultsTabsClick(Sender: TObject);
    procedure MenuItemUnixClick(Sender: TObject);
    procedure TclCmd_TkPadCommand(Sender: TTclCommand;
      var result: string; var success: Boolean);
    procedure Tcl1BeforeClose(Sender: TTcl);
    procedure Tcl1InitError(Sender: TObject; AInterp: pTcl_Interp);
    procedure TclCmd_TkPanel_focusSwitch(Sender: TTclCmdSwitch;
      ASwitch: string; var result: string; var success: Boolean);
    procedure TclCmd_TkPadPrepare(Sender: TTclCommand; var result: string; var success: boolean);
    procedure Tcl1BeforeInitInterp(Sender: TObject; AInterp: pTcl_Interp);
    procedure TclCmd_exitCommand(Sender: TTclCommand; var result: string;
      var success: Boolean);
    procedure MemoResultsKeyPress(Sender: TObject; var Key: Char);
    procedure TclChannel3BlockMode(Sender: TTclChannel; mode: Integer;
      var result: Integer);
  private
    { Private declarations }
	FCancelAttempts: integer;
    // Strictly Status Stuff Vars
    Panel1Ratio, Panel2Ratio: double;
    FormWidth, ProgMargin, ProgDelta, ProgBaseMargin: integer;
    PersWidth, PersHeight: integer;
    FEditPad: boolean;
    FOnEvaluate: TEvalEvent;
    FOnCancelHit: TNotifyEvent;
    FOnCloseInterp: TNotifyEvent;
    FOnQueryInterp: TQueryInterpEvent;
    FFreqUpdate, FAutoScroll, Evaluating, Phantomizing: boolean;
    LastMouseY, MouseDownY: integer;
    LastRect: TRect;
    FConsoleTextHeight, FStdInBlockMode: integer;
    FCarriageReturn: boolean;
	FBuffer: string;

	FDestroyInfo: Tcl_CmdInfo;
    FLoadInfo: Tcl_CmdInfo;
	FExitInfo: Tcl_CmdInfo;
    function CanClose: boolean;
//    procedure DrawPhantom;
	procedure CheckCancelHit;
    function DoCanClose: boolean;
    function EvalBtn: TButton;
    procedure SetEditPad(value: boolean);
    procedure SetFreqUpdate(value: boolean);
    procedure SetAutoScroll(value: boolean);
	procedure StatusText(msg: string);
    procedure StatusPercent(percent: integer);
    procedure StatusForceUpdate;
	procedure CalcConsole;
{$IFDEF TSLC_LOCAL}
	function  DoEval(script: pChar): pChar;
	procedure DoCloseInterp(Sender: TObject);
    function  DoQueryInterp(Sender: TObject): boolean;
    function  DoWinHandle(window: string): THandle;
{$ENDIF}
  protected
  	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    { Public declarations }
    destructor Destroy; override;
    procedure Evaluate;
	function  InputPassword(APrompt: string; var password: string): Boolean;
	procedure OpenScript(FileName: string; pword: string);
	procedure PrintText(msg: pChar; clear, raw: boolean);
   	function SaveScript(FileName, ext: string; warn: boolean): string;
    procedure UpdateStatus(msg: pChar; percent: integer);
	property AutoScroll: boolean read FAutoScroll write SetAutoScroll;
    property EditPad: boolean read FEditPad write SetEditPad;
    property FreqUpdate: boolean read FFreqUpdate write SetFreqUpdate;
    property OnEvaluate: TEvalEvent read FOnEvaluate write FOnEvaluate;
    property OnCancelHit: TNotifyEvent read FOnCancelHit write FOnCancelHit;
    property OnCloseInterp: TNotifyEvent read FOnCloseInterp write FOnCloseInterp;
    property OnQueryInterp: TQueryInterpEvent read FOnQueryInterp write FOnQueryInterp;
  end;


{$IFNDEF TSLC_IDE}
const
    tslc_ide = False;
    tslc_ide_error = 'TSLC_IDE should not be defined when building ScriptPd.dpr project. See top of TslcPad.pas.';
{$ELSE}
const
	tslc_ide_compile = True;
{$ENDIF}

{$IFDEF TSLC_PAD}
var
	LoadBDE: 		boolean = true;
    LoadUtility: 	boolean = true;
    LoadWait: 		boolean = true;
    LoadCompress:	boolean = true;
{$ENDIF}



implementation

// The following series of defines includes the appropriate units and makes
//     sure that there's no overlaying of the above DEFINES.
{$IFDEF TSLC_IDE}			// <====================== TARGET DEFINE
{$IFDEF TSLC_NORMAL}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_SLIM}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_INTRABDE}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_SERVER}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
uses uTslcLib, uTslcBde, uWaitMod, uTslcIde, uTslcCmp, TslcZLib, TslcDes, uTslcUti, TslcKey, uTslcSox;
{$ELSE}

{$IFDEF TSLC_NORMAL}	// <====================== TARGET DEFINE
{$IFDEF TSLC_IDE}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_SLIM}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_INTRABDE}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_SERVER}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
uses uTslcLib, uTslcBde, uWaitMod, uTslcCmp, TslcZLib, TslcDes, uTslcUti, TslcKey, TslcFile, uTslcSox;
{$ELSE}

{$IFDEF TSLC_INTRABDE}		// <====================== TARGET DEFINE
// ??? This define hasn't been tested since numerous changes were made....
{$IFDEF TSLC_IDE}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_NORMAL}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_SLIM}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_LOCAL}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_SERVER}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
uses uTslcLib, uWaitMod, TslcDes, TslcZLib, TslcKey;
{$ELSE}

{$IFDEF TSLC_SLIM}			// <====================== TARGET DEFINE
{$IFDEF TSLC_IDE}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_NORMAL}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_INTRABDE}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_SERVER}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
uses uTslcLib, uWaitMod, TslcZLib, TslcDes, TslcKey, TslcFile;
{$ELSE}

{$IFDEF TSLC_SERVER}			// <====================== TARGET DEFINE
{$IFDEF TSLC_IDE}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_NORMAL}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_INTRABDE}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
{$IFDEF TSLC_SLIM}
	?PRAGMA? ERROR - NON EXCLUSIVE DEFINES
{$ENDIF}
uses TslcZLib, TslcDes, TslcKey, TslcFile;
{$ELSE}

// Slimmer than slim
uses uWaitMod, TslcKey;

{$ENDIF}					// <==== Endif Target Define
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}

{$R *.DFM}

//******** NOTE NT4.0 ***************
// Divide By Zero when printing TRichEdit.
// Modify TRichEdit.Print in ComCtrls so that the Printer.Handle is
// referenced after Printer.BeginDoc
//
// ...
//    BeginDoc;
//    hdc := Handle;
//    hdcTarget := hdc;
// ...
//
//  Also note that I experienced refreshing problems with TRichEdit. It was used
//  in place of TMemo for its printing services. TMemo could be put back into action
//  by simply editing the DFM text-wise and making a few modifications in this file. The
//  compiler will let you know which changes need to made if you decide to use TMemo.
//  I'm using NT 4.00.1381; no service packs installed yet (old news... now have SP3, but
//  haven't checked out possible changes in behaviour of TRichEdit.)
//  ... inserted invalidation in formResize.

{$IFDEF TSLC_INTRABDE}
type
	TEvalBdeScript = function(script: pChar; quote: integer; reset: integer): pChar; cdecl;

const
	EvalBdeScript: TEvalBdeScript = nil;

const
	cDLLPath = 'IntraBde.dll';
    cEvalProc = 'EvalBdeScript';

var
	hIntraBde: HModule = 0;

procedure InitDLL;
begin
	if hIntraBde = 0 then
    begin
	   	hIntraBde := LoadLibrary(cDLLPath);
	    if hIntraBde = 0 then
	    	TclError('Could not Load ' + cDLLPath);
    end;

    EvalBdeScript := GetProcAddress(hIntraBde, cEvalProc);
    if @EvalBdeScript = nil then
	begin
    	FreeLibrary(hIntraBde);
        hIntraBde := 0;
        TclError('Could not GetProcAddress ' + cEvalProc);
    end;
end;
{$ENDIF}

procedure TScriptPad.Evaluate;
const
	cTerminateThreshold = 3;
var
	msg: TMsg;
    p: pChar;
    str: string;
begin
	if Evaluating then // Cancel clicked is checked by CheckCancelHit
    begin
		inc(FCancelAttempts);
{$IFDEF TSLC_LOCAL}
    	if (FCancelAttempts >= cTerminateThreshold) and
        	(MessageDlg(format('%d unsuccessful attempts have been made to cancel.' + #13 + 'Would you like to terminate the process?',
            	[FCancelAttempts]), mtWarning, [mbYes, mbNo], 0) = mrYes) then
{$IFDEF TSLC_IDE}
			begin
        		case MessageDlg('You are about to terminate Delphi. Would you like save open files?', mtWarning, mbYesNoCancel, 0) of
                	mrYes:
                    	begin
                        	SaveAllUnits;
                            if DoCanClose then
								TerminateProcess(GetCurrentProcess, 1);
                        end;
                    mrNo:
                    	begin
							if DoCanClose then
								TerminateProcess(GetCurrentProcess, 1);
                        end;
                end;
            end;
{$ELSE}
			TerminateProcess(GetCurrentProcess, 1);
{$ENDIF}
		KillVwait;
{$ELSE}
    	if Assigned(FOnCancelHit) then // This is usefule for infinite *vwait* commands
        	FOnCancelHit(self);
{$ENDIF}
    	exit;
    end;
{$IFDEF TSLC_IDE}
	if not QueryInvocation then
    	Abort;
{$ENDIF}

	FCancelAttempts := 0;
	Evaluating := True;
    try
	    while PeekMessage(msg, EvalBtn.handle, WM_LBUTTONDOWN, WM_LBUTTONDOWN, PM_REMOVE) do; // Clear any jitters.
        while PeekMessage(msg, EvalBtn.handle, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE) do;
    	UpdateStatus('',0);
        if MenuItemAutoClear.Checked then
		    MemoResults.Clear;
    	try
	    	EvalBtn.Caption := 'C&ancel';
	        BtnOpen.Enabled := False;
	        BtnSave.Enabled := False;
            BtnSaveAs.Enabled := False;
            MemoScript.PopupMenu := nil;
            MemoResults.PopupMenu := nil;
{$IFDEF TSLC_LOCAL}
            TslcAddTextToStrings(DoEval(pChar(MemoScript.text)), MemoResults.Lines);
{$ELSE}
{$IFDEF  TSLC_INTRABDE}   // Non Local Evaluation. No gui/console interaction between host computer and user
			InitDLL;
            MemoResults.Text := EvalBdeScript(pChar(MemoScript.text), 0, 0);

{$ELSE}
{$IFDEF TSLC_SERVER}



{$ELSE} // whatever else...
			if not Tcl1.Eval(MemoScript.text) and MenuItemShowErrorInfo.Checked then
            begin
    			Tcl1.GetVar('errorInfo', '', str, [tfGlobalOnly]);
                p := pChar(str);
            end else
			    p := Tcl_GetStringResult(Tcl1.Interp); // this function returns a preferred pChar. Could have used Tcl1.Result
            TslcAddTextToStrings(p, MemoResults.Lines);
{$ENDIF}
{$ENDIF}
{$ENDIF}

		finally
	    	EvalBtn.Caption := 'Eval&uate';
	        BtnOpen.Enabled := True;
	        BtnSave.Enabled := True;
            BtnSaveAs.Enabled := True;
            MemoScript.PopupMenu := PopupScript;
            MemoResults.PopupMenu := PopupResults;
	    end;
	finally
    	Evaluating := False;
        Sleep(750);
	    while PeekMessage(msg, EvalBtn.handle, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do; // Clear any jitters.
        while PeekMessage(msg, EvalBtn.handle, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE) do;
    end;
end;

procedure TScriptPad.BtnEvalClick(Sender: TObject);
begin
	Evaluate;
end;

procedure TScriptPad.OpenScript(fileName: string; pword: string);
	function  IsRich(strm: TStream): boolean;
    var
        buf: array[0..5] of char;
        pos: integer;
    begin
    	pos := strm.Position;
		strm.read(buf, 5);
        strm.Position := pos;
        buf[5] := #0;
        result := StrComp(buf, '{\rtf') = 0;
    end;
var
	strm, tStrm: TStream;
{$IFDEF TSLC_SECURE}
    st: TTslcScriptType;
begin

	st := StrToScriptType(ExtractFileExt(FileName));
    if (st in [stEncrypted, stCompressedEncrypted]) and (pword = '') and
			not InputPassword('Enter Password:', pword) then
	    abort;
	strm := TFileStream.Create(FileName, fmOpenRead);
   	tStrm := strm;
	if st <> stNormal then
    try
	    strm := UncrunchScriptStream(strm, st, pword);
    finally
    	tStrm.Free;
    end;
{$ELSE}
begin
	strm := TFileStream.Create(FileName, fmOpenRead);
{$ENDIF}

    try
{$IFDEF RICHEDITS}
		MemoScript.PlainText := not IsRich(strm); // richedit
        try
        	MemoScript.Lines.LoadFromStream(strm);
        finally
        	MemoScript.PlainText := True; // richedit
        end;
{$ELSE}
		MemoScript.Lines.LoadFromStream(strm);
{$ENDIF}
    finally
    	strm.Free;
    end;
    MemoScript.Modified := False;
    SaveDialog1.FileName := FileName;
    LabelScript.Caption := ' Scipt - ' + FileName;
end;

procedure TScriptPad.BtnOpenClick(Sender: TObject);
begin
	with OpenDialog1 do
    	if Execute and CanClose then
        	OpenScript(FileName, '');
end;

function TScriptPad.SaveScript(FileName, ext: string; warn: boolean): string;
var
	str, bak, pword, pword2: string;
    strm, tStrm: TStream;
    exists: boolean;
{$IFDEF TSLC_SECURE}
    st: TTslcScriptType;
{$ENDIF}
begin
   	FileName := ChangeFileExt(FileName, ext);
	exists := FileExists(FileName);
    if exists and warn and
    	(MessageDlg('Overwrite existing file?', mtConfirmation, [mbYes, mbNo], 0) <> mrYes) then
    	exit;

    if exists and (UpperCase(ExtractFileExt(FileName)) <> '.bak') then
    begin
		str := ChangeFileExt(FileName, '.bak');
        CopyFile(pChar(FileName), pChar(str), false);
    end;

	if MenuItemUnix.Checked then
    begin
    	str := MemoScript.Lines.Text;
        ConvertPEOL(pChar(str));
        strm := TMemoryStream.Create;
        try
        	strm.WriteBuffer(pChar(str)^, strlen(pChar(str)));
        except
        	strm.Free;
            raise
        end;
    end else
    begin
    	strm := TMemoryStream.Create;
        try
	    	MemoScript.Lines.SaveToStream(strm);
        except
        	strm.Free;
            raise;
        end;
    end;
{$IFDEF TSLC_SECURE}
	st := StrToScriptType(ext);
	pword := '';
    if st in [stEncrypted, stCompressedEncrypted] then
    try
		if not InputPassword('Enter Password:', pword) then
	    	abort;
		pword2 := '';
	    repeat
	    if not InputPassword('Verify Password:', pword2) then
	    	abort;
	    until pword = pword2;
	except
        strm.Free;
        raise;
    end;

   	strm.Position := 0;
    tStrm := strm;
    if st <> stNormal then
    try
        strm := CrunchScriptStream(strm, st, pword);
	finally
    	tStrm.Free;
    end;
{$ENDIF}
    try
    	TMemoryStream(strm).SaveToFile(FileName);
    finally
    	strm.Free;
    end;

	result := FileName;
	MemoScript.Modified := False;
end;


const
	cFilters: array[1..5] of pChar = ('.tcl', '.tcz', '.tce', '.tze', '.tcl');

procedure TScriptPad.BtnSaveClick(Sender: TObject);
var
	f: integer;
    ext: string;
begin
	with SaveDialog1 do
	if FileName <> '' then
    begin
       	ext := ExtractFileExt(FileName);
       	for f := low(cFilters) to high(cFilters) do
           	if compareText(cFilters[f], ext) = 0 then
            begin
				FilterIndex := f;
                break;
            end;
    	SaveScript(ChangeFileExt(FileName, ''), cFilters[FilterIndex]{ExtractFileExt(SaveDialog1.FileName)}, False)
	end else
    	BtnSaveAsClick(nil);
end;

procedure TScriptPad.BtnSaveAsClick(Sender: TObject);
begin
	with SaveDialog1 do
    	if Execute then
        begin
			FileName := SaveScript(FileName, cFilters[FilterIndex], true);
            OpenDialog1.FileName := FileName;
            LabelScript.Caption := ' Scipt - ' + FileName;
        end;
end;


type
	TWordBreakProcEx = function( pchText: pChar; cchText: longint; bCharSet: BYTE; code: integer): longint; stdcall;

var
	prevWordBreakProcEx: TWordBreakProcEx; // default is null as of written - not using

// Using our own Get-Word-At-Caret definitions - very basic but sufficient - default proc was too loose
function EditWordBreakProcEx( pchText: pChar; cchText: longint; bCharSet: BYTE; code: integer): longint; stdcall;
	function IsWordChar(c: char): boolean;
    begin
    	result := (c in ['a'..'z']) or (c in ['A'..'Z']) or (c in ['0'..'9']) or (c = '_');
    end;
var
	c: char;
begin
	result := cchText;
	if code = WB_LEFT then
    begin
        while IsWordChar(pchText[result-1]) do
        	dec(result);
    end else if code = WB_RIGHTBREAK then
    begin
        while IsWordChar(pchText[result]) do
        	inc(result);
    end else if code = WB_ISDELIMITER then
    begin
		if IsWordChar(pchText[result]) then
        	result := 0
        else
        	result := 1;
	end else if code = WB_CLASSIFY then // ???
    begin
    	result := 0;
    end else if code = WB_LEFTBREAK then
    begin
    	while IsWordChar(pchText[result]) do
        	dec(result);
        while not IsWordChar(pchText[result-1]) do
			dec(result);
    end else if code = WB_MOVEWORDLEFT then
    begin
		while IsWordChar(pchText[result]) do
        	dec(result);
        while not IsWordChar(pchText[result]) do
        	dec(result);
        while IsWordChar(pchText[result-1]) do
        	dec(result);
    end else if (code = WB_MOVEWORDRIGHT) or (code = WB_RIGHT) then
    begin
    	while IsWordChar(pchText[result]) do
        	inc(result);
        while not IsWordChar(pchText[result]) do
			inc(result);
	end;
end;

procedure TScriptPad.CalcConsole;
var
	dc: HDC;
    tm: TTextMetric;
begin
	dc := GetDC(MemoResults.Handle);
    GetTextMetrics(dc, tm);
    ReleaseDC(MemoResults.Handle, dc);
	FConsoleTextHeight := tm.tmHeight + tm.tmExternalLeading;

end;

procedure TScriptPad.FormCreate(Sender: TObject);
begin
	Width := 360;
    Height := 320;
    PersWidth := 360;
    PersHeight := 320;
    FEditPad := True;

{$IFDEF TSLC_LOCAL}
    OnQueryInterp := DoQueryInterp;
    OnCloseInterp := DoCloseInterp;
{$ENDIF}

    StatusBar1.Panels[0].Width := 174;
    StatusBar1.Panels[1].Width := 154;
    StatusBar1.Panels[2].Width := 1;
    ProgressBar1.Left := 180;
    ProgressBar1.Top := 126;
    ProgressBar1.Width := 145;
	FormWidth := Width;
    Panel1Ratio := StatusBar1.Panels[0].Width / (FormWidth - StatusBar1.Panels[2].Width);
    Panel2Ratio := StatusBar1.Panels[1].Width / (FormWidth - StatusBar1.Panels[2].Width);
    ProgMargin := ProgressBar1.Left - StatusBar1.Panels[0].Width;
    ProgDelta := StatusBar1.Panels[1].Width - ProgressBar1.Width;
    ProgBaseMargin := Panel2.Height - ProgressBar1.Top;
	FAutoScroll := True;
    FFreqUpdate := True;
	CalcConsole;

{$IFDEF TSLC_RESOURCE}
    ResourceServeThread(GetCurrentThreadId, Tcl1);
    Tcl1.Options := Tcl1.Options - [toPerformInit]; // the resource module will script initialize the interpreter.
{$ENDIF}

{$IFDEF TSLC_PAD}
	if LoadBDE then
{$ENDIF}
{$IFDEF TSLC_BDE}
	try
		BDEServeThread(GetCurrentThreadId, Tcl1);
    except
    	MessageDlg(Exception(ExceptObject).Message, mtError, [], 0);
    end;
{$ENDIF}

{$IFDEF TSLC_PAD}
	if LoadUtility then
{$ENDIF}
{$IFDEF TSLC_UTILITY}
	try
        UtilityServeThread(GetCurrentThreadId, Tcl1);
    except
    	MessageDlg(Exception(ExceptObject).Message, mtError, [], 0);
    end;
{$ENDIF}

{$IFDEF TSLC_PAD}
	if LoadWait then
{$ENDIF}
{$IFDEF TSLC_WAIT_BRIDGE}
    try
		TclBridgeWait.Server := WaitMod.Tcl1; // Not interested in threading this module.
    except
    	MessageDlg(Exception(ExceptObject).Message, mtError, [], 0);
    end;
{$ENDIF}

{$IFDEF TSLC_PAD}
	if LoadCompress then
{$ENDIF}
{$IFDEF TSLC_DES_COMPRESS}
	try
    	CompressServeThread(GetCurrentThreadId, Tcl1);
    except
    	MessageDlg(Exception(ExceptObject).Message, mtError, [], 0);
    end;
{$ENDIF}

{$IFDEF TSLC_SOCKETS}
	try
        SocketsServeThread(GetCurrentThreadId, Tcl1);
    except
    	MessageDlg(Exception(ExceptObject).Message, mtError, [], 0);
    end;
{$ENDIF}

{$IFDEF TSLC_IDE}
	TclBridgeIDE.Server := IDEMod.Tcl1;  // Not interested in threading this module.
{$ENDIF}

	// Don't bother getting default - it's null
//    prevWordBreakProcEx := TWordBreakProcEx(SendMessage(MemoScript.Handle, EM_GETWORDBREAKPROC, 0, 0));
//   	SendMessage(MemoScript.Handle, EM_SETWORDBREAKPROC, 0, longint(@EditWordBreakProcEx));

//	SendMessage(MemoScript.Handle, EM_SETTABSTOPS, 1, LPARAM(@x));
//	SendMessage(MemoResults.Handle, EM_SETTABSTOPS, 1, LPARAM(@x));

	if Application <> nil then
	  	Application.HelpFile := '..\..\Tslc.hlp';

end;

destructor TScriptPad.Destroy;
begin
	inherited Destroy;
end;

function TScriptPad.DoCanClose: boolean;
begin
	Result := True;
	if MemoScript.Modified then
    case MessageDlg('Script has changed. Save?', mtConfirmation, mbYesNoCancel, 0) of
        mrYes :
			with SaveDialog1 do
            begin
				if SaveDialog1.FileName = '' then
	            	Result := Execute;
                if Result then
                begin
        			MemoScript.Lines.SaveToFile(FileName);
		            MemoScript.Modified := False;
        		end;
            end;
        mrCancel: Result := False;
    end;
end;

function TScriptPad.CanClose: boolean;
begin
	if Evaluating then
    begin
    	MessageDlg('Cannot close during active evaluation. Press <Ctrl> while closing this window to terminate process.', mtError, [mbOK], 0);
		if GetKeyState(VK_CONTROL) < 0 then
        	TerminateProcess(GetCurrentProcess, 1);
		result := False;
        exit;
    end;
    result := DoCanClose;
end;

procedure TScriptPad.Notification(AComponent: TComponent; Operation: TOperation);
begin
	inherited Notification(AComponent, Operation);
end;

procedure TScriptPad.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
{$IFNDEF TSLC_IDE}
	CanClose := Self.CanClose;
{$ENDIF}
end;

procedure TScriptPad.FormDestroy(Sender: TObject);
begin
{$IFDEF TSLC_IDE}
	if MemoScript.Modified then
    begin
		Show;
		CanClose;
    end;
{$ENDIF}
{$IFDEF TSLC_INTRABDE}
	FreeLibrary(hIntraBde);
{$ENDIF}
end;

procedure TScriptPad.PrintText(msg: pChar; clear, raw: boolean);
var
	riw, cnt, h, cur, x, y: integer;
    p: pChar;
    rect: TRect;
begin
    CheckCancelHit;
	if clear then
    	MemoResults.Clear;

	if raw then
    begin
    	h := SendMessage(MemoResults.Handle, WM_GETTEXTLENGTH, 0, 0);
//		SendMessage(MemoResults.Handle, WM_SETREDRAW, 0, 0);
		MemoResults.SelStart := h;
    	MemoResults.SelLength := 0;
        MemoResults.SelText := msg;
        ValidateRect(MemoResults.Handle, nil);
//		SendMessage(MemoResults.Handle, WM_SETREDRAW, 1, 0);
        p := msg;
        while p^ <> #0 do
        	if p^ in [#10, #13] then
            	break
            else
            	inc(p);

        if p^ = #0 then
        begin
			x := (p - msg) * FConsoleTextHeight;
			GetCaretPos(rect.TopLeft);
            dec(rect.left, x);
            rect.right := rect.left + x;
            rect.bottom := rect.top + FConsoleTextHeight;
            InvalidateRect(MemoResults.Handle, @rect, True);
        	exit;
        end;
    end else
		TslcAddTextToStrings(msg, MemoResults.lines);

	if FAutoScroll then
    begin
	    cnt := MemoResults.Lines.Count; //???
        cur := SendMessage(MemoResults.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
        h := MemoResults.ClientHeight;
        riw := h div FConsoleTextHeight;
		if cnt - cur >= riw then
		    SendMessage(MemoResults.Handle, EM_LINESCROLL, 0, cnt - riw - cur);
    end;

    if FreqUpdate then
    begin
    	MemoResults.Invalidate;
	   	Update;
    end;
end;

procedure TScriptPad.CheckCancelHit;
var
	winMsg: TMsg;
begin
	if PeekMessage(winMsg, EvalBtn.handle, WM_LBUTTONDOWN, WM_LBUTTONDOWN, PM_REMOVE)
    	or
       PeekMessage(winMsg, EvalBtn.handle, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE)
     then
    	TclError('Operation aborted by user.');
end;

function TScriptPad.EvalBtn: TButton;
begin
	if FEditPad then
    	result := BtnEval
    else
    	result := BtnPop;
end;

procedure TScriptPad.SetEditPad(value: boolean);
begin
	if value = FEditPad then
    	exit;
	if value then
    begin
    	PanelPop.Visible := False;
        PanelPop.Align := alNone;
    	Width := PersWidth;
        Height := PersHeight;
        BorderStyle := bsSizeable;
//        StatusBar1.Visible := True;
//        ProgressBar1.Visible := True;
//        MemoResults.Visible := True;
		Panel2.Visible := True;
        Panel1.Visible := True;
	end else
    begin
    	PersWidth := Width;
        PersHeight := Height;
        Panel1.Visible := False;
        Panel2.Visible := False;
//        MemoResults.Visible := False;
//        ProgressBar1.Visible := False;
//        StatusBar1.Visible := False;
        Width := GetSystemMetrics(SM_CXDLGFRAME) * 2 + PanelPop.Width;
        Height := GetSystemMetrics(SM_CYDLGFRAME) + GetSystemMetrics(SM_CYCAPTION) + PanelPop.Height;
        BorderStyle := bsDialog;
        PanelPop.Left := 0;
        PanelPop.Height := 0;
        PanelPop.Align := alClient;
        PanelPop.Visible := True;
    end;
    FEditPad := value;
end;


procedure TScriptPad.SetFreqUpdate(value: boolean);
begin
	FFreqUpdate := value;
end;

procedure TScriptPad.SetAutoScroll(value: boolean);
begin
	FAutoScroll := value;
end;


procedure TScriptPad.StatusText(msg: string);
begin
	if FEditPad then
		StatusBar1.Panels[0].text := msg
    else
    	LabelPop.Caption := msg;
end;

procedure TScriptPad.StatusPercent(percent: integer);
begin
	if FEditPad then
	   	ProgressBar1.Position := percent
    else
    	ProgressPop.Position := percent;
end;

procedure TScriptPad.StatusForceUpdate;
begin
	if FEditPad then
		StatusBar1.Invalidate
    else
    	LabelPop.Invalidate;
    Update;
end;

procedure TScriptPad.UpdateStatus(msg: pChar; percent: integer);
begin
    CheckCancelHit;
	if msg <> nil then
    	StatusText(msg);
    if percent >= 0 then
    	StatusPercent(percent);
    if FreqUpdate then
    	StatusForceUpdate;
end;

procedure TScriptPad.FormResize(Sender: TObject);
var
	w: integer;
    b: boolean;
begin
	b := Width >= FormWidth;
    if b then
    	w := Width
    else
    	w := FormWidth;
    StatusBar1.Panels[0].Width := Round(w * Panel1Ratio);
    StatusBar1.Panels[1].Width := Round(w * Panel2Ratio);
    if b then
    begin
	    ProgressBar1.Left := StatusBar1.Panels[0].Width + ProgMargin;
    	ProgressBar1.Width := StatusBar1.Panels[1].Width - ProgDelta;
		ProgressBar1.Top := Panel2.Height - ProgBaseMargin;
        ProgressBar1.Visible := True;
    end else
    	ProgressBar1.Visible := False;
	MemoScript.Invalidate; // never investigated; however, this help prevent ?disappearing NT/RichEdit text? when resizing
    MemoResults.Invalidate;
end;

procedure TScriptPad.MenuItemClearResultsClick(Sender: TObject);
begin
	MemoResults.Clear;
end;

procedure TScriptPad.MenuItemPrintResultsClick(Sender: TObject);
begin
{$IFDEF RICHEDITS}
	MemoResults.Print('TestPad - Results');
{$ELSE}
{$ENDIF}
end;

procedure TScriptPad.MenuItemClearScriptClick(Sender: TObject);
begin
	if (MessageDlg('New Document?', mtConfirmation, mbYesNoCancel, 0 ) = mrYes) and CanClose then
    begin
    	MemoScript.Lines.Clear;
        LabelScript.Caption := ' Script';
        SaveDialog1.FileName := '';
    end;
end;

procedure TScriptPad.MenuItemPrintScriptClick(Sender: TObject);
begin
{$IFDEF RICHEDITS}
	MemoScript.Print('TestPad - Script');
{$ELSE}
{$ENDIF}
end;

procedure TScriptPad.MenuItemPrintSetupClick(Sender: TObject);
begin
	PrinterSetupDialog1.Execute;
end;

procedure TScriptPad.PopupScriptPopup(Sender: TObject);
var
	b: boolean;
begin
	MenuItemUndo.Enabled := SendMessage(MemoScript.Handle, EM_CANUNDO, 0, 0) <> 0;
    b := MemoScript.SelLength > 0;
    MenuItemCut.Enabled := b;
    MenuItemCopy.Enabled := b;
    MenuItemDelete.Enabled := b;
end;

{$IFDEF TSLC_LOCAL}
function TScriptPad.DoEval(script: pChar): pChar;
const
	buffer: string = '';
begin
	if not Tcl1.Eval(script) and MenuItemShowErrorInfo.Checked then
    begin
		Tcl1.GetVar('errorInfo', '', buffer, [tfGlobalOnly]);
        result := pChar(buffer);
    end else
	    result := Tcl_GetStringResult(Tcl1.Interp);
end;

procedure TScriptPad.DoCloseInterp(Sender: TObject);
begin
//	CloseInterp;
end;

function TScriptPad.DoQueryInterp(Sender: TObject): boolean;
begin
{$IFDEF TSLC_LOCAL}
	result := Tcl1.Active;
{$ELSE}
	???
{$ENDIF}
end;

function TScriptPad.DoWinHandle(window: string): THandle;
begin
	if (compareText(window, 'APP') = 0) or (compareText(window, 'APPLICATION') = 0) then
    	result := Application.Handle
    else if (compareText(window, 'PAD') = 0) or (compareText(window, 'SCRIPTPAD') = 0) then
    	result := Handle
    else
    	result := 0;
end;
{$ENDIF}

procedure TScriptPad.MenuItemUndoClick(Sender: TObject);
begin
	SendMessage(MemoScript.Handle, EM_UNDO, 0, 0);
end;

procedure TScriptPad.MenuItemCutClick(Sender: TObject);
begin
	MemoScript.CutToClipBoard;
end;

procedure TScriptPad.MenuItemCopyClick(Sender: TObject);
begin
	MemoScript.CopyToClipBoard;
end;

procedure TScriptPad.MenuItemPasteClick(Sender: TObject);
begin
	MemoScript.PasteFromClipBoard;
end;

procedure TScriptPad.MenuItemDeleteClick(Sender: TObject);
begin
	MemoScript.ClearSelection;
end;

procedure TScriptPad.MenuItemSelectAllClick(Sender: TObject);
begin
	MemoScript.SelectAll;
end;

procedure TScriptPad.MenuItemUndoResultsClick(Sender: TObject);
begin
	SendMessage(MemoResults.Handle, EM_UNDO, 0, 0);
end;

procedure TScriptPad.MenuItemCutResultsClick(Sender: TObject);
begin
	MemoResults.CutToClipBoard;
end;

procedure TScriptPad.MenuItemCopyResultsClick(Sender: TObject);
begin
	MemoResults.CopyToClipBoard;
end;

procedure TScriptPad.MenuItemPasteResultsClick(Sender: TObject);
begin
	MemoResults.PasteFromClipBoard;
end;

procedure TScriptPad.MenuItemDeleteResultsClick(Sender: TObject);
begin
	MemoResults.ClearSelection;
end;

procedure TScriptPad.MenuItemSelectAllResultsClick(Sender: TObject);
begin
	MemoResults.SelectAll;
end;

procedure TScriptPad.PopupResultsPopup(Sender: TObject);
var
	b: boolean;
begin
	MenuItemUndoResults.Enabled := SendMessage(MemoResults.Handle, EM_CANUNDO, 0, 0) <> 0;
    b := MemoResults.SelLength > 0;
    MenuItemCopyResults.Enabled := b;
    MenuItemCutResults.Enabled := b;
    MenuItemDeleteResults.Enabled := b;
end;

procedure TScriptPad.Panel3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    LastMouseY := Y;
    MouseDownY := Y;
    Phantomizing := True;
	LastRect := Panel3.BoundsRect;
	DrawPhantom(self, LastRect);
end;

procedure TScriptPad.Panel3MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
	if Phantomizing then
    begin
		DrawPhantom(self, LastRect);
        inc(LastRect.Top, Y - LastMouseY);
        inc(LastRect.Bottom, Y - LastMouseY);
        LastMouseY := Y;
        DrawPhantom(self, LastRect);
    end;
end;

procedure TScriptPad.Panel3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
	h, max: integer;
begin
	if Phantomizing then
    begin
		DrawPhantom(self, LastRect);
		h := Panel2.Height - (Y - MouseDownY);
        max := ClientHeight - (Panel3.Height + LabelScript.Height + 1);
        if h > max then
        	h := max
        else if h <= 0 then
        	h := 1;
    	Panel2.Height := h;
        ProgressBar1.Top := h - ProgBaseMargin;
	    Phantomizing := False;
		MemoScript.Invalidate; // never investigated; however, this helps prevent ?disappearing text? when resizing
    	MemoResults.Invalidate;
    end;
end;

{~~~ Status Command ~~~}
procedure TScriptPad.TclCmd_StatusPrepare(Sender: TTclCommand; var result: string; var success: boolean);
begin
	TclCmd_Status.ClientData := TObject(-1);
end;

procedure TScriptPad.TclCmd_StatusCommand(Sender: TTclCommand;
  var result: string; var success: Boolean);
begin
   	if Sender.ParamValuesCount > 0 then
	   	UpdateStatus(pChar(Sender.ParamValues[0]), integer(Sender.ClientData))
    else
    	UpdateStatus(nil, integer(Sender.ClientData));
end;

procedure TScriptPad.TclSwitch_Status_fSwitch(Sender: TTclCmdSwitch;
  ASwitch: string; var result: string; var success: Boolean);
begin
   	SetFreqUpdate(TslcStrTruth(Sender.SplitDef(ASwitch, '+')));
end;

procedure TScriptPad.TclSwitch_Status_pSwitch(Sender: TTclCmdSwitch;
  ASwitch: string; var result: string; var success: Boolean);
var
	p: integer;
begin
	with Sender do
    begin
		p := strtointdef(Split(ASwitch), 0);
        if p < 0 then
        	p := 0
        else if p > 100 then
        	p := 100;
		Command.ClientData := TObject(p);
    end;
end;


procedure TScriptPad.TclChannel1Output(Sender: TTclChannel; buf: PChar;
  toWrite: Integer; var errorCodePtr, result: Integer);
var
	str: string;
begin
	SetString(str, buf, toWrite);
    PrintText(pChar(str), False, True);
end;

procedure TScriptPad.MenuItemAutoClearClick(Sender: TObject);
begin
	MenuItemAutoClear.Checked := not MenuItemAutoClear.Checked;
end;

procedure TScriptPad.MenuItemShowErrorInfoClick(Sender: TObject);
begin
	MenuItemShowErrorInfo.Checked := not MenuItemShowErrorInfo.Checked;
end;


// This event is called after the Interp handle for Tcl1 is opened. The handle
// per design of this module, will not be closed until termination of this application.
//
// The following two procedures set up the directory info for Tslc Scripts

procedure TScriptPad.Tcl1BeforeInitInterp(Sender: TObject;
  AInterp: pTcl_Interp);
begin
	Tcl_GlobalEval(AInterp, 'set tslc_library $env(TSLC_LIBRARY)');
    Tcl_GlobalEval(AInterp, 'set tslc_pad 1');
	Tcl_GlobalEval(AInterp, 'set argc 0; set argv {}; set argv0 {}; set tcl_interactive 0');
end;

procedure TScriptPad.Tcl1AfterInitInterp(Sender: TObject;
  AInterp: pTcl_Interp);
var
	info: Tcl_CmdInfo;
begin

	Tcl_GlobalEval(AInterp, 'lappend auto_path $tslc_library');

	if Tcl_GetCommandInfo(AInterp, 'exit', info) <> 0 then
	begin
		if IsTslcCmdInfo(TclCmd_exit, @info, nil) then
			TclError('Potential infinite recursion in "exit" command');
        FExitInfo := info;
		TclCmd_exit.Install(AInterp);
	end else if false then
		TclError('TslcCompress: unable to locate native *exit* command');

    // Take advantage of resourced Tcl/Tk library scripts. Makes apps a bit easier to deploy... well...
	with Sender as TTcl do
    	if not (toPerformInit in Options) then // in this case, we infer the flag means perform here
			if Tcl_Init(AInterp) <> TCL_OK then
            	MessageBox(0, Tcl_GetStringResult(AInterp), 'Error', MB_ICONSTOP);
end;


procedure TScriptPad.MemoScriptKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
{$IFNDEF VER90}
type
  TTextRange = record
    chrg: TCharRange;
    lpstrText: PChar;
  end;
{$ENDIF}
const
	cMaxBuf = 32;
var
	l, r, c, h: integer;
    tRange: TTextRange;
    buf: array[0..cMaxBuf] of char;
    cmd: string;
    prevProc: longint;//TWordBreakProcEx; threads
begin
	if key = VK_F1 then
    begin
    	h := MemoScript.Handle;
    	prevProc := SendMessage(h, EM_GETWORDBREAKPROC, 0, 0);
	   	SendMessage(h, EM_SETWORDBREAKPROC, 0, longint(@EditWordBreakProcEx));
		try
	    	c := HIWORD(SendMessage(h, EM_GETSEL, 0, 0));
			l := SendMessage(h, EM_FINDWORDBREAK, WB_LEFT, c);
	        r := SendMessage(h, EM_FINDWORDBREAK, WB_RIGHTBREAK, c);
			if r - l  > cMaxBuf - 1 then // that is... R - L > cMaxBuf - ONE
	        	r := l + cMaxBuf - 1;
	        buf[0] := #0;
			tRange.chrg.cpMin := l;
	        tRange.chrg.cpMax := r;
	        tRange.lpstrText := @buf[0];
	        SendMessage(h, EM_GETTEXTRANGE, 0, longint(@tRange));
        finally
        	SendMessage(h, EM_SETWORDBREAKPROC, 0, prevProc);
        end;
        cmd := trim(buf);
		Application.HelpCommand(HELP_PARTIALKEY, longint(pChar(cmd)));
    end;
end;

// The following is a helper for setting global script variables. Scripts often make reference to
// other script files via the *source* command. It's common for users of Tcl world-wide to need
// to reference the variables *tcl_libraray* and *tk_library*. For the Tslc Components, we'll
// provide *tslc_library* which points to sample scripts. It may serve a greater purpose
// at a later date.
// Note the environment vars are in uppercase, the script vars are in lower case.
procedure SetEnvVars;
const
	cBufSize = 255;
    cLibrary = 'TSLC_LIBRARY';
var
    buf: array[0..cBufSize] of char;
    data: string;
    p: pChar;
    cx, i: integer;
begin
	if GetEnvironmentVariable(cLibrary, buf, cBufSize) = 0 then
		if TslcGetConfigStr('', '', 'tslc_root', data) then
	    begin
    	    strpcopy(buf, data);
			SetEnvironmentVariable(cLibrary, strlcat(buf, '/library', cBufSize));
	    end else
        begin
		// This probably won't work for deploys, but should suffice for typical dist. installations
			p := strplcopy(buf, Application.ExeName, cBufSize);
            cx := 0;
			while p^ <> #0 do
            begin
            	inc(p);
                inc(cx);
            end;
			i := 0;
           	while (cx > 0) and (i < 3) do
            begin
            	dec(p);
                dec(cx);
            	if p^ = '\' then
                	inc(i);
            end;
            if i = 3 then // moving up three directories
            begin
            	inc(p);
            	p^ := #0;
				data := buf + 'library';
	    	end else
            	data := ExtractFilePath(Application.ExeName) + 'library';
        	SetEnvironmentVariable(cLibrary, pChar(data));
		end;


// Env vars may be necessary if the following is non-existant
// [HKEY_LOCAL_MACHINE\SOFTWARE\Sun\Tcl\8.0]
// "Root"="E:\\PROGRA~1\\Tcl"

// Edit the following paths to the appropriate directory.
//
// The following vars provide the directories that contain important utility scripts. It's
// possible to run scripts without them.

//	root := 'c:\progra~1\Tcl\lib';
//	SetEnvironmentVariable('TCL_LIBRARY', pChar(root + '\tcl8.0'));
//  SetEnvironmentVariable('TK_LIBRARY', pChar(root + '\tk8.0'));
//	SetEnvironmentVariable('TIX_LIBRARY', 'tix4.1/library');

{$IFDEF TSLC_RESOURCE}
	SetEnvironmentVariable('TCL_LIBRARY', cTslcTclResLibPath);
	SetEnvironmentVariable('TK_LIBRARY', cTslcTkResLibPath);
{$ENDIF}
end;

const
	TCL_MODE_BLOCKING = 0;
    TCL_MODE_NONBLOCKING = 1;
	EZERO	= 0;
	EINVFNC	= 1;
	ENOFILE	= 2;
	ENOPATH	= 3;
	ECONTR	= 7;
	EINVMEM	= 9;
	EINVENV	= 10;
	EINVFMT	= 11;
	EINVACC	= 12;
	EINVDAT	= 13;
	EINVDRV	= 15;
	ECURDIR	= 16;
	ENOTSAM	= 17;
	ENMFILE	= 18;
	ENOENT	= 2;
	EMFILE	= 4;
	EACCES	= 5;
	EBADF	= 6;
	ENOMEM	= 8;
	EFAULT	= 14;
	ENODEV	= 15;
	EINVAL	= 19;
	E2BIG	= 20;
	ENOEXEC	= 21;
	EXDEV	= 22;
	ENFILE	= 23;
	ECHILD	= 24;
	ENOTTY	= 25;
	ETXTBSY	= 26;
	EFBIG	= 27;
	ENOSPC	= 28;
	ESPIPE	= 29;
	EROFS	= 30;
	EMLINK	= 31;
	EPIPE	= 32;
	EDOM	= 33;
	ERANGE	= 34;
	EEXIST	= 35;
	EDEADLOCK	= 36;
	EPERM	= 37;
	ESRCH	= 38;
	EINTR	= 39;
	EIO	= 40;
	ENXIO	= 41;
	EAGAIN	= 42;
	ENOTBLK	= 43;
	EBUSY	= 44;
	ENOTDIR	= 45;
	EISDIR	= 46;
	EUCLEAN	= 47;
	ENAMETOOLONG	= 48;

procedure TScriptPad.TclChannel3Input(Sender: TTclChannel; buf: PChar;
  toRead: Integer; var errorCodePtr, result: Integer);
var
	winMsg: TMsg;
begin
	if ActiveControl <> MemoResults then
		MemoResults.SetFocus;
//    MemoResults.ReadOnly := False;
//	CheckCancelHit;
	repeat
		if PeekMessage(winMsg, EvalBtn.handle, WM_LBUTTONDOWN, WM_LBUTTONDOWN, PM_REMOVE)
    		or
	       PeekMessage(winMsg, EvalBtn.handle, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) then
		begin
    		result := -1;
	        errorCodePtr := EINTR;
    	    exit;
	    end;
		Application.ProcessMessages;
//   	MemoResults.ReadOnly := True;
    	result := length(FBuffer);
	until (FStdInBlockMode = TCL_MODE_NONBLOCKING) or (result > 0);
    if result < toRead then
    	toRead := result;
    strplcopy(buf, FBuffer, toRead);
	FBuffer := '';
//    until FCarriageReturn;
//	str := MemoResults.Lines.Strings[MemoResults.Lines.Count - 1] + #10;
end;

procedure TScriptPad.PanelPopDblClick(Sender: TObject);
begin
	EditPad := True;
end;

procedure TScriptPad.LabelScriptDblClick(Sender: TObject);
begin
	EditPad := False;
end;

procedure SetRichEditTabs(re: TRichEdit; t: integer);
var
	x, w, b: integer;
begin

	with TControlCanvas.Create do
    try
    	Control := re;
        Font.Assign(re.Font);
        w := TextWidth('N');
    finally
    	free;
    end;

    b := (t - 1) * w;
    t := t * w;
	re.Lines.BeginUpdate;
    try
		for x:= 0 to 15 do
    		re.Paragraph.Tab[x] := x * t + b;
    finally
    	re.Lines.EndUpdate;
    end;
end;

function QueryTabs: integer;
var
	str: string;
begin
    repeat
        str := '8';
    	if not InputQuery('Tabs', 'Enter tab width:', str) then
        	result := 0
        else
        	result := StrToIntDef(str, -1);
    until result >= 0;
end;

procedure TScriptPad.MenuItemTabsClick(Sender: TObject);
var
	t: integer;
begin
	t := QueryTabs;
    if t > 0 then
{$IFDEF RICHEDITS}
        SetRichEditTabs(MemoScript, t);
{$ELSE}
{$ENDIF}
end;

procedure TScriptPad.MenuItemResultsTabsClick(Sender: TObject);
var
	t: integer;
begin
	t := QueryTabs;
    if t > 0 then
{$IFDEF RICHEDITS}
        SetRichEditTabs(MemoResults, t);
{$ELSE}
{$ENDIF}
end;

procedure TScriptPad.MenuItemUnixClick(Sender: TObject);
begin
	MenuItemUnix.Checked := not MenuItemUnix.Checked;
end;

// Borrowed from Dialogs.pas
function TScriptPad.InputPassword(APrompt: string; var password: string): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
	Result := False;
	Form := TForm.Create(Application);
	with Form do
	try
        Font := Self.Font;
    	BorderStyle := bsDialog;
	    Caption := 'Password Dialog';
    	ClientWidth := 120;
    	ClientHeight := 76;
      	Position := poScreenCenter;
    	Prompt := TLabel.Create(Form);
    	with Prompt do
    	begin
        	Parent := Form;
	        AutoSize := True;
    	    Left := 8;
        	Top := 5;
        	Caption := APrompt;
      	end;
      	Edit := TEdit.Create(Form);
      	with Edit do
      	begin
        	Parent := Form;
        	Left := Prompt.Left;
        	PasswordChar := '*';
        	Top := 22;
        	Width := 104;
        	MaxLength := 8;
        	Text := '        ';
        	SelectAll;
      	end;
      	ButtonTop := 50;
      	ButtonWidth := 48;
      	ButtonHeight := 20;
      	with TButton.Create(Form) do
      	begin
        	Parent := Form;
	        Caption := 'OK';
	        ModalResult := mrOk;
	        Default := True;
	        SetBounds(8, ButtonTop, ButtonWidth, ButtonHeight);
		end;
		with TButton.Create(Form) do
     	begin
        	Parent := Form;
        	Caption := 'Cancel';
        	ModalResult := mrCancel;
        	Cancel := True;
        	SetBounds(64, ButtonTop, ButtonWidth, ButtonHeight);
      	end;
      	if ShowModal = mrOk then
      	begin
        	password := Edit.Text;
        	Result := True;
      	end;
	finally
    	Form.Free;
    end;
end;

procedure TScriptPad.TclCmd_TkPadPrepare(Sender: TTclCommand; var result: string; var success: boolean);
begin
	Sender.ClientData := nil;
end;

procedure TScriptPad.TclCmd_TkPanel_focusSwitch(Sender: TTclCmdSwitch;
  ASwitch: string; var result: string; var success: Boolean);
begin
	Sender.Command.ClientData := TObject(1);
end;

procedure TScriptPad.TclCmd_TkPadCommand(Sender: TTclCommand;
  var result: string; var success: Boolean);
var
	cnt: integer;
    param: string;
    sheet: TTabSheet;
    tkwin: pTk_Window;
begin
   	param := Sender.ParamValues[0];
    if TslcTextEqual(param, 'PANEL') then
    begin
		param := Sender.ParamValues[1];
	   	if TslcTextEqual(param, 'TkPanel') then
	    begin
	    	sheet := SheetTk;
	        result := inttostr(TkPanel.Handle);
	    end else if TslcTextEqual(param, 'TkScroll') then
	    begin
	    	sheet := SheetScroll;
	        result := inttostr(TkScroll.Handle);
	    end else if TslcTextEqual(param, 'Results') then
	    begin
	    	sheet := SheetResults;
	        result := '0';
	    end else
	    	TclError('TkPanel: Unknown Panel');
		if Sender.ClientData <> nil then
	    begin
	    	Pages.ActivePage := sheet;
	        Update;
	    end;
        exit;
    end;
    if TslcTextEqual(param, 'ISEMBEDDED') then
    begin
    	result := '0';
        if TkLoaded('') then // determine if Tk was loaded, perhaps by script; otherwise, nothing can be possibly be embedded here.
        begin
        	if not InitializedTk then // The Tcl Components don't need the Tk windowing package; therefore, it's not
            	InitTk('');				// explicity loaded when the Tcl engine is loaded. Since we're about to use
                                        // some Tk library exports to determine if the parameter is embedded, we'll load now.
			tkwin := Tk_MainWindow(Sender.Interp);
            if tkwin <> nil then
            begin
            	tkwin := Tk_NameToWindow(Sender.Interp, pChar(Sender.ParamValues[1]), tkwin);
                if (tkwin <> nil) and ((tkwin^.flags and TK_EMBEDDED) <> 0) then
                	result := '1';
            end;
        end;
    	exit;
    end;
    TclError(Sender.ErrorMsg);
end;

procedure TScriptPad.Tcl1BeforeClose(Sender: TTcl);
begin
	TclChannel1.Close;
	TclChannel2.Close;
	TclChannel3.Close;
end;

procedure TScriptPad.Tcl1InitError(Sender: TObject; AInterp: pTcl_Interp);
begin
	// This error happened because the Tcl engine could not locate the init.tcl script.
	// If *toPerform* is set in Tcl1.Options, Tcl_Init will be called immediately after
    // creation of the interpreter handle. To get around file system dependency on
    // library scripts, uTslcLib provides a transparent mechanism to load common library
    // scripts from resource. See uTslcLib for more information.
    // Init.tcl is not required for successful script evaluations.
	MessageBox(0, Tcl_GetStringResult(AInterp), 'Error', MB_ICONSTOP);
end;

procedure TScriptPad.TclCmd_exitCommand(Sender: TTclCommand;
  var result: string; var success: Boolean);
begin
	if Evaluating then
    begin
		PostMessage(BtnEval.Handle, WM_LBUTTONDOWN, 0, 0);
        PostMessage(BtnEval.Handle, WM_LBUTTONUP, 0, 0);
    end;
end;

procedure TScriptPad.MemoResultsKeyPress(Sender: TObject; var Key: Char);
begin
	FBuffer := FBuffer + key;
    key := #0;
end;

procedure TScriptPad.TclChannel3BlockMode(Sender: TTclChannel;
  mode: Integer; var result: Integer);
begin
	FStdInBlockMode := mode;
end;

initialization
	SetEnvVars;

{$IFDEF TSLC_SECURE}
 	// Commenting out next line would result in the usage of the default StaticKey.
	SetStaticKey(TslcGetStaticKey, 0); // Created using script: StaticKey Gen <?secretkey?>
{$ENDIF}
end.







