* * *

Author Topic: TMemo Undo Redo analysis  (Read 706 times)

tomitomy

  • Full Member
  • ***
  • Posts: 223
TMemo Undo Redo analysis
« on: May 01, 2018, 04:05:12 am »
The history is used to record the change of TMemo. The change of TMemo has 2 case: "Add Text" and "Delete Text". Other cases can be regarded as a combination of these two cases(such as select some text then paste to overwrte them, this will delete the selected text first, then paste from clipboard, it will trigger OnChange event twice. another such as drag and drop operation, it will delete the selected text first, then add the previous selected text to new place, it will also trigger OnChange event twice).

There is only OnChange event can be used to capture the changes in TMemo, so we focus on the fixed features after text changes:

In usually, the "Add Text" and "Delete Text" should follow these two rules:
1、After add text, the SelStart must at the behind of the Inserted Text, and the SelLength must be 0
2、After delete text, the SelStart must at the front of the Deleted Text, and the SelLength must be 0.

If TMemo have these two features, the undo/redo can be easily implemented:

Code: Pascal  [Select]
  1.  
  2. { ========== One history step ========== }
  3. type
  4.  
  5.   THistoryStep = record
  6.     SelStart : SizeInt;
  7.     SelText  : string;
  8.     AddNotDel: Boolean;
  9.   end;
  10.  
  11. var
  12.   Step: THistoryStep;
  13.  
  14.  
  15. { ========== Record one hisory step ========== }
  16.  
  17. var PrevContent := Memo.Text;
  18.  
  19. procedure MemoOnChange(...);
  20. var
  21.   SelStart, SelLength: SizeInt;
  22.   CurContent, SelText: string;
  23. begin
  24.   CurContent := Memo.Text;
  25.  
  26.   SelLength = UTF8Length(CurContent) - UTF8Length(PrevContent);
  27.   if SelLength > 0 then begin // Record "Add Text"
  28.     Step.SelText   := UTF8Copy(CurContent, SelStart - SelLength, SelLength);
  29.     Step.SelStart  := SelStart - SelLength;
  30.     Step.AddNotDel := True;
  31.   end else begin             // Record "Delete Text"
  32.     Step.SelText   := UTF8Copy(PrevContent, SelStart, -SelLength);
  33.     Step.SelStart  := SelStart;
  34.     Step.AddNotDel := False;
  35.   end;
  36.  
  37.   PrevContent := CurContent;
  38. end;
  39.  
  40. { ========== Undo one hisory step ========== }
  41. procedure Undo;
  42. begin
  43.   if Step.AddNotDel then begin   // Undo "Add Text" (delete it)
  44.     Memo.SelStart  := Step.SelStart
  45.     Memo.SelLength := UTF8Length(Step.SelText);
  46.     Memo.SelText   := '';
  47.   end else begin               // Undo "Delete Text" (add it)
  48.     Memo.SelStart  := Step.SelStart
  49.     Memo.SelLength := 0;
  50.     Memo.SelText   := Step.SelText;
  51.   end;
  52.   PrevContent := Memo.Text;
  53. end;
  54.  
  55. { ========== Redo one hisory step ========== }
  56. procedure Redo;
  57. begin
  58.   if Step.AddNotDel then begin   // Redo "Add Text" (add it)
  59.     Memo.SelStart := Step.SelStart
  60.     Memo.SelLength := 0;
  61.     Memo.SelText := Step.SelText;
  62.   end else begin               // Redo "Delete Text" (delete it)
  63.     Memo.SelStart := Step.SelStart
  64.     Memo.SelLength := UTF8Length(Step.SelText);
  65.     Memo.SelText := '';
  66.   end;
  67.   PrevContent := Memo.Text;
  68. end;
  69.  
  70.  

But in GTK2 version, the TMemo does not follow those two rules listed above, in the "Paste Overwrite Selection" operation, it add text form the clipboard first, then delete the selected text, in this case, we can't get the correct SelStart when it add text, so we can't get the correct Step by the code above, we need another function to get the correct Step (make comparison byte by byte). The "Paste Overwrite Selection" operation has a feture that is "SelLenght <> 0" after add text (because the SelLength need to used to keep the Selected Text which will be delete later), so we can judge whether special treatment is needed through this featrue. (The "Drag And Drop" operation is also have this "SelLenght <> 0" feature)

