unit undos;

// TODO also log caret position changes? in that case, the undo log is per view, not globally on the buffer (the buffer has no notion of "Caret").
// TODO also mark where there were user commands and auto-undo until we have reached them.
// TODO in your undo menu, add a separator (and the timestamp?) between entries that have timestamps more than FoldTimeDuration apart.

{$M+}

interface
uses marks, classes, sysutils;

type
  ENoUndoEntriesLeft = class(Exception)
  end;
  
  TUndoableAction = (uaGroupBoundary, uaInsertion, uaDeletion{, uaCaretMoved});

  TUndoLogEntry = class
  protected
    Previous, Next : TUndoLogEntry; { linked list. } // private.
  private
    fTimestamp : Cardinal; // fptime() units.
    fPosition : Cardinal; // absolute; FIXME use relative position?
    fAction : TUndoableAction;
    fValue : UTF8String; // so sue me. // or buffers.TInternalBuffer - but then, how to print it?
  published
    property Position : Cardinal read fPosition write fPosition;
    property Action : TUndoableAction read fAction write fAction;
    property Value : UTF8String read fValue write fValue;
    property Timestamp : Cardinal read fTimestamp write fTimestamp;
    
    constructor Create; overload;
    function Clone : TUndoLogEntry;
  public
    destructor Destroy; override;
  end;
  
  TUndoLogEntryArray = array of TUndoLogEntry;
 
  IUndoLogger = interface
    ['{cc5cc75a-b33b-11dd-8d45-f9477ea1d23a}']
    procedure Push(const aEntry : TUndoLogEntry);
    function Pop() : TUndoLogEntry;
    function IsEmpty : Boolean;
    function GetItems(aLimit : Cardinal) : TUndoLogEntryArray;
    procedure LogInsertion(aPosition : Cardinal; aValue : UTF8String);
    procedure LogDeletion(aPosition : Cardinal; aValue : UTF8String);
    function GetPrimaryCapacity : Cardinal;
    property PrimaryCapacity : Cardinal read GetPrimaryCapacity;
    function GetFoldTimeDuration : Cardinal;
    property FoldTimeDuration : Cardinal read GetFoldTimeDuration;
  end;
  
  TUndoLogger = class(TInterfacedObject, IUndoLogger, IInterface)
  private
    fHead : TUndoLogEntry;
    fTail : TUndoLogEntry;
    fCount : Cardinal;
    fPrimaryCapacity : Cardinal;
    fFoldTimeDuration : Cardinal; // TODO configurable.
  protected
    function GetPrimaryCapacity : Cardinal;
    function GetFoldTimeDuration : Cardinal;
  published
    constructor Create();
    procedure Push(const aEntry : TUndoLogEntry);
    function Pop() : TUndoLogEntry;
    function IsEmpty : Boolean;
    function GetItems(aLimit : Cardinal) : TUndoLogEntryArray;
    procedure LogInsertion(aPosition : Cardinal; aValue : UTF8String);
    procedure LogDeletion(aPosition : Cardinal; aValue : UTF8String);
    property PrimaryCapacity : Cardinal read GetPrimaryCapacity;
    property FoldTimeDuration : Cardinal read GetFoldTimeDuration;
  public
    destructor Destroy; override;
  end;

implementation
{$IFNDEF WIN32}
uses baseunix;
{$ENDIF}

{$IFDEF WIN32}
function fptime() : Cardinal;
begin
  Result := Trunc(Now * 86400);
end;
{$ENDIF}

{ TUndoLogEntry }

constructor TUndoLogEntry.Create;
begin
  inherited;
end;

function TUndoLogEntry.Clone() : TUndoLogEntry;
begin
  Result := TUndoLogEntry.Create;
  Result.fAction := fAction;
  Result.fPosition := fPosition;
  Result.fValue := fValue;
end;

destructor TUndoLogEntry.Destroy;
begin
  inherited;
end;

{ IUndoLogger }


constructor TUndoLogger.Create();
begin
  inherited;
  fHead := nil;
  fTail := nil;
  fCount := 0;
  fPrimaryCapacity := $800; // TODO configurable.
  fFoldTimeDuration := 30; // seconds.
end;

destructor TUndoLogger.Destroy();
var
  VItem : TUndoLogEntry;
  VPreviousItem : TUndoLogEntry;
begin
  VItem := fTail;
  
  while Assigned(VItem) do begin
    VPreviousItem := VItem.Previous;
    FreeAndNil(VItem);
    VItem := VPreviousItem;
  end;

  fHead := nil;
  fTail := nil;
  fCount := 0;  
  inherited;
