fmmain.pas

Delphi脚本控件

////////////////////////////////////////////////////////////////////////////
// PAXScript IDE
// Author: Alexander Baranovsky ([e-mail])
// ========================================================================
// Copyright (c) Alexander Baranovsky, 2003-2004. All rights reserved.
// Code Version: 2.6
// ========================================================================
// Unit: fmMain.pas
// ========================================================================
////////////////////////////////////////////////////////////////////////////

unit fmMain;

interface

uses
  SysUtils, Classes,
  contnrs,
{$IFDEF LINUX}
  Qt,
  Types,
  QTypes,
  QGraphics, QControls, QForms, QDialogs,
  QExtCtrls, QMenus, QStdCtrls, QComCtrls,
  QImgList, QButtons,
{$ELSE}
  Windows,
  Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus, StdCtrls, ComCtrls,
  ImgList, Buttons, ShellAPI,
{$ENDIF}
  fmExplorer,

  SynEdit, SynEditHighlighter,

  SynHighlighterPaxC, SynHighlighterPaxBasic,
  SynHighlighterPaxPascal, SynHighlighterPaxJavaScript,

  BASE_SYS, BASE_SCRIPTER, PAX_RTTI,

  IMP_SysUtils, IMP_Contnrs, IMP_Classes, IMP_ActiveX, 
  IMP_Controls,
  IMP_StdCtrls, IMP_ComCtrls, IMP_Buttons, IMP_Forms,
  IMP_Graphics, IMP_ExtCtrls, IMP_Dialogs, IMP_Menus, IMP_ImgList,

{$ifdef Ver150}
  IMP_Variants,
{$endif}

  PaxScripter, PaxJavaScript, PaxC, PaxBasic, PaxPascal, BASE_PARSER;

const
  paxsite = 'http://www.paxscript.com/';
  helpsite = '\Help\index.htm';
  ininame = 'paxide.ini';
  HeightNoProject = 95;

  paxProject_Ext = '.pax';