Code: Pascal  [Select]
  1.  
  2. procedure MemoOnChangeSpecial(...);
  3. var
  4.   SelStart, SelLength: SizeInt;
  5.   CurContent, SelText: string;
  6.   Index, EndIndex: SizeInt;
  7. begin
  8.  
  9.   // if Memo.SelLength = 0 then use those code above;
  10.   // if Memo.SelLength > 0 then use these code below;
  11.  
  12.   CurContent := Memo.Text;
  13.  
  14.   SelLength = Length(CurContent) - Length(PrevContent);
  15.  
  16.   { start comparison byte by byte }
  17.  
  18.   if SelLength > 0 then
  19.     EndIndex := Length(PrevContent)
  20.   else
  21.     EndIndex := Length(CurContent);
  22.  
  23.   Index := 1;
  24.   while (Index <= EndIndex) and (CurContent[Index] = PrevContent[Index]) do
  25.     Inc(Index);
  26.  
  27.   Utf8TryFindCodepointStart(CurContent, Index, CharLen);
  28.  
  29.   { end comparison byte by byte }
  30.  
  31.   if SelLength > 0 then begin // Record "Add Text"
  32.     Step.SelText   := Copy(CurContent, Index, SelLength);
  33.     Step.SelStart  := UTF8Length(CurContent, Index);
  34.     Step.AddNotDel := True;
  35.   end else begin             // Record "Delete Text"
  36.     Step.SelText   := Copy(PrevContent, Index, -SelLength);
  37.     Step.SelStart  := UTF8Length(PrevContent, Index);
  38.     Step.AddNotDel := False;
  39.   end;
  40.  
  41.   PrevContent := CurContent;
  42. end;
  43.  
  44.  

At this point, all history step can be record correctly. but there is another problem, after your "Paste Overwrite Selection" operation, you need to Undo twice to back to the state before Paste. the "Paste Overwrite Selection" is one operation, but Undo need two operations, which is very weird. How to only undo once to back to the state before Paste? I found that we can use ApplicationIdle event to capture the Half Operation.

Code: Pascal  [Select]
  1.  
  2. var
  3.   HalfEvent := False;
  4.  
  5. procedure ApplicationIdle(...);
  6. begin
  7.   HalfEvent := False;
  8. end;
  9.  
  10. procedure MemoOnChange(...);
  11. begin
  12.   if HalfEvent then
  13.     ShowMessage('this OnChange and previous OnChange are two Half Event of one user operation.');
  14.  
  15.   HalfEvent := True;
  16. end;
  17.  
  18.  

We can record the HalfEvent flag into Step, and check it in Undo/Redo function.

That's all, I think Undo/Redo can be achieve correctly. I will give a demo later.
« Last Edit: May 01, 2018, 11:53:15 am by tomitomy »

tomitomy

  • Full Member
  • ***
  • Posts: 223
