{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor SDK                                                  }
{                                                                             }
{ Copyright (c) 2004 - 2008 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}

unit ecMacroRec;

interface

uses Windows, Classes, ecSyntAnal, ecSyntMemo, ecStrUtils;

type
  TMacroEvent = class
    Command: integer;
    Data: ecString;
  end;

  TMacroRecord = class
  private
    FName: ecString;
    FEvents: TList;
    function GetCount: integer;
    function GetEvent(Index: integer): TMacroEvent;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Add(Cmd: integer; Data: ecString = '');
    procedure Delete(Index: integer);
    procedure Move(CurIndex, NewIndex: integer);

    property Name: ecString read FName write FName;
    property Count: integer read GetCount;
    property Events[Index: integer]: TMacroEvent read GetEvent; default;
  end;

  TecMacroRecorder = class(TSyntMemoPlugin, {$IFDEF EC_VCL5}IUnknown,{$ENDIF} IecCommandHook)
  private
    FMacroses: TList;
    FRecorded: TMacroRecord;
    FActive: Boolean;
    FPlaying: TMacroRecord;
    FOnChange: TNotifyEvent;
    FModified: Boolean;
    FAllowRecord: boolean;
    procedure SetActive(const Value: Boolean);
    function GetCount: integer;
    function GetMacros(Index: integer): TMacroRecord;
    function GetRecording: Boolean;
    function GetPlaying: Boolean;
    procedure SetAllowRecord(const Value: boolean);
    procedure ReadData(Stream: TStream);
    procedure WriteData(Stream: TStream);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure BeforeCommand(Command: integer; Data: ecPointer; var Handled: Boolean);
    procedure AfterCommand(Command: integer; Data: ecPointer; var Handled: Boolean);
    procedure IsCommandEnabled(Command: integer; Data: ecPointer; var Enable: Boolean);
    procedure Change; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    procedure Start;
    procedure Stop;
    procedure Cancel;
    function Play(const MacroName: ecString): Boolean; overload;
    function Play(const MacroIndex: integer): Boolean; overload;

    procedure DeleteMacro(Index: integer);
    procedure AddMacro(Macro: TMacroRecord);
    procedure MoveMacro(CurIndex, NewIndex: integer);

    procedure SaveToSream(Stream: TStream);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure LoadFromFile(const FileName: string);

    function Customize: Boolean;

    property Count: integer read GetCount;
    property Macros[Index: integer]: TMacroRecord read GetMacros; default;
    property Recording: Boolean read GetRecording;
    property Plying: Boolean read GetPlaying;
    property Modified: Boolean read FModified write FModified;
  published
    property SyntMemo;
    property Active: Boolean read FActive write SetActive default True;
    property AllowRecord: boolean read FAllowRecord write SetAllowRecord default True;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

implementation

uses SysUtils, Contnrs, ecCmdConst, {Types, }ecMacroEditDlg
    {$IFDEF EC_DOTNET},System.Text{$ENDIF};

{ TMacroRecord }

procedure TMacroRecord.Add(Cmd: integer; Data: ecString);
var e: TMacroEvent;
begin
  e := TMacroEvent.Create;
  e.Command := Cmd;
  e.Data := Data;
  FEvents.Add(e);
end;

constructor TMacroRecord.Create;
begin
  inherited;
  FEvents := TObjectList.Create;
end;

procedure TMacroRecord.Delete(Index: integer);
begin
  FEvents.Delete(Index);
end;

destructor TMacroRecord.Destroy;
begin
  FEvents.Free;
  inherited;
end;

function TMacroRecord.GetCount: integer;
begin
  Result := FEvents.Count;
end;

function TMacroRecord.GetEvent(Index: integer): TMacroEvent;
begin
  Result := TMacroEvent(FEvents[Index]);
end;

procedure TMacroRecord.Move(CurIndex, NewIndex: integer);
begin
  FEvents.Move(CurIndex, NewIndex);
end;

{ TecMacroRecorder }

constructor TecMacroRecorder.Create(AOwner: TComponent);
begin
  inherited;
  FMacroses := TObjectList.Create;
  FActive := True;
  FAllowRecord := True;
end;

destructor TecMacroRecorder.Destroy;
begin
  Cancel;
  FMacroses.Free;
  inherited;
end;

procedure TecMacroRecorder.AfterCommand(Command: integer; Data: ecPointer;
  var Handled: Boolean);
begin
end;

procedure TecMacroRecorder.BeforeCommand(Command: integer; Data: ecPointer;
  var Handled: Boolean);
  function GetRelativePos: string;
  var p: TPoint;
  begin
   p := {$IFDEF EC_DOTNET}TPoint(Data){$ELSE}PPoint(Data)^{$ENDIF};
   with SyntMemo.CaretPos do
     begin
       p.X := p.X - X;
       p.Y := p.Y - Y;
     end;
   Result := IntToStr(p.X) + ';' + IntToStr(p.Y);
  end;
