diff --git a/components/synedit/test/testbase.pas b/components/synedit/test/testbase.pas index 6a71a01d94..7de650d01e 100644 --- a/components/synedit/test/testbase.pas +++ b/components/synedit/test/testbase.pas @@ -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. diff --git a/components/synedit/test/testsynselection.pas b/components/synedit/test/testsynselection.pas index 90a1e85b46..117d75afc8 100644 --- a/components/synedit/test/testsynselection.pas +++ b/components/synedit/test/testsynselection.pas @@ -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;