Re: TMemo Undo Redo analysis
« Reply #1 on: May 01, 2018, 09:24:19 am »
Hi, everybody, I have already written the demo. It's in the attachment. The following is the core code:
Code: Pascal  [Select]
  1. unit uhistory;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, StdCtrls, Forms, Clipbrd;
  9.  
  10. type
  11.  
  12.   PStep = ^TStep;
  13.  
  14.   // one step of history data
  15.   TStep = record
  16.     SelStart              : SizeInt; // < 0 means Delete text, > 0 means Insert text
  17.     SelText               : string;  // Insert or Delete text
  18.     HalfStep              : Integer; // 0 means full step, 1 means first half step, 2 means second half step.
  19.   end;
  20.  
  21.   { THistory }
  22.  
  23.   THistory = class
  24.   private
  25.     FMemo          : TMemo;
  26.     FOldOnChange   : TNotifyEvent;
  27.     FPrevContent   : string;
  28.  
  29.     FSteps         : TList;         // history records
  30.     FIndex         : Integer;       // index of history record, based 0
  31.     FSize          : SizeInt;
  32.  
  33.     FInEdit        : Boolean;
  34.     FixOnChangeBug : Boolean;
  35.  
  36.     FHalfEvent          : Boolean;
  37.     FOldApplicationIdle : TIdleEvent;
  38.     FPrevSelStart       : SizeInt;
  39.  
  40.     function  GetStep(AIndex: Integer): PStep; inline;
  41.     function  CurStep: PStep; inline;
  42.  
  43.     procedure AddStep(ASelStart: SizeInt; ASelText: string; AHalfEvent: Boolean);
  44.     procedure DelStep(AIndex: Integer);
  45.  
  46.     procedure MemoOnChange(Sender: TObject);
  47.     procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
  48.  
  49.     function  StrDiff(const ACurContent: string; out ASelStart: SizeInt;
  50.       out ASelText: string; out AHalfEvent: Boolean): Boolean;
  51.  
  52.     function  StrDiff1(const ACurContent: string; out ASelStart: SizeInt;
  53.       out ASelText: string; out AHalfEvent: Boolean): Boolean;
  54.  
  55.     function  StrDiff2(const ACurContent: string; out ASelStart: SizeInt;
  56.       out ASelText: string; out AHalfEvent: Boolean): Boolean;
  57.   public
  58.     constructor Create(AMemo: TMemo);
  59.     destructor  Destroy; override;
  60.  
  61.     function  CanUndo: Boolean; inline;
  62.     function  CanRedo: Boolean; inline;
  63.     procedure Undo;
  64.     procedure Redo;
  65.  
  66.     // you should use Paste function to paste text instead of FMemo.PasteFromClipboard function,
  67.     // this function can reduce the calculation.
  68.     procedure PasteText;
  69.  
  70.     // you should use the DeleteText function to delete text instead of the FMemo.Text := '' method,
  71.     // otherwise your delete operation may not trigger the OnChange event.
  72.     procedure DeleteText;
  73.  
  74.     procedure Reset; inline;
  75.  
  76.     property  Size: SizeInt read FSize;
  77.   end;
  78.  
  79.   { Custom Functions }
  80.   function UTF8PosToBytePos(const Text: PChar; const Size: SizeInt; UPos: SizeInt): SizeInt;
  81.   function UTF8PosToBytePos(const Text: String; const UPos: SizeInt): SizeInt; inline;
  82.   function UTF8LengthFast(const Text: PChar; const Size: SizeInt): SizeInt;
  83.   function UTF8LengthFast(const AStr: String): SizeInt; inline;
  84.  
  85. implementation
  86.  
  87. // uses lazUTF8;
  88.  
  89. { THistory }
  90.  
  91. function THistory.GetStep(AIndex: Integer): PStep; inline;
  92. begin
  93.   Result := PStep(FSteps[AIndex]);
  94. end;
  95.  
  96. function THistory.CurStep: PStep; inline;
  97. begin
  98.   Result := GetStep(FIndex);
  99. end;
  100.  
  101. procedure THistory.AddStep(ASelStart: SizeInt; ASelText: string; AHalfEvent: Boolean);
  102. begin
  103.   // remove tailing steps
  104.   DelStep(FIndex + 1);
  105.  
  106.   // correct the previous step
  107.   if AHalfEvent and (FIndex >= 0) then
  108.     GetStep(FIndex)^.HalfStep := 1;  // first half step
  109.  
  110.   // add current step
  111.   FSteps.Add(new(PStep));
  112.   Inc(FIndex);
  113.   Inc(FSize, Sizeof(TStep) + Length(ASelText));
  114.  
  115.   with CurStep^ do begin
  116.     SelStart := ASelStart;
  117.     SelText  := ASelText;
  118.     if AHalfEvent then
  119.       HalfStep := 2   // second half step
  120.     else
  121.       HalfStep := 0;  // full step
  122.   end;
  123. end;
  124.  
  125. procedure THistory.DelStep(AIndex: Integer);
  126. var
  127.   i: Integer;
  128.   Step: PStep;
  129. begin
  130.   for i := FSteps.Count - 1 downto AIndex do begin
  131.     Step := GetStep(i);
  132.     // Size
  133.     Dec(FSize, Sizeof(TStep) + Length(Step^.SelText));
  134.     // Memory
  135.     Step^.SelText := '';
  136.     dispose(Step);
  137.     // List
  138.     FSteps.Delete(i);
  139.   end;
  140.   // Index
  141.   FIndex := AIndex - 1;
  142. end;
  143.  
  144. constructor THistory.Create(AMemo: TMemo);
  145. begin
  146.   inherited Create;
  147.  
  148.   FSteps := TList.Create;
  149.   FIndex := -1;
  150.  
  151.   FMemo          := AMemo;
  152.   FOldOnChange   := FMemo.OnChange;
  153.   FMemo.OnChange := @MemoOnChange;
  154.   FPrevContent   := FMemo.Text;
  155.  
  156.   FOldApplicationIdle := Application.OnIdle;
  157.   Application.OnIdle  := @ApplicationIdle;
  158.  
  159.   FHalfEvent := False;
  160.   FInEdit    := True;
  161. end;
  162.  
  163. destructor THistory.Destroy;
  164. begin
  165.   Application.OnIdle := FOldApplicationIdle;
  166.   FMemo.OnChange     := FOldOnChange;
  167.   FMemo              := nil;
  168.  
  169.   DelStep(0);
  170.   FSteps.Free;
  171.  
  172.   inherited Destroy;
  173. end;
  174.  
  175. procedure THistory.MemoOnChange(Sender: TObject);
  176. var
  177.   CurContent, ASelText : string;
  178.   ASelStart            : SizeInt;
  179.   AHalfEvent           : Boolean;
  180. begin
  181.   if FInEdit then begin
  182.     CurContent := FMemo.Text;
  183.     if StrDiff(CurContent, ASelStart, ASelText, AHalfEvent) then
  184.       AddStep(ASelStart, ASelText, AHalfEvent);
  185.     FPrevContent := CurContent;
  186.   end;
  187.  
  188.   FixOnChangeBug := False;
  189.  
  190.   if Assigned(FOldOnChange) then
  191.     FOldOnChange(Sender);
  192. end;
  193.  
  194. procedure THistory.ApplicationIdle(Sender: TObject; var Done: Boolean);
  195. begin
  196.   FHalfEvent := False;
  197.   FPrevSelStart := FMemo.SelStart;
  198.  
  199.   if Assigned(FOldApplicationIdle) then
  200.     FOldApplicationIdle(Sender, Done);
  201. end;
  202.  
  203. function THistory.StrDiff(const ACurContent: string; out ASelStart: SizeInt;
  204.   out ASelText: string; out AHalfEvent: Boolean): Boolean;
  205. begin
  206.   if FMemo.SelLength = 0 then begin
  207.     Result := StrDiff1(ACurContent, ASelStart, ASelText, AHalfEvent);
  208.   end else begin
  209.     Result := StrDiff2(ACurContent, ASelStart, ASelText, AHalfEvent);
  210.   end;
  211. end;
  212.  
  213. // Get the difference between ACurContent and FPrevContent(FMemo.SelStart nust be correct, need less calculations).
  214. // The difference can only be insert or delete text in one place, not allowed other difference
  215. // ASelStart: the SelStart of the difference, based 1. if > 0 means add text, if < 0 means delete content
  216. // ASelText: the content of the difference
  217. // AHalfEvent: is it half event of one user operation
  218. function THistory.StrDiff1(const ACurContent: string; out ASelStart: SizeInt;
  219.   out ASelText: string; out AHalfEvent: Boolean): Boolean;
  220. var
  221.   BytePos, DiffLen: SizeInt;
  222. begin
  223.   Result := False;
  224.  
  225.   DiffLen := Length(ACurContent) - Length(FPrevContent);
  226.  
  227.   // UTF8CharToByteIndex based 0.
  228.   // BytePos := lazUTF8.UTF8CharToByteIndex(PChar(ACurContent), Length(ACurContent), FMemo.SelStart) + 1;
  229.   // Custom function based 1.
  230.   BytePos := UTF8PosToBytePos(ACurContent, FMemo.SelStart + 1);
  231.  
  232.   if DiffLen > 0 then begin          // add text
  233.     BytePos   := BytePos - DiffLen;
  234.     ASelText  := Copy(ACurContent, BytePos, DiffLen);
  235.     ASelStart := FMemo.SelStart - UTF8LengthFast(ASelText) + 1;
  236.     { special case: drag in from other control }
  237.     if ASelStart - 1 <> FPrevSelStart then begin
  238.       Result := StrDiff2(AcurContent, ASelStart, ASelText, AHalfEvent);
  239.       Exit;
  240.     end;
  241.   end else if DiffLen < 0 then begin // delete text
  242.     ASelText  := Copy(FPrevContent, BytePos, -DiffLen);
  243.     ASelStart := -(FMemo.SelStart + 1);
  244.   end else
  245.     Exit;
  246.  
  247.   Result := True;
  248.  
  249.   AHalfEvent := FHalfEvent;
  250.   FHalfEvent := True;
  251. end;
  252.  
  253. // get the difference between ACurContent and FPrevContent(FMemo.SelStart does not need correct, need more calculations).
  254. // the difference can only be insert or delete text in one place, not allowed other difference
  255. // ASelStart  : the SelStart of the difference, based 1. if > 0 means add text, if < 0 means delete content
  256. // ASelText   : the content of the difference
  257. // AHalfEvent : is it half event of one user operation
  258. function THistory.StrDiff2(const ACurContent: string; out ASelStart: SizeInt;
  259.   out ASelText: string; out AHalfEvent: Boolean): Boolean;
  260. var
  261.   CurStart, PrevStart, CurPos, PrevPos, CurEnd: PChar;
  262.   BytePos, CurLen, PrevLen, DiffLen: SizeInt;
  263. begin
  264.   Result := False;
  265.  
  266.   CurStart  := PChar(ACurContent);
  267.   PrevStart := PChar(FPrevContent);
  268.  
  269.   CurLen  := Length(ACurContent); // for speed, use Length(string) DO NOT use Length(PChar)
  270.   PrevLen := Length(FPrevContent);
  271.   DiffLen := CurLen - PrevLen;
  272.  
  273.   if DiffLen < 0 then
  274.     CurEnd := CurStart + CurLen - 1
  275.   else if DiffLen > 0 then
  276.     CurEnd := CurStart + PrevLen - 1
  277.   else
  278.     Exit;
  279.  
  280.   // byte-by-byte comparison
  281.   CurPos  := CurStart;
  282.   PrevPos := PrevStart;
  283.   while CurPos <= CurEnd do begin
  284.     if CurPos^ <> PrevPos^ then Break;
  285.     Inc(CurPos);
  286.     Inc(PrevPos);
  287.   end;
  288.  
  289.   // lazUTF8.Utf8TryFindCodepointStart(CurContent, CurPos, CharLen);
  290.   // custom find codepoint start
  291.   while CurPos > CurStart do
  292.     case CurPos^ of
  293.       #0..#127, #192..#247: break;
  294.       else Dec(CurPos);
  295.   end;
  296.  
  297.   BytePos := CurPos - CurStart + 1;
  298.  
  299.   if DiffLen > 0 then begin  // add text
  300.     ASelText  := Copy(ACurContent, BytePos, DiffLen);
  301.     ASelStart := UTF8LengthFast(CurStart, BytePos);
  302.   end else begin             // delete text
  303.     ASelText  := Copy(FPrevContent, BytePos, -DiffLen);
  304.     ASelStart := -UTF8LengthFast(PChar(FPrevContent), BytePos);
  305.   end;
  306.  
  307.   Result := True;
  308.  
  309.   AHalfEvent := FHalfEvent;
  310.   FHalfEvent := True;
  311. end;
  312.  
  313. function THistory.CanUndo: Boolean; inline;
  314. begin
  315.   Result := FIndex >= 0;
  316. end;
  317.  
  318. function THistory.CanRedo: Boolean; inline;
  319. begin
  320.   Result := FIndex < FSteps.Count - 1;
  321. end;
  322.  
  323. procedure THistory.Undo;
  324. var
  325.   Half: Integer;
  326. begin
  327.   if FIndex < 0 then Exit;
  328.  
  329.   FInEdit := False;
  330.   FixOnChangeBug := True;
  331.  
  332.   // FPrevContent == FMemo.Text
  333.   with CurStep^ do begin
  334.     Half := HalfStep;
  335.     if SelStart > 0 then begin
  336.       // writeln(Format('Undo: %d, %s, %d', [SelStart-1, SelText, HalfStep]));
  337.       FMemo.SelStart  := SelStart - 1;  // from "baseed 1" to "based 0"
  338.       FMemo.SelLength := UTF8LengthFast(SelText);
  339.       FMemo.SelText   := '';
  340.     end else begin
  341.       // writeln(Format('Undo: %d, %s, %d', [-SelStart-1, SelText, HalfStep]));
  342.       FMemo.SelStart  := -SelStart - 1; // from "baseed 1" to "based 0"
  343.       FMemo.SelLength := 0;
  344.       FMemo.SelText   := SelText;
  345.     end;
  346.   end;
  347.   Dec(FIndex);
  348.   FPrevContent := FMemo.Text;
  349.  
  350.   if FixOnChangeBug then MemoOnChange(FMemo);
  351.   FInEdit := True;
  352.  
  353.   if Half = 2 then Undo; // trigger another half step
  354. end;
  355.  
  356. procedure THistory.Redo;
  357. var
  358.   Half: Integer;
  359. begin
  360.   if FIndex >= FSteps.Count - 1 then Exit;
  361.  
  362.   FInEdit := False;
  363.   FixOnChangeBug := True;
  364.  
  365.   Inc(FIndex);
  366.   // FPrevContent == FMemo.Text
  367.   with CurStep^ do begin
  368.     Half := HalfStep;
  369.     if SelStart > 0 then begin
  370.       // writeln(Format('Redo: %d, %s, %d', [SelStart-1, SelText, HalfStep]));
  371.       FMemo.SelStart  := SelStart - 1;  // from "baseed 1" to "based 0"
  372.       FMemo.SelLength := 0;
  373.       FMemo.SelText  := SelText;
  374.     end else begin
  375.       // writeln(Format('Redo: %d, %s, %d', [-SelStart-1, SelText, HalfStep]));
  376.       FMemo.SelStart  := -SelStart - 1; // from "baseed 1" to "based 0"
  377.       FMemo.SelLength := UTF8LengthFast(SelText);
  378.       FMemo.SelText   := '';
  379.     end;
  380.   end;
  381.  
  382.   FPrevContent := FMemo.Text;
  383.  
  384.   if FixOnChangeBug then MemoOnChange(FMemo);
  385.   FInEdit := True;
  386.  
  387.   if Half = 1 then Redo; // trigger another half step
  388. end;
  389.  
  390. procedure THistory.PasteText;
  391. var
  392.   ClipBoardText: string;
  393. begin
  394.   ClipBoardText := ClipBoard.AsText;
  395.   if ClipBoardText = '' then Exit;
  396.  
  397.   FInEdit := False;
  398.   FixOnChangeBug := True;
  399.  
  400.   // FPrevContent == FMemo.Text
  401.   if FMemo.SelLength > 0 then begin
  402.     AddStep(-(FMemo.SelStart+1), FMemo.SelText, False);
  403.     AddStep(FMemo.SelStart + 1, ClipBoardText, True);
  404.   end else
  405.     AddStep(FMemo.SelStart + 1, ClipBoardText, False);
  406.   FMemo.SelText := ClipBoardText;
  407.   FPrevContent  := FMemo.Text;
  408.  
  409.   if FixOnChangeBug then MemoOnChange(FMemo);
  410.  
  411.   FInEdit := True;
  412. end;
  413.  
  414. procedure THistory.DeleteText;
  415. begin
  416.   if FMemo.SelLength = 0 then Exit;
  417.  
  418.   FInEdit := False;
  419.   FixOnChangeBug := True;
  420.  
  421.   // FPrevContent == FMemo.Text
  422.   AddStep(-(FMemo.SelStart+1), FMemo.SelText, False);
  423.   FMemo.SelText := '';
  424.   FPrevContent  := FMemo.Text;
  425.  
  426.   if FixOnChangeBug then MemoOnChange(FMemo);
  427.  
  428.   FInEdit := True;
  429. end;
  430.  
  431. procedure THistory.Reset; inline;
  432. begin
  433.   DelStep(0);
  434. end;
  435.  
  436. { ========== Custom Functions ========== }
  437.  
  438. // Convert the character index of a UTF8 string to a byte index. Returns 0 if
  439. // UPos <= 0, return Size + 1 if UPos > Size. This function does not check the
  440. // integrity of the UTF8 encoding, multi-codepoint character will be treated
  441. // as multiple characters.
  442. // Text         : UTF8 string
  443. // Size         : size of UTF8 string
  444. // UPos         : index of character, based 1
  445. // return value : byte index of UPos, based 1
  446. function UTF8PosToBytePos(const Text: PChar; const Size: SizeInt; UPos: SizeInt): SizeInt;
  447. begin
  448.   Result := 0;
  449.   if UPos <= 0 then Exit;
  450.  
  451.   while (UPos > 1) and (Result < Size) do begin
  452.     case Text[Result] of
  453.       // #0  ..#127: Inc(Pos);
  454.       #192..#223: Inc(Result, 2);
  455.       #224..#239: Inc(Result, 3);
  456.       #240..#247: Inc(Result, 4);
  457.       else Inc(Result);
  458.     end;
  459.     Dec(UPos);
  460.   end;
  461.  
  462.   Inc(Result);
  463. end;
  464.  
  465. function UTF8PosToBytePos(const Text: String; const UPos: SizeInt): SizeInt; inline;
  466. begin
  467.   Result := UTF8PosToBytePos(PChar(Text), Length(Text), UPos);
  468. end;
  469.  
  470. // Get characters count of a UTF8 string.
  471. // This function does not check the integrity of the UTF8 encoding,
  472. // multi-codepoint character will be treated as multiple characters.
  473. function UTF8LengthFast(const Text: PChar; const Size: SizeInt): SizeInt;
  474. var
  475.   Pos: Integer;
  476. begin
  477.   Result := 0;
  478.   Pos    := 0;
  479.   while Pos < Size do begin
  480.     case Text[Pos] of
  481.         // #0  ..#127: Inc(Pos);
  482.         #192..#223: Inc(Pos, 2);
  483.         #224..#239: Inc(Pos, 3);
  484.         #240..#247: Inc(Pos, 4);
  485.         else Inc(Pos);
  486.     end;
  487.     Inc(Result);
  488.   end;
  489. end;
  490.  
  491. function UTF8LengthFast(const AStr: String): SizeInt; inline;
  492. begin
  493.   Result := UTF8LengthFast(PChar(AStr), Length(AStr));
  494. end;
  495.  
  496. end.