end;

{ takes ownership of #aEntry and pushes it onto the undo stack. }
procedure TUndoLogger.Push(const aEntry : TUndoLogEntry);
var
  VEntry : TUndoLogEntry;
begin
  assert(aEntry.Next = nil);
  assert(aEntry.Previous = nil);
  
  VEntry := aEntry;
  
  VEntry.Previous := fTail;
  VEntry.Next := nil;

  if Assigned(fTail) then
    fTail.Next := VEntry
  else
    fHead := VEntry;
    
  fTail := VEntry;
  Inc(fCount);
end;

{ returns the undoable entry. Please free it. }
function TUndoLogger.Pop() : TUndoLogEntry;
var
  VEntry : TUndoLogEntry;
begin
  VEntry := fTail;
  if Assigned(VEntry) then begin
    Dec(fCount);
    fTail := fTail.Previous;
    if not Assigned(fTail) then
      fHead := nil
    else
      fTail.Next := nil;
    
    Result.Next := nil;
    Result.Previous := nil;
  end else
    raise ENoUndoEntriesLeft.Create('no more items to undo.');
end;

function TUndoLogger.IsEmpty : Boolean;
begin
  Result := fTail = nil;
end;

function TUndoLogger.GetItems(aLimit : Cardinal) : TUndoLogEntryArray;
var
  VI : Cardinal;
  VItem : TUndoLogEntry;
begin
  if aLimit > fCount then
    aLimit := fCount;

  VItem := fTail;
  
  SetLength(Result, aLimit);
  if aLimit = 0 then
    Exit;
    
  for VI := 0 to aLimit - 1 do begin
    Result[VI] := VItem;
    
    VItem := VItem.Previous;
  end;
end;

procedure TUndoLogger.LogInsertion(aPosition : Cardinal; aValue : UTF8String);
var
  VItem : TUndoLogEntry;
  VTimestamp : Cardinal;
begin
  VTimestamp := fptime();
  
  VItem := fTail;
  // TODO undo log on a line-by-line basis?

  // check for similar stuff in fTail and just append there.
  if Assigned(VItem) and (VItem.Action = uaInsertion) and (VItem.Position + Length(VItem.Value) = aPosition) and (Length(VItem.Value) + Length(aValue) < 255) and ((VTimestamp >= VItem.Timestamp) and (VTimestamp <= VItem.Timestamp + fFoldTimeDuration)) then begin
    VItem.Value := VItem.Value + aValue;
    Exit;
  end;
  
  VItem := TUndoLogEntry.Create;
  VItem.Timestamp := VTimestamp;
  VItem.Action := uaInsertion;
  VItem.Position := aPosition;
  VItem.Value := aValue;
  
  Self.Push(VItem);
end;
  
procedure TUndoLogger.LogDeletion(aPosition : Cardinal; aValue : UTF8String);
var
  VItem : TUndoLogEntry;
  VTimestamp : Cardinal;
begin
  VTimestamp := fptime();
  // TODO undo log on a line-by-line basis?
  VItem := fTail;

  // check for similar stuff in fTail and just append there.
  if Assigned(VItem) and (VItem.Action = uaDeletion) and ((VTimestamp >= VItem.Timestamp) and (VTimestamp <= VItem.Timestamp + fFoldTimeDuration)) then begin
    if (VItem.Position = aPosition) then begin
      if (Length(VItem.Value) + Length(aValue) < 255) then begin
        VItem.Value := VItem.Value + aValue;
        Exit;
      end;
    end else if (aPosition + Length(aValue) = VItem.Position) then begin
      if (Length(VItem.Value) + Length(aValue) < 255) then begin
        Dec(VItem.Position, Length(aValue));
        VItem.Value := aValue + VItem.Value;
        Exit;
      end;
    end;
  end;
  
  VItem := TUndoLogEntry.Create;
  VItem.Timestamp := VTimestamp;
  VItem.Action := uaDeletion;
  VItem.Position := aPosition;
  VItem.Value := aValue;
  
  Self.Push(VItem);
end;

function TUndoLogger.GetPrimaryCapacity : Cardinal;
begin
  Result := fPrimaryCapacity;
end;

function TUndoLogger.GetFoldTimeDuration : Cardinal;
begin
  Result := fFoldTimeDuration;
end;

// FIXME if too much memory is used by the undo log, use backing store to store the undo log.

end.