begin
  if not Active or (SyntMemo = nil) then Exit;
  case Command of
    smMacroRecStart: Start;
    smMacroRecStop: Stop;
    smMacroRecCancel: Cancel;
    smMacroPlay: begin
                   Play(ecPchar(Data));
                   if FRecorded <> nil then
                     FRecorded.Add(Command, ecPChar(Data));
                 end;
    else
     begin
       if (FRecorded <> nil) and (FPlaying = nil) then
       case Command of
         smGotoXY:
           FRecorded.Add(Command, GetRelativePos);
         smChar:
           FRecorded.Add(Command, {$IFDEF EC_DOTNET}Char(Data){$ELSE}
                      {$IFDEF EC_UNICODE}PWideChar(Data)^{$ELSE}PChar(Data)^{$ENDIF}{$ENDIF});
//         smMacroPlay,
         smString:
           FRecorded.Add(Command, ecPChar(Data));
         smDropMarker:
           if Data = nil then FRecorded.Add(Command)
            else FRecorded.Add(Command, GetRelativePos);
         else FRecorded.Add(Command);
       end;
       Exit;
     end;
  end;
  Handled := True;
end;

procedure TecMacroRecorder.IsCommandEnabled(Command: integer;
  Data: ecPointer; var Enable: Boolean);
begin
  if Active and (SyntMemo <> nil) then
  case Command of
    smMacroRecStart:   Enable := (FRecorded = nil) and FAllowRecord;
    smMacroRecStop:    Enable := (FRecorded <> nil) and (FRecorded.Count > 0);
    smMacroRecCancel:  Enable := (FRecorded <> nil);
    smMacroPlay:       Enable := (Count > 0) and (FRecorded = nil);
  end;
end;

function TecMacroRecorder.Play(const MacroIndex: integer): Boolean;
var m: TMacroRecord;
    i: integer;
    p: TPoint;
  function GetAbsolutePos(Data: ecString): TPoint;
  var k: integer;
  begin
    k := Pos(';', Data);
    Result := SyntMemo.CaretPos;
    if k > 0 then
     begin
      Result.X := Result.X + StrToInt(Copy(Data, 1, k - 1));
      Result.Y := Result.Y + StrToInt(Copy(Data, k + 1,  Length(Data) - k));
     end;
  end;
begin
  m := Macros[MacroIndex];
  Result := (m <> nil) and (m.Count > 0) and  (SyntMemo <> nil) and (m <> FPlaying);
  if not Result then Exit;
  // Playing
  FPlaying := m;
  try
    for i := 0 to m.Count - 1 do
     begin
       case m[i].Command of
          smGotoLine:;  // do nothing
          smDropMarker,
          smGotoXY:
           begin
            p := GetAbsolutePos(m[i].Data);
            SyntMemo.ExecCommand(m[i].Command, {$IFNDEF EC_DOTNET}@{$ENDIF}p);
           end;
          smChar,
          smString,
          smMacroPlay:
            SyntMemo.ExecCommand(m[i].Command, {$IFDEF EC_UNICODE}PWideChar{$ELSE}ecPChar{$ENDIF}(m[i].Data));
          else SyntMemo.ExecCommand(m[i].Command);
       end;
     end;
  finally
    FPlaying := nil;
  end;
end;

function TecMacroRecorder.Play(const MacroName: ecString): Boolean;
var i, idx: integer;
begin
  idx := -1;
  if MacroName = '' then idx := Count - 1 else
   for i := 0 to Count - 1 do
     if Macros[i].Name = MacroName then
       begin
         idx := i;
         Break;
       end;
   if idx <> -1 then
     Result := Play(idx)
   else
     Result := False;
end;

procedure TecMacroRecorder.Start;
begin
  if (FRecorded = nil) and FAllowRecord then
   begin
    FRecorded := TMacroRecord.Create;
    Change;
   end;
end;

procedure TecMacroRecorder.Stop;
begin
  if (FRecorded <> nil) then
   begin
    AddMacro(FRecorded);
    FRecorded := nil;
    Change;
   end;
end;

procedure TecMacroRecorder.Cancel;
begin
  if FRecorded <> nil then
   begin
     FRecorded.Free;
     FRecorded := nil;
     Change;
   end;
end;

procedure TecMacroRecorder.SetActive(const Value: Boolean);
begin
  if FActive <> Value then
    begin
      FActive := Value;
      Cancel;
    end;
end;

function TecMacroRecorder.GetCount: integer;
begin
  Result := FMacroses.Count;
end;

function TecMacroRecorder.GetMacros(Index: integer): TMacroRecord;
begin
  Result := TMacroRecord(FMacroses[Index]);
end;