Note: This demo needs to ensure that SelText:='' works well in Lazarus. In my test, it does not work well in Lazarus 1.8.0 and 1.8.2, but work well in 1.8.0.RC4(my OS is Ubuntu 16.04). I hope that the SelText:='' bug can be fixed in the next release.

Handoko

  • Hero Member
  • *****
  • Posts: 2252
  • My goal: build my own game engine using Lazarus
Re: TMemo Undo Redo analysis
« Reply #2 on: May 01, 2018, 09:33:26 am »
I tested the code on my Lazarus 1.8.0 64-bit Gtk2 Ubuntu. Just as you said, it did not work.

Thaddy

  • Hero Member
  • *****
  • Posts: 5969
Re: TMemo Undo Redo analysis
« Reply #3 on: May 01, 2018, 09:37:08 am »
Usually it should be implemented as a stack and simply store diffs. There are several TStacks available. I prefer the generic one from generics.collections. There is also a TStringStack somewhere that could be useful.There are also many ready-to-use diff algorithms available.
« Last Edit: May 01, 2018, 09:39:19 am by Thaddy »
recommends {$macro on}{$define Silly:=ObjFpc}

ASerge

  • Hero Member
  • *****
  • Posts: 744
Re: TMemo Undo Redo analysis
« Reply #4 on: May 01, 2018, 09:49:36 am »
There is a note when you use TMemo in Windows.
SelStart and SelLength are calculated using WinApi, which is not counted in code points, but in code units (WideChar). That is, if the code point requires two WideСhars, you can select and replace when inserting the half code unit.
SelText and your code uses a conversion function Utf-8 encoding is that trying to count code points.
As a result, it will work incorrectly.

