TMemo Undo Redo analysis

[tomitomy]

Please visit the new version through the link bollow(support undo by word):
https://forum.lazarus.freepascal.org/index.php/topic,54069.0.html



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.

[tomitomy]

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]

I tested the code on my Lazarus 1.8.0 64-bit Gtk2 Ubuntu. Just as you said, it did not work.

[Thaddy]

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.

[ASerge]

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]

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]

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]

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!

[Thaddy]

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 
(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.

[ASerge]

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]

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]

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?