function TecMacroRecorder.GetRecording: Boolean;
begin
  Result := FRecorded <> nil;
end;

procedure TecMacroRecorder.Change;
begin
  if Assigned(FOnChange) and not (csDestroying in ComponentState) then
    FOnChange(Self);
end;

procedure TecMacroRecorder.AddMacro(Macro: TMacroRecord);
begin
  FMacroses.Add(Macro);
  FModified := True;
end;

procedure TecMacroRecorder.DeleteMacro(Index: integer);
begin
  FMacroses.Delete(Index);
end;

function ReadString(Stream: TStream): WideString;
var N: integer;
{$IFDEF EC_DOTNET}
    Buffer: array of Byte;
{$ENDIF}
begin
  if (Stream.Read(N, 4) = 4) and (N <= Stream.Size - Stream.Position) then
    begin
     if N = 0 then
       begin
         Result := '';
         Exit;
       end;
     {$IFNDEF EC_DOTNET}
     SetLength(Result, N);
     if Stream.Read(Result[1], N * 2) = N * 2 then Exit;
     {$ELSE}
     SetLength(Buffer, N * 2);
     if Stream.Read(Buffer, N * 2) = N * 2 then
       begin
         Result := System.Text.Encoding.Unicode.GetString(Buffer);
         Exit;
       end;
     {$ENDIF}
    end;
  raise Exception.Create('Invalid stream format');
end;

procedure WriteString(const S: WideString; Stream: TStream);
var N: integer;
{$IFDEF EC_DOTNET}
    Buffer: array of Byte;
{$ENDIF}
begin
  N := Length(S);
  Stream.Write(N, 4);
  if N > 0 then
    begin
     {$IFNDEF EC_DOTNET}
      Stream.Write(S[1], N * 2);
     {$ELSE}
      Buffer := System.Text.Encoding.Unicode.GetBytes(S);
      Stream.WriteBuffer(Buffer, Length(Buffer));
     {$ENDIF}
    end;
end;

procedure TecMacroRecorder.LoadFromStream(Stream: TStream);
var i,j,N,N1,cmd: integer;
    m: TMacroRecord;
begin
  FMacroses.Clear;
  Stream.Read(N, sizeof(N));
  for i := 0 to N - 1 do
    begin
      m := TMacroRecord.Create;
      try
        m.Name := ReadString(Stream);
        Stream.Read(N1, sizeof(N1));
        for j := 0 to N1 - 1 do
          begin
            Stream.Read(cmd, sizeof(cmd));
            m.Add(cmd, ReadString(Stream));
          end;
      finally
        FMacroses.Add(m)
      end;
    end;
  FModified := False;
end;

procedure TecMacroRecorder.SaveToSream(Stream: TStream);
var i,j,N,N1: integer;
begin
  N := FMacroses.Count;
  Stream.Write(N, sizeof(N));
  for i := 0 to N - 1 do
    begin
      WriteString(Macros[i].Name, Stream);
      N1 := Macros[i].Count;
      Stream.Write(N1, sizeof(N1));
      for j := 0 to N1 - 1 do
        with Macros[i][j] do
        begin
          Stream.Write(Command, sizeof(Command));
          WriteString(Data, Stream);
        end;
    end;
end;

procedure TecMacroRecorder.LoadFromFile(const FileName: string);
var Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TecMacroRecorder.SaveToFile(const FileName: string);
var Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToSream(Stream);
  finally
    Stream.Free;
  end;
end;

function TecMacroRecorder.GetPlaying: Boolean;
begin
  Result := FPlaying <> nil;
end;

procedure TecMacroRecorder.Assign(Source: TPersistent);
var Mem: TMemoryStream;
begin
  if Source is TecMacroRecorder then
    begin
      Cancel;
      Mem := TMemoryStream.Create;
      try
        TecMacroRecorder(Source).SaveToSream(Mem);
        Mem.Position := 0;
        LoadFromStream(Mem);
      finally
        Mem.Free;
      end;
      FActive := TecMacroRecorder(Source).FActive;
    end else inherited;
end;

function TecMacroRecorder.Customize: Boolean;
begin
  Result := EditMacro(Self);
end;

procedure TecMacroRecorder.MoveMacro(CurIndex, NewIndex: integer);
begin
  FMacroses.Move(CurIndex, NewIndex);
end;

procedure TecMacroRecorder.SetAllowRecord(const Value: boolean);
begin
  FAllowRecord := Value;
  Cancel;
end;

procedure TecMacroRecorder.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineBinaryProperty('MarcosData', ReadData, WriteData, Count > 0);
end;

procedure TecMacroRecorder.ReadData(Stream: TStream);
begin
  LoadFromStream(Stream);
end;

procedure TecMacroRecorder.WriteData(Stream: TStream);
begin
  SaveToSream(Stream);
end;

end.