tomitomy

  • Full Member
  • ***
  • Posts: 223
Re: TMemo Undo Redo analysis
« Reply #5 on: May 01, 2018, 11:32:49 am »
I tested the code on my Lazarus 1.8.0 64-bit Gtk2 Ubuntu. Just as you said, it did not work.

Hi Handoko, does this code work in your Lazarus 1.8.0 ?

Code: Pascal  [Select]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. begin
  3.   Memo1.Text := 'abcd';
  4.   Memo1.SelStart := 1;
  5.   Memo1.SelLength := 1;
  6.   Memo1.SelText := '';
  7.   writeln(Memo1.Text);  // should be 'acd'
  8. end;

if it work well, the UndoRedoDemo will work well.

tomitomy

  • Full Member
  • ***
  • Posts: 223
Re: TMemo Undo Redo analysis
« Reply #6 on: May 01, 2018, 11:35:01 am »
Usually it should be implemented as a stack and simply store diffs. There are several TStacks available. I prefer the generic one from generics.collections. There is also a TStringStack somewhere that could be useful.There are also many ready-to-use diff algorithms available.

Hi Thaddy. I don't know about generics.collections, where can I learn and get it? Is there some example or link about the diff algorithms?

tomitomy

  • Full Member
  • ***
  • Posts: 223
