paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 03:09:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

SynEdit: tests for paste, copy, OnPaste, OnCutCopy event

Browse Source 
git-svn-id: trunk@22453 -
This commit is contained in:
martin 2009-11-05 19:54:40 +00:00
parent 166ccb9e94
commit 06dfd54e05
2 changed files with 194 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
components/synedit/test/testbase.pas
View File

@ -32,8 +32,9 @@ type
FFixedBaseTestNames: Integer;
FForm : TForm;
FSynEdit : TTestSynEdit;
FClipBoardText: String;
function GetClipBoardText: String;
procedure SetBaseTestName(const AValue: String);
procedure SetClipBoardText(const AValue: String);
protected
function LinesToText(Lines: Array of String; Separator: String = LineEnding;
SeparatorAtEnd: Boolean = False): String;
@ -54,12 +55,16 @@ type
(* Setting selection, with one X/Y pair having negative values, will set caret to other X/Y pair and clear selection *)
// Locical Caret
procedure SetCaret(X, Y: Integer);
procedure SetCaretAndSel(X1, Y1, X2, Y2: Integer; DoLock: Boolean = False);
procedure SetCaretAndSelBackward(X1, Y1, X2, Y2: Integer; DoLock: Boolean = False);
procedure SetCaretAndSel(X1, Y1, X2, Y2: Integer; DoLock: Boolean = False;
AMode: TSynSelectionMode = smCurrent);
procedure SetCaretAndSelBackward(X1, Y1, X2, Y2: Integer; DoLock: Boolean = False;
AMode: TSynSelectionMode = smCurrent);
// Physical Caret
procedure SetCaretPhys(X, Y: Integer);
procedure SetCaretAndSelPhys(X1, Y1, X2, Y2: Integer; DoLock: Boolean = False);
procedure SetCaretAndSelPhysBackward(X1, Y1, X2, Y2: Integer; DoLock: Boolean = False);
procedure SetCaretAndSelPhys(X1, Y1, X2, Y2: Integer; DoLock: Boolean = False;
AMode: TSynSelectionMode = smCurrent);
procedure SetCaretAndSelPhysBackward(X1, Y1, X2, Y2: Integer;
DoLock: Boolean = False; AMode: TSynSelectionMode = smCurrent);
procedure DoKeyPress(Key: Word; Shift: TShiftState = []);
procedure DoKeyPressAtPos(X, Y: Integer; Key: Word; Shift: TShiftState = []);
@ -72,7 +77,8 @@ type
procedure DecFixedBaseTestNames;
property SynEdit: TTestSynEdit read FSynEdit;
property Form: TForm read FForm;
property ClipBoardText: String read FClipBoardText write FClipBoardText;
procedure ClearClipBoard;
property ClipBoardText: String read GetClipBoardText write SetClipBoardText;
protected
procedure SetUp; override;
procedure TearDown; override;
@ -145,11 +151,7 @@ var
FormatList: Array [0..1] of TClipboardFormat;
begin
inherited SetUp;
Clipboard.OnRequest := @ClipBoardRequest;
Clipboard.Open;
FormatList[0] := CF_TEXT;
//FormatList[1] := TSynClipboardStream.ClipboardFormatId;
Clipboard.SetSupportedFormats(1 {2}, @FormatList[0]);
FForm := TForm.Create(nil);
ReCreateEdit;
@ -161,7 +163,6 @@ procedure TTestBase.TearDown;
begin
inherited TearDown;
Clipboard.Close;
Clipboard.OnRequest := nil;
FreeAndNil(FSynEdit);
FreeAndNil(FForm);
end;
@ -265,6 +266,16 @@ begin
PushBaseName(AValue);
end;
function TTestBase.GetClipBoardText: String;
begin
Result := Clipboard.AsText;
end;
procedure TTestBase.SetClipBoardText(const AValue: String);
begin
Clipboard.AsText := AValue;
end;
function TTestBase.LinesToText(Lines: array of String; Separator: String = LineEnding;
SeparatorAtEnd: Boolean = False): String;
var
@ -329,9 +340,6 @@ end;
procedure TTestBase.ClipBoardRequest(const RequestedFormatID: TClipboardFormat;
Data: TStream);
begin
if (RequestedFormatID = CF_TEXT) and (FClipBoardText <> '') then
Data.Write(FClipBoardText[1], length(FClipBoardText));
// if RequestedFormatID = TSynClipboardStream.ClipboardFormatId then begin
end;
@ -359,7 +367,8 @@ begin
{$IFDEF WITH_APPMSG}Application.ProcessMessages;{$ENDIF}
end;
procedure TTestBase.SetCaretAndSel(X1, Y1, X2, Y2: Integer; DoLock: Boolean = False);
procedure TTestBase.SetCaretAndSel(X1, Y1, X2, Y2: Integer;
DoLock: Boolean = False; AMode: TSynSelectionMode = smCurrent);
begin
if (Y1<0) or (X1 < 0) then begin
SetCaret(X2, Y2); // clears selection
@ -374,12 +383,15 @@ begin
SynEdit.LogicalCaretXY := Point(X2, Y2);
SynEdit.BlockBegin := Point(X1, Y1);
SynEdit.BlockEnd := Point(X2, Y2);
if AMode <> smCurrent then
SynEdit.SelectionMode := AMode;
if DoLock then
SynEdit.EndUpdate;
{$IFDEF WITH_APPMSG}Application.ProcessMessages;{$ENDIF}
end;
procedure TTestBase.SetCaretAndSelBackward(X1, Y1, X2, Y2: Integer; DoLock: Boolean = False);
procedure TTestBase.SetCaretAndSelBackward(X1, Y1, X2, Y2: Integer;
DoLock: Boolean = False; AMode: TSynSelectionMode = smCurrent);
begin
if (Y1<0) or (X1 < 0) then begin
SetCaret(X2, Y2); // clears selection
@ -394,6 +406,8 @@ begin
SynEdit.LogicalCaretXY := Point(X1, Y1);
SynEdit.BlockBegin := Point(X1, Y1);
SynEdit.BlockEnd := Point(X2, Y2);
if AMode <> smCurrent then
SynEdit.SelectionMode := AMode;
if DoLock then
SynEdit.EndUpdate;
{$IFDEF WITH_APPMSG}Application.ProcessMessages;{$ENDIF}
@ -406,7 +420,8 @@ begin
{$IFDEF WITH_APPMSG}Application.ProcessMessages;{$ENDIF}
end;
procedure TTestBase.SetCaretAndSelPhys(X1, Y1, X2, Y2: Integer; DoLock: Boolean);
procedure TTestBase.SetCaretAndSelPhys(X1, Y1, X2, Y2: Integer; DoLock: Boolean;
AMode: TSynSelectionMode = smCurrent);
begin
if (Y1<0) or (X1 < 0) then begin
SetCaretPhys(X2, Y2); // clears selection
@ -421,12 +436,15 @@ begin
SynEdit.CaretXY := Point(X2, Y2);
SynEdit.BlockBegin := SynEdit.PhysicalToLogicalPos(Point(X1, Y1));
SynEdit.BlockEnd := SynEdit.PhysicalToLogicalPos(Point(X2, Y2));
if AMode <> smCurrent then
SynEdit.SelectionMode := AMode;
if DoLock then
SynEdit.EndUpdate;
{$IFDEF WITH_APPMSG}Application.ProcessMessages;{$ENDIF}
end;
procedure TTestBase.SetCaretAndSelPhysBackward(X1, Y1, X2, Y2: Integer; DoLock: Boolean);
procedure TTestBase.SetCaretAndSelPhysBackward(X1, Y1, X2, Y2: Integer;
DoLock: Boolean; AMode: TSynSelectionMode = smCurrent);
begin
if (Y1<0) or (X1 < 0) then begin
SetCaretPhys(X2, Y2); // clears selection
@ -441,6 +459,8 @@ begin
SynEdit.LogicalCaretXY := Point(X1, Y1);
SynEdit.BlockBegin := SynEdit.PhysicalToLogicalPos(Point(X1, Y1));
SynEdit.BlockEnd := SynEdit.PhysicalToLogicalPos(Point(X2, Y2));
if AMode <> smCurrent then
SynEdit.SelectionMode := AMode;
if DoLock then
SynEdit.EndUpdate;
{$IFDEF WITH_APPMSG}Application.ProcessMessages;{$ENDIF}
@ -490,5 +510,10 @@ begin
Dec(FFixedBaseTestNames);
end;
procedure TTestBase.ClearClipBoard;
begin
Clipboard.Clear;
end;
end.

