整理していると実用上問題のある点がわかり修正しました

[json-checker/json_checker.git] / Undo.pas

diff --git a/Undo.pas b/Undo.pas
index 7aff5b2..9f41381 100644 (file)
--- a/Undo.pas
+++ b/Undo.pas
@@ -14,14 +14,6 @@ type
     procedure ReDo; virtual; abstract;
   end;
 
-  TUnInput = class(TUndoBase)
-  private
-    FData: Char;
-  public
-    procedure Execute; override;
-    procedure ReDo; override;
-  end;
-
   TUnDelete = class(TUndoBase)
   private
     FStr: string;
@@ -46,12 +38,23 @@ type
     procedure ReDo; override;
   end;
 
+  TUnDelRet = class(TUndoBase)
+  private
+    FTop: Boolean;
+  public
+    procedure Execute; override;
+    procedure ReDo; override;
+  end;
+
   TUndoClass = class(TComponent)
   private
+    FMax: integer;
     FStack: TObjectStack;
     FReStack: TObjectStack;
     FMemo: TCustomMemo;
     FCnt: integer;
+    FBack: integer;
+    FDel: integer;
     function GetCanUndo: Boolean;
     procedure Clear;
     procedure DelRedoStack;
@@ -62,16 +65,22 @@ type
     procedure Deleted(const str: string; pos: integer; top: Boolean);
     procedure Inputted(c: Char; pos: integer);
     procedure Returned(pos: integer);
+    procedure DelReturn(num: integer; top: Boolean);
     procedure Pasted(const str: string; pos: integer);
     procedure Execute;
     procedure ReDo;
     destructor Destroy; override;
     procedure UpCount;
+    procedure UpDelCnt;
+    procedure UpBackCnt;
     procedure ResetCnt;
+    procedure ResetDel;
+    procedure ResetBack;
   published
     property Memo: TCustomMemo read FMemo write SetMemo;
     property CanUndo: Boolean read GetCanUndo;
     property CanRedo: Boolean read GetCanRedo;
+    property Max: integer read FMax write FMax;
   end;
 
 implementation
@@ -91,6 +100,7 @@ end;
 constructor TUndoClass.Create(AOwner: TComponent);
 begin
   inherited;
+  FMax := 5;
   FStack := TObjectStack.Create;
   FReStack := TObjectStack.Create;
 end;
@@ -99,13 +109,44 @@ procedure TUndoClass.Deleted(const str: string; pos: integer; top: Boolean);
 var
   obj: TUnDelete;
 begin
+  if str = '' then
+    Exit;
   DelRedoStack;
-  obj := TUnDelete.Create;
-  obj.FStr := str;
-  obj.FPos := pos;
-  obj.FTop := top;
-  obj.FMemo := FMemo;
-  FStack.Push(obj);
+  if ((FBack > 0) or (FDel > 0)) and (FStack.Peek is TUnDelete) and
+    (Length(str) = 1) then
+  begin
+    obj := FStack.Peek as TUnDelete;
+    if top = obj.FTop then
+    begin
+      if top = true then
+      begin
+        obj.FStr := obj.FStr + str;
+        obj.FPos := obj.FPos;
+      end
+      else
+      begin
+        obj.FStr := str + obj.FStr;
+        obj.FPos := obj.FPos - 1;
+      end;
+    end
+    else
+    begin
+      FBack := 0;
+      FDel := 0;
+      Deleted(str, pos, top);
+    end;
+  end
+  else
+  begin
+    FBack := 0;
+    FDel := 0;
+    obj := TUnDelete.Create;
+    obj.FStr := str;
+    obj.FPos := pos;
+    obj.FTop := top;
+    obj.FMemo := FMemo;
+    FStack.Push(obj);
+  end;
 end;
 
 procedure TUndoClass.DelRedoStack;
@@ -117,6 +158,17 @@ begin
       FReStack.Pop.Free;
 end;
 
+procedure TUndoClass.DelReturn(num: integer; top: Boolean);
+var
+  obj: TUnDelRet;
+begin
+  obj := TUnDelRet.Create;
+  obj.FPos := num;
+  obj.FTop := top;
+  obj.FMemo := FMemo;
+  FStack.Push(obj);
+end;
+
 destructor TUndoClass.Destroy;
 begin
   Clear;