type
  TLineInfo = (dlTraceLine, dlBreakpointLine, dlExecutableLine, dlBadBreakpointLine,
               dlErrorLine);
  TLineInfos = set of TLineInfo;

  TIDEState = (ideNoProject, ideInit, idePaused);

  TEditor = class (TSynEdit)
  public
    TraceLine: Integer;
    constructor Create(AOwner: TComponent); override;
    procedure RemoveLineInfos(LineInfos: TLineInfos);
  end;

  TLineRecord = class
    ModuleName: String;
    LineNumber: Integer;
    Condition: String;
    PassCount: Integer;
    LineInfos: TLineInfos;
    constructor Create(const ModuleName: String; LineNumber: Integer;
                       const Condition: String; PassCount: Integer;
                       LineInfos: TLineInfos);
  end;

  TFormMain = class;

  TDebugSupportPlugin = class(TSynEditPlugin)
  protected
    fForm: TFormMain;
    procedure AfterPaint(ACanvas: TCanvas; AClip: TRect;
      FirstLine, LastLine: integer); override;
    procedure LinesInserted(FirstLine, Count: integer); override;
    procedure LinesDeleted(FirstLine, Count: integer); override;
  public
    constructor Create(Editor: TEditor);
  end;

  TFormMain = class(TForm)
    PanelTop: TPanel;
    PanelBottom: TPanel;
    MainMenu1: TMainMenu;
    mFile: TMenuItem;
    mOpenProject: TMenuItem;
    N1: TMenuItem;
    mNewProject: TMenuItem;
    N2: TMenuItem;
    mSave: TMenuItem;
    N3: TMenuItem;
    mExit: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    mRun: TMenuItem;
    mAddBreakpoint: TMenuItem;
    N4: TMenuItem;
    RunScript: TMenuItem;
    N5: TMenuItem;
    mStepOver: TMenuItem;
    mTraceInto: TMenuItem;
    mProject: TMenuItem;
    mAddToProject: TMenuItem;
    mRemoveFromProject: TMenuItem;
    PageControl1: TPageControl;
    mHelp: TMenuItem;
    mAbout: TMenuItem;
    PanelBottomLeft: TPanel;
    PanelBottomRight: TPanel;
    PanelBottomCenter: TPanel;
    LabelBottomLeft: TLabel;
    LabelBottomCenter: TLabel;
    LabelBottomRight: TLabel;
    imglGutterGlyphs: TImageList;
    mProgramReset: TMenuItem;
    PageControl2: TPageControl;
    TreeView1: TTreeView;
    TabSheetWatches: TTabSheet;
    ListBoxWatches: TListBox;
    TabSheetBreakpoints: TTabSheet;
    ListBoxBreakpoints: TListBox;
    TabSheetCallStack: TTabSheet;
    ListBoxCallStack: TListBox;
    mRunToCursor: TMenuItem;
    mTraceToNextSourceLine: TMenuItem;
    mClose: TMenuItem;
    N7: TMenuItem;
    SpeedButtonNew: TSpeedButton;
    SpeedButtonOpen: TSpeedButton;
    SpeedButtonSave: TSpeedButton;
    SpeedButtonAdd: TSpeedButton;
    SpeedButtonRemove: TSpeedButton;
    SpeedButtonRun: TSpeedButton;
    SpeedButtonHelp: TSpeedButton;
    SpeedButtonTraceInto: TSpeedButton;
    SpeedButtonStepOver: TSpeedButton;
    mRemoveAllBreakpoints: TMenuItem;
    N6: TMenuItem;
    mCompile: TMenuItem;
    mEdit: TMenuItem;
    mUndo: TMenuItem;
    mRedo: TMenuItem;
    N8: TMenuItem;
    mCut: TMenuItem;
    mCopy: TMenuItem;
    mPaste: TMenuItem;
    mDelete: TMenuItem;
    mSelectAll: TMenuItem;
    OnlineHelp1: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    PaxScriptHomePage1: TMenuItem;
    AddWatch1: TMenuItem;
    View1: TMenuItem;
    mConsole: TMenuItem;
    N11: TMenuItem;
    ViewSource1: TMenuItem;
    PaxScripter1: TPaxScripter;
    Search1: TMenuItem;
    Find1: TMenuItem;
    SearchAgain1: TMenuItem;
    PaxPascal1: TPaxPascal;
    PaxBasic1: TPaxBasic;
    PaxC1: TPaxC;
    PaxJavaScript1: TPaxJavaScript;
    PaintBox1: TPaintBox;
    procedure mExitClick(Sender: TObject);
    procedure mOpenProjectClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure mAddBreakpointClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mNewProjectClick(Sender: TObject);
    procedure mAddToProjectClick(Sender: TObject);
    procedure mRemoveFromProjectClick(Sender: TObject);
    procedure RunScriptClick(Sender: TObject);
    procedure mCompileClick(Sender: TObject);
    procedure mTraceIntoClick(Sender: TObject);
    procedure mStepOverClick(Sender: TObject);
    procedure mProgramResetClick(Sender: TObject);
    procedure ListBoxWatchesKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure mRunToCursorClick(Sender: TObject);
    procedure mTraceToNextSourceLineClick(Sender: TObject);
    procedure ListBoxCallStackDblClick(Sender: TObject);
    procedure mCloseClick(Sender: TObject);
    procedure mSaveClick(Sender: TObject);
    procedure SpeedButtonOpenClick(Sender: TObject);
    procedure SpeedButtonNewClick(Sender: TObject);
    procedure SpeedButtonSaveClick(Sender: TObject);
    procedure SpeedButtonAddClick(Sender: TObject);
    procedure SpeedButtonRemoveClick(Sender: TObject);
    procedure SpeedButtonHelpClick(Sender: TObject);
    procedure mAboutClick(Sender: TObject);
    procedure mRemoveAllBreakpointsClick(Sender: TObject);
    procedure SpeedButtonRunClick(Sender: TObject);
    procedure SpeedButtonTraceIntoClick(Sender: TObject);
    procedure SpeedButtonStepOverClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mUndoClick(Sender: TObject);
    procedure mRedoClick(Sender: TObject);
    procedure mCutClick(Sender: TObject);
    procedure mCopyClick(Sender: TObject);
    procedure mDeleteClick(Sender: TObject);
    procedure mSelectAllClick(Sender: TObject);
    procedure PaxScripter1ShowError(Sender: TPaxScripter);
    procedure PaxScripter1BeforeRunStage(Sender: TPaxScripter);
    procedure PaxScripter1BeforeCompileStage(Sender: TPaxScripter);
    procedure PaxScripter1AssignScript(Sender: TPaxScripter);
    procedure PaxScripter1AfterCompileStage(Sender: TPaxScripter);
    procedure OnlineHelp1Click(Sender: TObject);
    procedure ListBoxBreakpointsDblClick(Sender: TObject);
    procedure PaxScriptHomePage1Click(Sender: TObject);
    procedure PaxScripter1Print(Sender: TPaxScripter; const S: String);
    procedure mPasteClick(Sender: TObject);
    procedure AddWatch1Click(Sender: TObject);
    procedure mConsoleClick(Sender: TObject);
    procedure ViewSource1Click(Sender: TObject);
    procedure TreeView1DblClick(Sender: TObject);
    procedure TreeView1Click(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure PaxScripter1CompilerProgress(Sender: TPaxScripter;
      ModuleNumber: Integer);
    procedure Find1Click(Sender: TObject);
    procedure SearchAgain1Click(Sender: TObject);
  private
//Code explorer
    PosList: TObjectList;
    procedure EnumProc(const Name: String;
                       ID: Integer;
                       Kind: TPAXMemberKind;
                       ml: TPAXModifierList;
                       Data: Pointer);
     procedure SetupClassNode(N: TTreeNode; ID: Integer);
     procedure SetupFuncNode(N: TTreeNode; ID: Integer);
     procedure RebuildCodeExplorerTree;
  private
    SignSyntaxCheck: Boolean;
    IniFile: TPAXIniFile;
    ScriptWasAssigned: Boolean;

    SynPaxPascalSyn1: TSynPaxPascalSyn;
    SynPaxBasicSyn1: TSynPaxBasicSyn;
    SynPaxCSyn1: TSynPaxCSyn;
    SynPaxJavaScriptSyn1: TSynPaxJavaScriptSyn;

    ProjectName: String;
    ScriptAge: Integer;

    HeightOpenProject: Integer;
    PageControl2Height: Integer;

    ideState: TIDEState;

    CompileAndRun: Boolean;

    SearchString: String;
    SearchPos: Integer;

    procedure SetIDEState(IDEState: TIDEState);
    function FindPage(const ModuleName: String): TTabSheet;

    function FindEditor(Page: TTabSheet): TEditor; overload;
    function FindEditor(const ModuleName: String): TEditor; overload;

    procedure ToggleBreakpoint(ALine: Integer);
    function GetLineInfos(ALine: Integer): TLineInfos;
    { Private declarations }

    function IsExecutableLine(ALine: integer): boolean;
    function IsBreakpointLine(ALine: integer): boolean;
    function IsBadBreakpointLine(ALine: integer): boolean;
    function IsErrorLine(ALine: integer): boolean;

    function CurrentEditor: TEditor;
    function CurrentModuleName: String;
    function CurrentModuleID: Integer;
    function CurrentLineNumber: Integer;
    function CurrentPosNumber: Integer;
    function GetLineRecord(LineNumber: Integer): TLineRecord;
    procedure SetLineRecord(LineNumber: Integer; LineRecord: TLineRecord);
    procedure UpdateBottomLeftLabel;
    procedure AddBreakpoints;
    procedure RemoveAllBreakpoints;
    procedure RemoveError;
    function ScriptHasBeenChanged: Boolean;
    procedure SetTraceLine(const ModuleName: String; ALine: integer);
    procedure RemoveTraceLine;
    procedure Trace(RunMode: Integer; const ModuleName: String = ''; ALine: integer = 0);

    procedure PaintGutterGlyphs(ACanvas: TCanvas; AClip: TRect;
                                FirstLine, LastLine: integer);
    procedure EditorSpecialLineColors(Sender: TObject; Line: Integer;
      var Special: Boolean; var FG, BG: TColor);
    procedure EditorKeyUp(Sender: TObject; var Key: Word;
                             Shift: TShiftState);
    procedure EditorGutterClick(Sender: TObject; X, Y, Line: Integer;
      mark: TSynEditMark);
    procedure EditorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure EditorMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    function GetModName(Index: Integer): String;
    procedure UpdateLineNumbers;
  public
    WatchList: TStringList;
    function ModuleCount: Integer;
    procedure ShowError(Sender: TPaxScripter);
    function LanguageName: String;
    function GotoLine(const ModuleName: String; LineNumber: Integer): TEditor;

    procedure ProcessWatches;
    procedure ProcessCallStack;

    procedure CloseProject;
    procedure OpenNewProject(const FileName: String);
    procedure CreateNewProject(const FileName: String);
    procedure AddToProject(const ModuleName, FileName, LanguageName: String);
    procedure RemoveFromProject(const ModuleName: String);
    procedure SaveProject;

    property ModuleNames[Index: Integer]: String read GetModName;
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

uses fmNewProject, fmDelete, fmConsole, fmCompiling, fmAbout;

{$R *.dfm}

constructor TEditor.Create(AOwner: TComponent);
begin
  inherited;
  TraceLine := -1;
  WantTabs := true;
end;

procedure TEditor.RemoveLineInfos(LineInfos: TLineInfos);
var
  LineRecord: TLineRecord;
  J: Integer;
begin
  for J:=0 to Lines.Count - 1 do
    if Lines.Objects[J] <> nil then
    begin
      LineRecord := TLineRecord(Lines.Objects[J]);
      LineRecord.LineInfos := LineRecord.LineInfos - LineInfos;
      if LineRecord.LineInfos = [] then
      begin
        LineRecord.Free;
        Lines.Objects[J] := nil;
      end;
    end;
  Invalidate;
end;

constructor TDebugSupportPlugin.Create(Editor: TEditor);
begin
  inherited Create(Editor);
  fForm := FormMain;
end;

procedure TDebugSupportPlugin.AfterPaint(ACanvas: TCanvas; AClip: TRect;
  FirstLine, LastLine: integer);
begin
  FormMain.PaintGutterGlyphs(ACanvas, AClip, FirstLine, LastLine);
end;

procedure TDebugSupportPlugin.LinesInserted(FirstLine, Count: integer);
begin
end;

procedure TDebugSupportPlugin.LinesDeleted(FirstLine, Count: integer);
var
  I: Integer;
  Editor: TEditor;
begin
  Editor := FormMain.CurrentEditor;

  if Editor = nil then
    Exit;

  for I:=FirstLine to FirstLine + Count - 1 do
    if Editor.Lines.Objects[I] <> nil then
    begin
      Editor.Lines.Objects[I].Free;
      Editor.Lines.Objects[I] := nil;
    end;
end;

constructor TLineRecord.Create(const ModuleName: String; LineNumber: Integer;
                               const Condition: String; PassCount: Integer;
                               LineInfos: TLineInfos);
begin
  Self.ModuleName := ModuleName;
  Self.LineNumber := LineNumber;
  Self.Condition := Condition;
  Self.PassCount := PassCount;
  Self.LineInfos := LineInfos;
end;

procedure ErrMessageBox(const S1, S2: String);
begin
  ShowMessage(Format(S1, [S2]));
end;

procedure Foo;
begin
  ShowMessage('Foo');
end;

procedure TFormMain.FormCreate(Sender: TObject);
var
  S: String;
begin
  SignSyntaxCheck := false;

  SearchString := '';
  SearchPos := 1;

  PosList := TObjectList.Create;

  IniFile := TPAXIniFile.Create(ininame);
  S := IniFile['top'];
  if S <> '' then
    Top := StrToInt(S);
  S := IniFile['left'];
  if S <> '' then
    Left := StrToInt(S);
  S := IniFile['width'];
  if S <> '' then
    Width := StrToInt(S);
  S := IniFile['height'];
  if S <> '' then
    HeightOpenProject := StrToInt(S)
  else
  begin
    HeightOpenProject := Height;
    IniFile['height'] := IntToStr(Height);
  end;

  ScriptWasAssigned := false;

  SynPaxPascalSyn1 := TSynPaxPascalSyn.Create(Self);
  SynPaxBasicSyn1 := TSynPaxBasicSyn.Create(Self);
  SynPaxCSyn1 := TSynPaxCSyn.Create(Self);
  SynPaxJavaScriptSyn1 := TSynPaxJavaScriptSyn.Create(Self);

  S := ExtractFileDir(Application.ExeName);
  SetCurrentDir(S);

  OpenDialog1.InitialDir := S;
  SaveDialog1.InitialDir := S;

  ScriptAge := 0;

  LabelBottomLeft.Caption := '';
  LabelBottomCenter.Caption := '';
  LabelBottomRight.Caption := '';

  WatchList := TStringList.Create;

  PageControl2Height := PageControl2.Height;

  CloseProject;

  CompileAndRun := true;

  RegisterClassType(TFormMain, -1);
  PaxScripter1.RegisterObject('FormMain', Self);

  PaxScripter1.AssignEventHandlerRunner(@TFormMain.SpeedButtonRunClick, Self);
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  PosList.Free;

  WatchList.Free;

  SynPaxPascalSyn1.Free;
  SynPaxBasicSyn1.Free;
  SynPaxCSyn1.Free;
  SynPaxJavaScriptSyn1.Free;
end;

procedure TFormMain.mExitClick(Sender: TObject);
begin
  Close;
end;

procedure TFormMain.mOpenProjectClick(Sender: TObject);
begin
  with OpenDialog1 do
  begin
    Filter := 'PaxScript project file (*' + PaxProject_Ext + '|*' + PaxProject_Ext;
    if Execute then
    begin
      if Pos('.', FileName) = 0 then
        FileName := FileName + PaxProject_Ext;
      OpenNewProject(FileName);
    end;
  end;
end;

procedure TFormMain.EditorGutterClick(Sender: TObject; X, Y, Line: Integer;
  mark: TSynEditMark);
begin
  if CurrentEditor = nil then
    Exit;