unit uhistory;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Variants, Controls, StdCtrls, Dialogs, Forms;
type
// One Undo/Redo record
PHistoryRecord = ^THistroyRecord;
THistroyRecord = record
PrevSelStart: integer;
PrevSelLength: integer;
PrevSelText: string;
SelStart: integer;
SelLength: integer;
SelText: string;
end;
{ THistory }
generic THistory <T> = class
private
FEnabled: boolean;
FEdit: T;
FList: TList; // List of Undo/Redo records
FIndex: integer; // Index of current record
FSize: integer; // Current history size
FMaxSize: integer; // Maximum size limit for history
FMinCount: integer; // Minimum count limit of records
FEditing: boolean; // Is it not in the undo/redo state
FPrevText: string; // The content of the FEdit before OnChange Event
FPrevSelStart: integer; // The SelStart of the FEdit before OnChange Event
FPrevSelLength: integer; // The SelLength of the FEdit before OnChange Event
FOldKeyDown: TKeyEvent;
FOldMouseDown: TMouseEvent;
FOldChange: TNotifyEvent;
// Get the SelStart and SelLength of FEdit before the OnChange event is executed
procedure KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Change(Sender: TObject);
function GetRecordSize(PHR: PHistoryRecord): integer;
// Check if the undo operation can be executed correctly
function InvaildRecord(PHR: PHistoryRecord): boolean;
// Just use the Text, SelStart and PrevText to calculate the Record Information
procedure CalcRecord(out PHR: PHistoryRecord);
// Drag text will get wrong SelStart, use this most stupid method to calculate record information
procedure HardCalcRecord(out PHR: PHistoryRecord);
function GetIndex: integer;
function GetCount: integer;
procedure SetEnabled(AValue: boolean);
procedure ShowPrevText; // debug
procedure ShowCurText; // debug
procedure ShowHistory; // Debug
procedure ShowRecord; // Debug
public
constructor Create(AEdit: TCustomEdit; AMaxSize: integer = 32 * 1024; AMinCount: integer = 10);
destructor Destroy; override;
function CanUndo: boolean;
function CanRedo: boolean;
procedure Undo;
procedure Redo;
property Index: integer read GetIndex;
property Size: integer read FSize;
property MaxSize: integer read FMaxSize;
property Count: integer read GetCount;
property MinCount: integer read FMinCount;
property Enabled: boolean read FEnabled write SetEnabled;
property PrevText: string read FPrevText;
end;
TEditHistory = specialize THistory<TEdit>;
TMemoHistory = specialize THistory<TMemo>;
implementation
uses
lazUTF8;
constructor THistory.Create(AEdit: TCustomEdit; AMaxSize: integer = 32 * 1024; AMinCount: integer = 10);
begin
inherited Create;
FEdit := T(AEdit);
FPrevText := FEdit.Text;
FPrevSelStart := 0;
FPrevSelLength := 0;
FList := TList.Create;
FIndex := -1;
FSize := 0;
FMaxSize := AMaxSize;
FMinCount := AMinCount;
FEditing := True;
FOldChange := FEdit.OnChange;
FOldKeyDown := FEdit.OnKeyDown;
FOldMouseDown := FEdit.OnMouseDown;
FEdit.OnChange := @Change;
FEdit.OnKeyDown := @KeyDown;
FEdit.OnMouseDown := @MouseDown;
FEnabled := True;
end;
destructor THistory.Destroy;
var
i: integer;
begin
for i := 0 to FList.Count - 1 do
dispose(PHistoryRecord(FList[i]));
FList.Free;
Enabled := False;
inherited Destroy;
end;
procedure THistory.KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
FPrevSelStart := FEdit.SelStart;
FPrevSelLength := FEdit.SelLength;
if Assigned(FOldKeyDown) then
FOldKeyDown(Sender, Key, Shift);
end;
procedure THistory.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FPrevSelStart := FEdit.SelStart;
FPrevSelLength := FEdit.SelLength;
if Assigned(FOldMouseDown) then
FOldMouseDown(Sender, Button, Shift, X, Y);
end;
procedure THistory.Change(Sender: TObject);
var
i: integer;
PHR: PHistoryRecord;
SelStart: integer;
begin
// ShowPrevText; // debug
// ShowCurText; // debug
SelStart := FEdit.SelStart;
if FEditing then
begin
// Destroy the records after current record
for i := FList.Count - 1 downto FIndex + 1 do
begin
Dec(FSize, GetRecordSize(PHistoryRecord(FList[i])));
dispose(PHistoryRecord(FList[i]));
FList.Delete(i);
end;
// Add a record
PHR := new(PHistoryRecord);
FList.Add(PHR);
Inc(FIndex);
// Fill in the record
if SelStart < FPrevSelStart then
begin
// Backspace character
PHR^.PrevSelStart := SelStart;
PHR^.PrevSelLength := FPrevSelStart - SelStart;
PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength);
PHR^.SelStart := SelStart;
PHR^.SelLength := 0;
PHR^.SelText := '';
end
else if SelStart > FPrevSelStart then
begin
if FEdit.SelLength > 0 then // This case only happens in GTK2
begin
{
// Add text (Paste after selecting some text)
PHR^.PrevSelStart := FPrevSelStart;
PHR^.PrevSelLength := 0;
PHR^.PrevSelText := '';
PHR^.SelStart := FPrevSelStart;
PHR^.SelLength := SelStart - FPrevSelStart;
PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
}
// Drag text also makes the code run here (GTK2)
HardCalcRecord(PHR);
end
else
begin
// Add text (Input or Paste)
PHR^.PrevSelStart := FPrevSelStart;
PHR^.PrevSelLength := 0;
PHR^.PrevSelText := '';
PHR^.SelStart := FPrevSelStart;
PHR^.SelLength := SelStart - FPrevSelStart;
PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
end;
end
else
begin
// Delete a character without text selection (Just select it)
if FPrevSelLength = 0 then
FPrevSelLength := 1;
// Delete selected text
PHR^.PrevSelStart := FPrevSelStart;
PHR^.PrevSelLength := FPrevSelLength;
PHR^.PrevSelText := UTF8Copy(FPrevText, FPrevSelStart + 1, FPrevSelLength);
PHR^.SelStart := SelStart;
PHR^.SelLength := 0;
PHR^.SelText := '';
end;
// Safeguard: If the Record is invaild
if InvaildRecord(PHR) then
begin
// The code will run into here if FPrevSelStart and FPrevSelLength
// are not correctly obtained.
// In this case, I need to calculate the Record information here.
// Drag text will get wrong SelStart (GTK2)
if PHR^.PrevSelStart = PHR^.SelStart then
HardCalcRecord(PHR)
else
CalcRecord(PHR);
// writeln('***** Invaild Undo Record *****'); // debug
// ShowMessage('Invaild Undo Record'); // debug
end;
// Update history size
Inc(FSize, GetRecordSize(PHR));
// Limit history size
while (FMaxSize > 0) and (FSize > FMaxSize) and (FList.Count > FMinCount) do
begin
Dec(FSize, GetRecordSize(PHistoryRecord(FList[0])));
dispose(PHistoryRecord(FList[0]));
FList.Delete(0);
Dec(FIndex);
end;
end;
// Save the text information for the next OnChange event
FPrevSelStart := SelStart;
FPrevSelLength := FEdit.SelLength;
FPrevText := FEdit.Text;
// ShowRecord; // debug
// writeln('=============================='); // debug
if Assigned(FOldChange) then
FOldChange(Sender);
end;
function THistory.CanUndo: boolean;
begin
Result := FIndex >= 0;
end;
function THistory.CanRedo: boolean;
begin
Result := FIndex < FList.Count - 1;
end;
procedure THistory.Undo;
var
PHR: PHistoryRecord;
begin
if FIndex < 0 then Exit;
PHR := PHistoryRecord(FList[FIndex]);
FEditing := False;
FEdit.SelStart := PHR^.SelStart;
FEdit.SelLength := PHR^.SelLength;
FEdit.SelText := PHR^.PrevSelText;
FEditing := True;
FPrevText := FEdit.Text; // For the next write operation of FEdit
Dec(FIndex);
end;
procedure THistory.Redo;
var
PHR: PHistoryRecord;
begin
if FIndex >= FList.Count - 1 then Exit;
Inc(FIndex);
PHR := PHistoryRecord(FList[FIndex]);
FEditing := False;
FEdit.SelStart := PHR^.PrevSelStart;
FEdit.SelLength := PHR^.PrevSelLength;
FEdit.SelText := PHR^.SelText;
FEditing := True;
end;
function THistory.InvaildRecord(PHR: PHistoryRecord): boolean;
begin
Result := (Length(FEdit.Text) - PHR^.SelText.Length + PHR^.PrevSelText.Length) <> FPrevText.Length;
end;
procedure THistory.CalcRecord(out PHR: PHistoryRecord);
var
PrevLen, Len: integer;
Head, Tail: string;
begin
Len := UTF8Length(FEdit.Text);
PrevLen := UTF8Length(FPrevText);
if Len > PrevLen then
begin
// Add content to FEdit
Tail := UTF8Copy(FEdit.Text, FEdit.SelStart + 1, MaxInt);
PHR^.PrevSelStart := PrevLen - UTF8Length(Tail);
PHR^.PrevSelLength := 0;
PHR^.PrevSelText := '';
PHR^.SelStart := PHR^.PrevSelStart;
PHR^.SelLength := Len - PrevLen;
PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
end
else
begin
// Delet content from FEdit
Head := UTF8Copy(FEdit.Text, 1, FEdit.SelStart);
PHR^.PrevSelStart := UTF8Length(Head);
PHR^.PrevSelLength := PrevLen - Len;
PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength);
PHR^.SelStart := PHR^.PrevSelStart;
PHR^.SelLength := 0;
PHR^.SelText := '';
end;
end;
procedure THistory.HardCalcRecord(out PHR: PHistoryRecord);
var
PrevLen, Len: integer;
Head: string;
i: integer;
begin
Len := UTF8Length(FEdit.Text);
PrevLen := UTF8Length(FPrevText);
if Len > PrevLen then
begin
for i := 1 to FPrevText.Length do
if FEdit.Text[i] <> FPrevText[i] then break;
if (i = Length(FPrevText)) and (FEdit.Text[i] = FPrevText[i]) then
Inc(i);
Head := Copy(FEdit.Text, 1, i - 1);
PHR^.PrevSelStart := UTF8Length(Head);
PHR^.PrevSelLength := 0;
PHR^.PrevSelText := '';
PHR^.SelStart := PHR^.PrevSelStart;
PHR^.SelLength := Len - PrevLen;
PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
end
else
begin
for i := 1 to Length(FEdit.Text) do
if FEdit.Text[i] <> FPrevText[i] then break;
if (i = Length(FEdit.Text)) and (FEdit.Text[i] = FPrevText[i]) then
Inc(i);
Head := Copy(FEdit.Text, 1, i - 1);
PHR^.PrevSelStart := UTF8Length(Head);
PHR^.PrevSelLength := PrevLen - Len;
PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength);
PHR^.SelStart := PHR^.PrevSelStart;
PHR^.SelLength := 0;
PHR^.SelText := '';
end;
end;
function THistory.GetIndex: integer;
begin
Result := FIndex + 1;
end;
function THistory.GetCount: integer;
begin
Result := FList.Count;
end;
procedure THistory.SetEnabled(AValue: boolean);
begin
if FEnabled = AValue then Exit;
FEnabled := AValue;
if FEnabled then
begin
FEdit.OnChange := @Change;
FEdit.OnKeyDown := @KeyDown;
FEdit.OnMouseDown := @MouseDown;
end
else
begin
FEdit.OnChange := FOldChange;
FEdit.OnKeyDown := FOldKeyDown;
FEdit.OnMouseDown := FOldMouseDown;
end;
end;
function THistory.GetRecordSize(PHR: PHistoryRecord): integer;
begin
Result := PHR^.PrevSelText.Length + PHR^.SelText.Length + 4 * Sizeof(integer);
end;
// for Debug
procedure THistory.ShowPrevText;
begin
Writeln(Format('Prev: %d, %d "%s"', [FPrevSelStart, FPrevSelLength, FPrevText]));
end;
// for Debug
procedure THistory.ShowCurText;
begin
Writeln(Format('Curr: %d, %d "%s"', [FEdit.SelStart, FEdit.SelLength, FEdit.Text]));
end;
// for Debug
procedure THistory.ShowHistory;
var
I: integer;
begin
for i := 0 to FList.Count - 1 do
begin
with PHistoryRecord(FList[i])^ do
writeln(Format('History: %d,%d "%s" / %d,%d "%s"', [PrevSelStart, PrevSelLength,
PrevSelText, SelStart, SelLength, SelText]));
end;
end;
// for Debug
procedure THistory.ShowRecord;
begin
with PHistoryRecord(FList[FIndex])^ do
writeln(Format('History: %d,%d "%s" / %d,%d "%s"', [PrevSelStart, PrevSelLength,
PrevSelText, SelStart, SelLength, SelText]));
end;
end.