Re: TMemo Undo Redo analysis
« Reply #7 on: May 01, 2018, 11:37:06 am »
There is a note when you use TMemo in Windows.
SelStart and SelLength are calculated using WinApi, which is not counted in code points, but in code units (WideChar). That is, if the code point requires two WideСhars, you can select and replace when inserting the half code unit.
SelText and your code uses a conversion function Utf-8 encoding is that trying to count code points.
As a result, it will work incorrectly.

Hi ASerge. Do you mean that the UTF8LengthFast in my code can't correctly count the number of characters in Windows? Can I count correctly if I use lazUTF8.UTF8LengthFast?

Or do you mean "SelStart, SelLength, SelText" can't be used to correctly implement Undo Redo function?

------------------------------

I think I understand, the SelStart or SelLength I got by the code maybe different from TMemo's real SelStart or SelLength in Windows when TMemo has multi-codepoint character. I have not tested in Windows, I will do this test if I have time. Thank you ASerge!

« Last Edit: May 01, 2018, 02:09:51 pm by tomitomy »

Thaddy

  • Hero Member
  • *****
  • Posts: 5969
Re: TMemo Undo Redo analysis
« Reply #8 on: May 01, 2018, 02:47:35 pm »
Hi Thaddy. I don't know about generics.collections, where can I learn and get it? Is there some example or link about the diff algorithms?
In trunk it is in /packages/rtl-generics, but there is a version for fpc 3.0.4. available and both come with examples. You can also use the Delphi examples with it, but there are some features that Delphi doesn't have I believe.
Maciej can point you to the download link. I will look up the diff sourcecode for you. These are mostly based on LCS (longest common substring) but can also be CRC32 based. Or a combination.
Note I myself use an adapted version of the binary diff that is in the dream controls package from dream company, but that is a) commercial and b) alas no longer available. I asked them (actually the new owners)  for a open source release a couple of years ago, but got no answer so I am not able to provide that. That's a pity because a binary diff is able to handle all clipboard formats. Maybe I can find something.
There's a good one for Delphi by Angus Johnson on the embarcadero website that needs little work to get it working for FPC/Lazarus.
http://cc.embarcadero.com/Item/17118  (Needs registration but the code is open source so I might be able to attach it here.)
[edit]
It is also here: http://www.angusj.com/delphi/diff.zip

