unit got_main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ToolWin, ComCtrls, ecSyntMemo, ecSyntAnal, Menus,
  ActnList, ecPopupCtrl, ecSyntDlg, ecKeyMap, StdActns, ecStrUtils;

type
  TForm3 = class(TForm)
    SyntAnalyzer1: TSyntAnalyzer;
    SyntaxMemo1: TSyntaxMemo;
    imglGutterGlyphs: TImageList;
    imglActions: TImageList;
    actlMain: TActionList;
    actDebugStep: TAction;
    actDebugGotoCursor: TAction;
    actToggleBreakpoint: TAction;
    actClearAllBreakpoints: TAction;
    MainMenu1: TMainMenu;
    mDebug: TMenuItem;
    miDebugStep: TMenuItem;
    miDebugGotoCursor: TMenuItem;
    N1: TMenuItem;
    miToggleBreakpoint: TMenuItem;
    miClearBreakpoints: TMenuItem;
    tbDebug: TToolBar;
    tbtnRun: TToolButton;
    tbtnStep: TToolButton;
    tbtnGotoCursor: TToolButton;
    tbtnPause: TToolButton;
    ToolButton1: TToolButton;
    ParamCompletion1: TParamCompletion;
    SyntFindDialog1: TSyntFindDialog;
    SyntReplaceDialog1: TSyntReplaceDialog;
    SyntStyles1: TSyntStyles;
    EditPaste1: TEditPaste;
    ToolButton2: TToolButton;
    ParameterComplStyles: TSyntStyles;
    procedure SyntaxMemo1TGutterObjects0CheckLine(Sender: TObject;
      Line: Integer; var Show: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SyntaxMemo1TGutterObjects1CheckLine(Sender: TObject;
      Line: Integer; var Show: Boolean);
    procedure SyntaxMemo1TGutterObjects2CheckLine(Sender: TObject;
      Line: Integer; var Show: Boolean);
    procedure SyntaxMemo1TGutterObjects3CheckLine(Sender: TObject;
      Line: Integer; var Show: Boolean);
    procedure SyntaxMemo1TGutterObjects4CheckLine(Sender: TObject;
      Line: Integer; var Show: Boolean);
    procedure SyntaxMemo1GutterClick(Sender: TObject; Line: Integer;
      Buton: TMouseButton; Shift: TShiftState; XY: TPoint);
    procedure actToggleBreakpointExecute(Sender: TObject);
    procedure actToggleBreakpointUpdate(Sender: TObject);
    procedure actClearAllBreakpointsExecute(Sender: TObject);
    procedure actClearAllBreakpointsUpdate(Sender: TObject);
    procedure actDebugGotoCursorExecute(Sender: TObject);
    procedure actDebugGotoCursorUpdate(Sender: TObject);
    procedure actDebugStepExecute(Sender: TObject);
    procedure SyntAnalyzer1TokenRules0MouseClick(TokenIndex: Integer;
      Button: TMouseButton; Shift: TShiftState);
    procedure ParamCompletion1GetParams(Sender: TObject;
      const FuncName: String; Pos: Integer);
    procedure ParamCompletion1GetParamsEx(Sender: TObject;
      const FuncNames: TStrings);
  private
    FBreakPoints: TList;
    FCurrentLine: integer;
    function IsBreakPt(Line: integer): boolean;
    function IsCodeLine(Line: integer): Boolean;
    procedure ToggleBreakpoint(Line: integer);
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
begin
  FBreakPoints := TList.Create;
  FCurrentLine := -1;
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  FBreakPoints.Free;
end;

function TForm3.IsBreakPt(Line: integer): boolean;
begin
  Result := FBreakPoints.IndexOf(Pointer(Line)) <> -1;
end;

function TForm3.IsCodeLine(Line: integer): Boolean;
begin
  Result := Line In [3, 4, 5, 9, 10, 11, 12];
end;

// Use OnCheckLine events of gutter object

procedure TForm3.SyntaxMemo1TGutterObjects0CheckLine(Sender: TObject;
  Line: Integer; var Show: Boolean);
begin
  Show := IsCodeLine(Line) and not IsBreakPt(Line) and (FCurrentLine <> Line);
end;

procedure TForm3.SyntaxMemo1TGutterObjects1CheckLine(Sender: TObject;
  Line: Integer; var Show: Boolean);
begin
  Show := not IsBreakPt(Line) and (FCurrentLine = Line);
end;

procedure TForm3.SyntaxMemo1TGutterObjects2CheckLine(Sender: TObject;
  Line: Integer; var Show: Boolean);
begin
  Show := IsBreakPt(Line) and (FCurrentLine = Line);
end;

procedure TForm3.SyntaxMemo1TGutterObjects3CheckLine(Sender: TObject;
  Line: Integer; var Show: Boolean);
begin
  Show := IsBreakPt(Line) and not IsCodeLine(Line);
end;

procedure TForm3.SyntaxMemo1TGutterObjects4CheckLine(Sender: TObject;
  Line: Integer; var Show: Boolean);
begin
  Show := IsBreakPt(Line) and IsCodeLine(Line) and (FCurrentLine <> Line);
end;

// After toggle break point or changing current line
// we have to invalidate editor because it does not know about these changes.

procedure TForm3.ToggleBreakpoint(Line: integer);
begin
  if IsBreakPt(Line) then FBreakPoints.Remove(TObject(Line))
   else FBreakPoints.Add(TObject(Line));
  SyntaxMemo1.Invalidate;
end;

procedure TForm3.SyntaxMemo1GutterClick(Sender: TObject; Line: Integer;
  Buton: TMouseButton; Shift: TShiftState; XY: TPoint);
begin
  ToggleBreakpoint(Line);
end;

procedure TForm3.actToggleBreakpointExecute(Sender: TObject);
begin
  ToggleBreakpoint(SyntaxMemo1.CaretPos.Y);
end;

procedure TForm3.actToggleBreakpointUpdate(Sender: TObject);
begin
  actToggleBreakpoint.Enabled := IsCodeLine(SyntaxMemo1.CaretPos.Y);
end;

procedure TForm3.actClearAllBreakpointsExecute(Sender: TObject);
begin
  FBreakPoints.Clear;
  SyntaxMemo1.Invalidate;
end;

procedure TForm3.actClearAllBreakpointsUpdate(Sender: TObject);
begin
  actClearAllBreakpoints.Enabled := FBreakPoints.Count > 0;
end;

procedure TForm3.actDebugGotoCursorExecute(Sender: TObject);
begin
  FCurrentLine := SyntaxMemo1.CaretPos.Y;
  SyntaxMemo1.Invalidate;
end;

procedure TForm3.actDebugGotoCursorUpdate(Sender: TObject);
begin
  actDebugGotoCursor.Enabled := IsCodeLine(SyntaxMemo1.CaretPos.Y);
end;

procedure TForm3.actDebugStepExecute(Sender: TObject);
begin
  // Emulate programm step
  case FCurrentLine of
    5: FCurrentLine := 10;
    11: FCurrentLine := 3;
    3,4,9,10: Inc(FCurrentLine);
    else FCurrentLine := 9;
  end;
  // Show line of current execution point (if it is collapsed)
  SyntaxMemo1.ShowLine(FCurrentLine);
  SyntaxMemo1.Invalidate;
end;

procedure TForm3.SyntAnalyzer1TokenRules0MouseClick(TokenIndex: Integer;
  Button: TMouseButton; Shift: TShiftState);
begin
  if ssCtrl in Shift then
   begin
    ShowMessage(SyntaxMemo1.SyntObj.TagStr[TokenIndex]);
    Abort;
   end;
end;

procedure TForm3.ParamCompletion1GetParams(Sender: TObject;
  const FuncName: String; Pos: Integer);
begin
  // Old Style function name processing
{  with TParamCompletion(Sender) do
   begin
    Items.Clear;
    if SameText(FuncName, 'TestProc') then
     begin
      Items.Add('Param1: double; Param2: double; Param3: double; Param4: double; Param5: double; Param6: double');
//      Items.Add('Param1: double; Param1: double; Param1: double; Param1: doubleParam2: double');
      Items.Add('Param1: string');
     end else
    if SameText(FuncName, 'Process') then
      Items.Add('Obj: TObject');
   end;}
end;

var n: integer = 0;
procedure TForm3.ParamCompletion1GetParamsEx(Sender: TObject;
  const FuncNames: TStrings);
begin
  with TParamCompletion(Sender) do
    if (FuncNames.Count = 2) and (FuncNames[1] = 'TestProc') and (FuncNames[0] = 'Obj') then
      begin
        if FmtEnable then
          begin
            AddItem('\s1\procedure \i5\\s4\TMyClass\s5\.\s2\TestProc\s5\(' +
                    '\s3\\x\Param1: double\s5\;\x\ \s3\\x\Param2: double\s5\;\x\' + sLineBreak +
                    '\s3\\x\Param3: double;\x\ \s3\\x\Param4: double;\x\' + sLineBreak +
                    '\s3\\x\Param5: double;\x\ \s3\\x\Param6: double\x\\s5\)');
            AddItem('\s1\procedure \i5\\s4\TMyClass\s5\.\s2\TestProc\s5\(\s3\\x\Param1: string\s5\;\x\ \s3\\x\Param2: double\x\\s5\)');
          end else
          begin
            AddItem('Param1: double; Param2: double;' + sLineBreak + 'Param3: double; Param4: double;' + sLineBreak + 'Param5: double; Param6: double');
            AddItem('Param1: string; Param2: double');
          end;
      end else
    if (FuncNames.Count = 1) and (FuncNames[0] = 'Process') then
      if FmtEnable then
        AddItem('\s1\procedure \i5\\s2\Process\s5\(\s3\\x\Obj: TObject\x\\s5\[;\s4\\x\OptionalPar: string\x\\s5\])')
      else
        AddItem('Obj: TObject');
end;

end.