@@ -139,7 +191,7 @@ end;
 
 function TUndoClass.GetCanRedo: Boolean;
 begin
-  result:=FReStack.Count > 0;
+  result := FReStack.Count > 0;
 end;
 
 function TUndoClass.GetCanUndo: Boolean;
@@ -177,6 +229,7 @@ begin
   obj := TUnPaste.Create;
   obj.FPos := pos;
   obj.FLen := Length(str);
+  obj.FStr := str;
   obj.FMemo := FMemo;
   FStack.Push(obj);
 end;
@@ -193,11 +246,21 @@ begin
   end;
 end;
 
+procedure TUndoClass.ResetBack;
+begin
+  FBack := 0;
+end;
+
 procedure TUndoClass.ResetCnt;
 begin
   FCnt := 0;
 end;
 
+procedure TUndoClass.ResetDel;
+begin
+  FDel := 0;
+end;
+
 procedure TUndoClass.Returned(pos: integer);
 var
   obj: TUnRETURN;
@@ -228,13 +291,27 @@ begin
   List.Free;
 end;
 
+procedure TUndoClass.UpBackCnt;
+begin
+  inc(FBack);
+  if FBack > Max then
+    FBack := 0;
+end;
+
 procedure TUndoClass.UpCount;
 begin
   inc(FCnt);
-  if FCnt > 5 then
+  if FCnt > Max then
     FCnt := 0;
 end;
 
+procedure TUndoClass.UpDelCnt;
+begin
+  inc(FDel);
+  if FDel > Max then
+    FDel := 0;
+end;
+
 { TUnDelete }
 
 procedure TUnDelete.Execute;
@@ -252,7 +329,7 @@ begin
   else
   begin
     FMemo.SelLength := Length(FStr);
-    FMemo.SelStart := FPos + 1;
+    FMemo.SelStart := FPos + Length(FStr);
   end;
 end;
 
@@ -289,44 +366,54 @@ begin
   end;
 end;
 
-{ TUnInput }
+{ TUnRETURN }
 
-procedure TUnInput.Execute;
+procedure TUnRETURN.Execute;
+var
+  i: integer;
 begin
   if FMemo <> nil then
   begin
     FMemo.SelStart := FPos;
-    FMemo.SelText := '';
+    i := FMemo.CaretPos.Y;
+    FMemo.Lines[i] := FMemo.Lines[i] + FMemo.Lines[i + 1];
+    FMemo.Lines.Delete(i + 1);
+    FMemo.SelStart := FPos;
   end;
 end;
 
-procedure TUnInput.ReDo;
+procedure TUnRETURN.ReDo;
 begin
-
+  if FMemo <> nil then
+  begin
+    FMemo.SelStart := FPos;
+    FMemo.SelText := #13#10;
+  end;
 end;
 
-{ TUnRETURN }
+{ TUnDelRet }
 
-procedure TUnRETURN.Execute;
-var
-  i: integer;
+procedure TUnDelRet.Execute;
 begin
   if FMemo <> nil then
   begin
     FMemo.SelStart := FPos;
-    i := FMemo.CaretPos.Y;
-    FMemo.Lines[i] := FMemo.Lines[i] + FMemo.Lines[i + 1];
-    FMemo.Lines.Delete(i + 1);
-    FMemo.SelStart := FPos;
+    FMemo.SelText := #13#10;
+    if FTop = false then
+      FMemo.SelStart := FMemo.SelStart + 1;
   end;
 end;
 
-procedure TUnRETURN.ReDo;
+procedure TUnDelRet.ReDo;
+var
+  i: integer;
 begin
   if FMemo <> nil then
   begin
     FMemo.SelStart := FPos;
-    FMemo.SelText := #13#10;
+    i := FMemo.CaretPos.Y;
+    FMemo.Lines[i] := FMemo.Lines[i] + FMemo.Lines[i + 1];
+    FMemo.Lines.Delete(i + 1);
   end;
 end;