Make the following changes at the start of the unit and it works in FPC+Lazarus provided you dynamically create it:
Code: Pascal  [Select]
  1. {$ifdef fpc}{$mode delphi}{$H+}{$endif}
  2. interface
  3.  
  4. uses
  5.   SysUtils, Classes, Math, Forms; // removed nonsense dependencies, that's all. It is non-visual.
  6.  

It is now also cross-platform, works also on debian-arm  :D :D
(If Angus is reading this: I'll send you the code if you want...)
Note the version on Angus' website is slightly newer. I used the version from embarcadero to test and convert it, and THAT works. The other one should work too in FPC 3.0.4 + Lazarus 1.8.X

If you need a small example I will add it on request.
« Last Edit: May 01, 2018, 03:28:48 pm by Thaddy »
recommends {$macro on}{$define Silly:=ObjFpc}

ASerge

  • Hero Member
  • *****
  • Posts: 744
Re: TMemo Undo Redo analysis
« Reply #9 on: May 02, 2018, 12:43:00 am »
I think I understand, the SelStart or SelLength I got by the code maybe different from TMemo's real SelStart or SelLength in Windows when TMemo has multi-codepoint character. I have not tested in Windows, I will do this test if I have time. Thank you ASerge!
Try this:
Code: Pascal  [Select]
  1. uses LazUtf8;
  2.  
  3. procedure TForm1.Button1Click(Sender: TObject);
  4. begin
  5.   Memo1.SelStart := 0;
  6.   Memo1.SelLength := UTF8Length(Memo1.Text);
  7.   Memo1.SelText := ''; // Remove all text? Not only one symbol!
  8. end;
  9.  
  10. procedure TForm1.FormCreate(Sender: TObject);
  11. const
  12.   Alpha = #240#157#155#130; // One code point in Utf8
  13.   Omega = #240#157#156#148; // One code point in Utf8
  14. begin
  15.   Memo1.Text := Alpha + Omega;
  16. end;

tomitomy

  • Full Member
  • ***
  • Posts: 223
Re: TMemo Undo Redo analysis
« Reply #10 on: May 02, 2018, 02:32:23 am »
There's a good one for Delphi by Angus Johnson on the embarcadero website that needs little work to get it working for FPC/Lazarus.
http://cc.embarcadero.com/Item/17118  (Needs registration but the code is open source so I might be able to attach it here.)
[edit]
It is also here: http://www.angusj.com/delphi/diff.zip

Thank you Thaddy. I have downloaded "diff.zip" and I will try it later, but all it's documents are in English, I can't swim in such a big English sea. I will search for some Chinese documents about diff later. Thank you very much Thaddy!

tomitomy

  • Full Member
  • ***
  • Posts: 223
Re: TMemo Undo Redo analysis
« Reply #11 on: May 02, 2018, 02:35:15 am »
Try this:

Thank you ASerge. I have tested your code in Windows and I now understand what you mean. Is there a function like UTF8LengthToWindowsLength and WindowsLengthToUTF8Length? or GetWindowsSelLength?

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus