{|----------------------------------------------------------------------
 | Unit:        DelExpert
 |
 | Author:      Egbert van Nes
 |
 | Description: The main form of DelForExp
 |
 | Copyright (c) 2000  Egbert van Nes
 |   All rights reserved
 |   Disclaimer and licence notes: see license.txt
 |
 |----------------------------------------------------------------------
}
unit DelExpert;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls, Delfor1, ToolsAPI, ComCtrls;
type
  TBookMarkRed = record
    Exists: Boolean;
    BookMarkNo: Integer;
    FPos: TOTAEditPos;
  end;

  TBookmarks = array[0..19] of TBookMarkRed;

  TBreakPoint = record
    StackFramesToLog: Integer;
    DoHandleExceptions: Boolean;
    DoIgnoreExceptions: Boolean;
    GroupName: string;
    DoBreak: Boolean;
    LogMessage: string;
    EvalExpression: string;
    LogResult: Boolean;
    EnableGroup: string;
    DisableGroup: string;
    Enabled: Boolean;
    Expression: string;
    FileName: string;
    LineNumber: Integer;
    PassCount: Integer;
  end;

  TBreakPoints = array of TBreakPoint;

  TDelExpertDlg = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    CurrentBtn: TButton;
    WholeProjBtn: TButton;
    OptionsButton: TButton;
    CancelBtn: TButton;
    HelpBtn: TButton;
    AllButton: TButton;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    RichEdit1: TRichEdit;
    procedure Label6Click(Sender: TObject);
    procedure CurrentBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure OptionsButtonClick(Sender: TObject);
    procedure WholeProjBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure AllButtonClick(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Label4Click(Sender: TObject);
  private
    ISourceEditor: IOTASourceEditor;
    FCurPos: TOTAEditPos;
    Bookmarks: TBookmarks;
    BreakPoints: TBreakPoints;
    procedure BeforeFormat(AFileName: string);
    procedure AfterFormat;

    procedure FormatterProgress(Sender: TObject; Progress: Integer);
    procedure CapFileNameEditChange(Sender: TObject);
  public
    HelpFile: string;
    CfgFile: string;
    procedure DoFormatFile(AFileName: string);
    { Public declarations }
  end;

var
  DelExpertDlg: TDelExpertDlg = nil;
  Formatter: TPascalParser = nil;

implementation
uses DelForExpert, DelForTypes, MyIDEStream, Progr, OptDlg, Dialogs,
  Setup1, ShellAPI, OTAUtils;

{$R *.DFM}

function IsReadonlyFile(const FileName: string): Boolean;
var
  Attributes: Integer;
begin
  Attributes := FileGetAttr(FileName);
  Result := {(Attributes = -1) or}((Attributes and
    faReadOnly) > 0);
end;

function StrInsert(Str1, Str2: PChar; I: Integer): PChar;
var
  LenStr2: Integer;
begin
  if I < 0 then
    I := 0;
  LenStr2 := StrLen(Str2);
  StrMove(Str1 + I + LenStr2, Str1 + I, Integer(StrLen(Str1)) - I + 1);
  StrMove(Str1 + I, Str2, LenStr2);
  StrInsert := Str1;
end;

function MakeBakFile(Dest, FileName: PChar): PChar;
var
  F: file;
  P: PChar;
begin
  if FileExists(FileName) then
  begin
    MakeBakFile := StrCopy(Dest, FileName);
    P := StrRScan(Dest, '.');
    if P = nil then
      StrCat(Dest, '.~')
    else
    begin
      (StrEnd(P) - 1)^ := #0;
      StrInsert(P + 1, '~', 0);
    end;
    DeleteFile(string(Dest));
    AssignFile(F, FileName);
    {try}
    Rename(F, Dest);
    {except
      on EInOutError do ;
    end;}
  end
  else
  begin
    Dest[0] := #0;
    MakeBakFile := Dest;
  end;
end;

function FormatFile(Param: Pointer; const FileName, UnitName,
  FormName: string): Boolean stdcall;
var
  BakFile: array[0..255] of Char;
  ExtName: string;
begin
  Result := True;
  ExtName := LowerCase(ExtractFileExt(FileName));
  if ((ExtName = '.pas') or (ExtName = '.dpr'))
    and (Trim(FileName) <> '') then
  begin
    if OtaIsFileOpen(FileName) then
      DelExpertDlg.DoFormatFile(FileName)
    else
      if (Param = nil) then
      begin
        if FileExists(FileName) and not
          IsReadonlyFile(FileName) then
        begin
        { IF PARAM<>NIL then only open files}
          if ProgressDlg.Visible then
          begin
          {if file not open then load from file}
            ProgressDlg.SetFileName(FileName);
            Application.ProcessMessages;
            Formatter.Clear;
            with Formatter do
            begin
              try
                Clear;
                try
                  MakeBakFile(BakFile, PChar(FileName));
                  LoadFromFile(BakFile);
                  if Parse then
                    WriteToFile(PChar(FileName));
                except
                  on E: EInOutError do
                    ShowMessage('I/O Error [' + E.Message + '] with "' +
                      FileName
                      +
                      '"');
                end;
              finally
                Formatter.Clear;
              end;
            end;
          end;
        end
        else
        begin
          ShowMessage('Can not find "' + FileName + '"');
        end;
      end;
  end;
end;


procedure TDelExpertDlg.CapFileNameEditChange(Sender: TObject);
begin
//  if (OptionsDlg <> nil) then
//    with OptionsDlg do
//      SaveFile(CapFileNameEdit.Text);
end;

procedure TDelExpertDlg.FormatterProgress(Sender: TObject; Progress: Integer);
begin
  ProgressDlg.ProgressBar1.Position := Progress;
end;

procedure TDelExpertDlg.CurrentBtnClick(Sender: TObject);
begin
  ProgressDlg.Show;
  DoFormatFile('');
  ProgressDlg.Hide;
end;

procedure TDelExpertDlg.AfterFormat;
  procedure AddBreakPoint;
  var DebugSvs: IOTADebuggerServices;
    tmp: TBreakPoint;
    NewBreakPoint: IOTABreakpoint;
    j: integer;
  begin
    if Assigned(BorlandIDEServices)
      and Supports(BorlandIDEServices, IOTADebuggerServices, DebugSvs) then
    begin
      for j := 0 to Length(BreakPoints) - 1 do
      begin
        tmp := BreakPoints[j];
        NewBreakPoint := DebugSvs.NewSourceBreakpoint(tmp.FileName,
          tmp.LineNumber, DebugSvs.CurrentProcess);
        NewBreakPoint.StackFramesToLog := tmp.StackFramesToLog;
        NewBreakPoint.DoHandleExceptions := tmp.DoHandleExceptions;
        NewBreakPoint.DoIgnoreExceptions := tmp.DoIgnoreExceptions;
        NewBreakPoint.GroupName := tmp.GroupName;
        NewBreakPoint.DoBreak := tmp.DoBreak;
        NewBreakPoint.LogMessage := tmp.LogMessage;
        NewBreakPoint.EvalExpression := tmp.EvalExpression;
        NewBreakPoint.LogResult := tmp.LogResult;
        NewBreakPoint.EnableGroup := tmp.EnableGroup;
        NewBreakPoint.DisableGroup := tmp.DisableGroup;
        NewBreakPoint.Enabled := tmp.Enabled;
        NewBreakPoint.Expression := tmp.Expression;
        NewBreakPoint.PassCount := tmp.PassCount;
      end;
      //DebugSvs.NewSourceBreakpoint('Unit1.pas',21,DebugSvs.CurrentProcess);
    end;
    BreakPoints := nil;
  end;
var i: Integer;
begin
  if Assigned(ISourceEditor) and (ISourceEditor.EditViewCount > 0) then
  begin
    for i := 0 to 19 do
    begin
      if Bookmarks[i].Exists then
      begin
        ISourceEditor.EditViews[0].CursorPos := Bookmarks[i].FPos;
        ISourceEditor.EditViews[0].BookmarkRecord(Bookmarks[i].BookMarkNo);
      end;
    end;
    ISourceEditor.EditViews[0].CursorPos := FCurPos;
//    ISourceEditor.EditViews[0].MoveViewToCursor;
    ISourceEditor.EditViews[0].Paint;
    ISourceEditor := nil;
  end;
  AddBreakPoint;
end;

procedure TDelExpertDlg.BeforeFormat(AFileName: string);

  function GetTheModule: IOTAModule;
  var SVC: IOTAModuleServices;
  begin