151
components/synedit/test/testsynselection.pas
View File

@ -32,6 +32,14 @@ type
procedure TestIsBlock(Name: String; X1, Y1, X2, Y2: Integer; Text: String);
procedure TestIsBlock(Name: String; X1, Y1, X2, Y2: Integer; Text: Array of String);
procedure TestIsNoBlock(Name: String);
protected
FGotMode, FNewMode: TSynSelectionMode;
FGotText, FNewText: String;
FGotPos: TPoint;
FGotAction, FNewAction: TSynCopyPasteAction;
procedure OnCutCopy(Sender: TObject; var AText: String;
var AMode: TSynSelectionMode; ALogStartPos: TPoint;
var AnAction: TSynCopyPasteAction);
published
procedure SelectByKey;
@ -43,6 +51,8 @@ type
procedure ReplaceSelText;
procedure CopyPaste;
//Temporarily here, till we have more units
procedure TextDelCmd;
end;
@ -96,6 +106,19 @@ begin
);
end;
procedure TTestSynSelection.OnCutCopy(Sender: TObject; var AText: String;
var AMode: TSynSelectionMode; ALogStartPos: TPoint; var AnAction: TSynCopyPasteAction);
begin
FGotText := AText;
FGotMode := AMode;
FGotPos := ALogStartPos;
FGotAction := AnAction;
AText := FNewText;
AMode := FNewMode;
AnAction := FNewAction;
end;
procedure TTestSynSelection.SelectByKey;
var
SkipBlockOtherEndBack: Boolean;
@ -1298,6 +1321,134 @@ begin
end;
procedure TTestSynSelection.CopyPaste;
function TheText: TStringArray;
begin
SetLength(Result, 7);
Result[0] := ' ABC';
Result[1] := ' D';
Result[2] := '';
Result[3] := 'XYZ 123';
Result[4] := 'FOO BAR';
Result[5] := ' M';
Result[6] := '';
end;
function TheText2: TStringArray;
begin
SetLength(Result, 7);
Result[0] := '-+';
Result[1] := '-+';
Result[2] := '-+';
Result[3] := '-+';
Result[4] := '-+';
Result[5] := '-+';
Result[6] := '';
end;
procedure DoTest(Name: String; X,Y, X2,Y2: Integer; AMode: TSynSelectionMode;
ACmd: TSynEditorCommand; ClipBefore, ClipAfter: Array of String; TextRepl: Array of const);
begin
ClearClipBoard;
ClipBoardText := LinesToText(ClipBefore);
SetLines(TheText);
if X2 < 1
then SetCaret(X, Y)
else SetCaretAndSel(X,Y, X2,Y2, False, AMode);
SynEdit.CommandProcessor(ACmd, '', nil);
TestIsFullText(Name + ' - Text', TheText, TextRepl);
AssertEquals (Name + ' - Clip', LinesToText(ClipAfter), ClipBoardText);
end;
procedure DoTestPaste(Name: String; TextRepl: Array of const); // Paste SynEdits ClipFormat, if avail
begin
SetLines(TheText2);
SetCaret(2,1);
SynEdit.CommandProcessor(ecPaste, '', nil);
TestIsFullText(Name + ' - Clip-pasted', TheText2, TextRepl);
end;
procedure SetEvent(AText: String; AMode: TSynSelectionMode; AnAction: TSynCopyPasteAction);
begin
FNewText := AText;
FNewMode := AMode;
FNewAction := AnAction;
end;
procedure TestEvent(name, AText: String; AMode: TSynSelectionMode;
AnAction: TSynCopyPasteAction; ALogStartPos: TPoint);
begin
AssertEquals (Name + ' - Event text', AText, FGotText);
AssertEquals (Name + ' - Event mode', ord(AMode), ord(FGotMode));
AssertEquals (Name + ' - Event posx', ALogStartPos.x, FGotPos.x);
AssertEquals (Name + ' - Event posy', ALogStartPos.y, FGotPos.y);
AssertEquals (Name + ' - Event action', ord(AnAction), ord(FGotAction));
end;
begin
ReCreateEdit;
BaseTestName := 'Selftest';
ClearClipBoard;
AssertEquals('clip empty', ClipBoardText, '');
ClipBoardText := 'abc';
AssertEquals('clip abc', ClipBoardText, 'abc');
ClearClipBoard;
AssertEquals('clip empty 2', ClipBoardText, '');
{%region ***** Copy *****}
BaseTestName := 'Copy';
DoTest ('simple copy', 2,4, 5,4, smNormal, ecCopy, [''], ['YZ '], []);
DoTestPaste('simple copy', [1,'-YZ +']);
DoTest ('empty copy', 2,4, 0,0, smNormal, ecCopy, [''], [''], []);
DoTestPaste('empty copy', []);
DoTest ('simple copy (old clip)', 2,4, 5,4, smNormal, ecCopy, ['ab'], ['YZ '], []);
DoTestPaste('simple copy (old clip)', [1,'-YZ +']);
DoTest ('empty copy (old clip)', 2,4, 0,0, smNormal, ecCopy, ['ab'], ['ab'], []); // TODO: decide, should clipboard be emptied?
DoTest ('2 line copy', 2,4, 3,5, smNormal, ecCopy, [''], ['YZ 123', 'FO'], []);
DoTestPaste('2 line copy', [1,'-YZ 123', 'FO+']);
DoTest ('column copy', 2,4, 5,5, smColumn, ecCopy, [''], ['YZ ', 'OO '], []);
DoTestPaste('column copy', [1,'-YZ +', 2,'-OO +']);
BaseTestName := 'Copy (event)';
SynEdit.OnCutCopy := @OnCutCopy;
SetEvent ('kl'+LineEnding+'nm', smColumn, scaContinue);
DoTest ('copy, replace', 2,4, 5,4, smNormal, ecCopy, [''], ['kl', 'nm'], []);
DoTestPaste('copy, replace', [1, '-kl+', 2,'-nm+']);
TestEvent ('copy, replace', 'YZ ', smNormal, scaPlainText, Point(2,4));
SetEvent ('kl'+LineEnding+'nm', smColumn, scaAbort);
DoTest ('copy, abort (old clip)', 2,4, 5,4, smNormal, ecCopy, ['ab'], ['ab'], []);
SynEdit.OnCutCopy := nil;
{%endregion}
{%region ***** Paste *****}
BaseTestName := 'Paste';
DoTest('simple paste', 2,4, 0,0, smCurrent, ecPaste, ['op '], ['op '], [4, 'Xop YZ 123']);
DoTest('empty paste', 2,4, 0,0, smCurrent, ecPaste, [''], [''], []);
DoTest('paste over sel', 2,4, 4,4, smCurrent, ecPaste, ['op '], ['op '], [4, 'Xop 123']);
BaseTestName := 'Paste (event)';
SynEdit.OnPaste := @OnCutCopy;
SetEvent('kl'+LineEnding+'nm', smColumn, scaContinue);
DoTest('paste, replace', 2,4, 0,0, smCurrent, ecPaste, ['op '], ['op '], [4, 'XklYZ 123', 5, 'FnmOO BAR']);
TestEvent('paste, replace', 'op ', smNormal, scaPlainText, Point(2,4));
SetEvent('kl'+LineEnding+'nm', smColumn, scaAbort);
DoTest('paste, abort', 2,4, 0,0, smCurrent, ecPaste, ['op '], ['op '], []);
SynEdit.OnPaste := nil;
{%endregion}
end;
procedure TTestSynSelection.TextDelCmd;
Procedure test1(Name, Txt: String;
x, y: Integer; Cmd: TSynEditorCommand;