paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-02 13:19:49 +01:00
Code Issues Packages Projects Releases Wiki Activity

SynEdit: Multi caret beta

Browse Source 
git-svn-id: trunk@47596 -
This commit is contained in:
martin 2015-02-06 02:07:31 +00:00
parent edf313e023
commit b6efaa244f
14 changed files with 2383 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -3493,6 +3493,7 @@ components/synedit/synhighlightervb.pas svneol=native#text/plain
components/synedit/synhighlighterxml.pas svneol=native#text/pascal
components/synedit/synmacrorecorder.pas svneol=native#text/pascal
components/synedit/synmemo.pas svneol=native#text/pascal
components/synedit/synpluginmulticaret.pp svneol=native#text/plain
components/synedit/synpluginsyncroedit.pp svneol=native#text/pascal
components/synedit/synpluginsyncronizededitbase.pp svneol=native#text/pascal
components/synedit/synplugintemplateedit.pp svneol=native#text/pascal
@ -3513,6 +3514,7 @@ components/synedit/test/testhighlightxml.pas svneol=native#text/pascal
components/synedit/test/testmarkuphighall.pas svneol=native#text/pascal
components/synedit/test/testmarkupifdef.pas svneol=native#text/pascal
components/synedit/test/testmarkupwordgroup.pas svneol=native#text/pascal
components/synedit/test/testmulticaret.pas svneol=native#text/plain
components/synedit/test/testnavigation.pas svneol=native#text/pascal
components/synedit/test/testpaintcolormerging.pas svneol=native#text/pascal
components/synedit/test/testsearch.pas svneol=native#text/pascal

2
components/ideintf/idecommands.pas
View File

@ -46,7 +46,7 @@ const
}
ecNone = 0;
ecFirstLazarus = 1001;
ecFirstLazarus = 1001; // syneditkeycmds.ecUserFirst = 1001;
// search
ecFind = ecFirstLazarus + 1;

2
components/synedit/allsynedit.pas
View File

@ -26,7 +26,7 @@ uses
SynPluginSyncronizedEditBase, SynPluginTemplateEdit, LazSynEditText, LazSynTextArea,
SynRegExpr, SynTextDrawer, SynEditMarkupGutterMark, SynHighlighterBat, SynHighlighterIni,
SynEditMarkupSpecialChar, SynEditTextDoubleWidthChars, SynEditTextSystemCharWidth,
SynEditMarkupIfDef, LazarusPackageIntf;
SynEditMarkupIfDef, SynPluginMultiCaret, LazarusPackageIntf;
implementation

4
components/synedit/lazsynedittext.pas
View File

@ -63,8 +63,10 @@ type
senrDecOwnedPaintLock,
senrIncPaintLock, // Actual PaintLock
senrDecPaintLock,
senrAfterIncPaintLock, // For plugins, etc...
senrBeforeIncPaintLock, // For plugins, etc...
senrAfterIncPaintLock,
senrBeforeDecPaintLock,
senrAfterDecPaintLock,
senrTextBufferChanging, // About to change
senrTextBufferChanged
);

16
components/synedit/lazsyntextarea.pp
View File

@ -103,6 +103,7 @@ type
FCharWidth: integer;
FLinesInWindow: Integer;
fOnStatusChange: TStatusChangeEvent;
FTextSizeChangeList: TMethodList;
FTextHeight: integer;
FCanvas: TCanvas;
@ -152,6 +153,8 @@ type
function PixelsToRowColumn(Pixels: TPoint; aFlags: TSynCoordinateMappingFlags): TPoint; // ignores scmLimitToLines
procedure FontChanged;
procedure AddTextSizeChangeHandler(AHandler: TNotifyEvent);
procedure RemoveTextSizeChangeHandler(AHandler: TNotifyEvent);
// Settings controlled by SynEdit
property Padding[Side: TLazSynBorderSide]: integer read GetPadding write SetPadding;
@ -1215,6 +1218,7 @@ var
i: TLazSynBorderSide;
begin
inherited Create(AOwner);
FTextSizeChangeList := TMethodList.Create;
FTokenBreaker := TLazSynPaintTokenBreaker.Create;
FTextDrawer := ATextDrawer;
FTextDrawer.RegisterOnFontChangeHandler(@DoDrawerFontChanged);
@ -1236,6 +1240,7 @@ begin
FTextDrawer.UnRegisterOnFontChangeHandler(@DoDrawerFontChanged);
FreeAndNil(FPaintLineColor);
FreeAndNil(FPaintLineColor2);
FreeAndNil(FTextSizeChangeList);
inherited Destroy;
end;
@ -1320,6 +1325,17 @@ begin
if (Chg <> []) then
fOnStatusChange(Self, Chg);
end;
FTextSizeChangeList.CallNotifyEvents(Self);
end;
procedure TLazSynTextArea.AddTextSizeChangeHandler(AHandler: TNotifyEvent);
begin
FTextSizeChangeList.Add(TMethod(AHandler));
end;
procedure TLazSynTextArea.RemoveTextSizeChangeHandler(AHandler: TNotifyEvent);
begin
FTextSizeChangeList.Remove(TMethod(AHandler));
end;
procedure TLazSynTextArea.DoPaint(ACanvas: TCanvas; AClip: TRect);

133
components/synedit/synedit.pp
View File

@ -449,7 +449,7 @@ type
FBlockTabIndent: integer;
FCaret: TSynEditCaret;
FInternalCaret: TSynEditCaret;
FScreenCaret: TSynEditScreenCaret;
//FScreenCaret: TSynEditScreenCaret;
FInternalBlockSelection: TSynEditSelection;
FOnChangeUpdating: TChangeUpdatingEvent;
FMouseSelectionMode: TSynSelectionMode;
@ -543,6 +543,7 @@ type
FKeyPressEventList: TLazSynKeyPressEventList;
FUtf8KeyPressEventList: TLazSynUtf8KeyPressEventList;
FStatusChangedList: TObject;
FPaintEventHandlerList: TObject; // TSynPaintEventHandlerList
FPlugins: TList;
fScrollTimer: TTimer;
FScrollDeltaX, FScrollDeltaY: Integer;
@ -736,11 +737,14 @@ type
FTextArea: TLazSynTextArea;
FLeftGutterArea, FRightGutterArea: TLazSynGutterArea;
FPaintArea: TLazSynSurfaceManager;
property ScreenCaret: TSynEditScreenCaret read FScreenCaret;
procedure PaintWindow(DC: HDC); override;
procedure Paint; override;
procedure StartPaintBuffer(const ClipRect: TRect);
procedure EndPaintBuffer(const ClipRect: TRect);
procedure DoOnPaint; virtual;
function GetPaintArea: TLazSynSurfaceManager; override;
procedure IncPaintLock;
procedure DecPaintLock;
@ -943,7 +947,8 @@ type
function ExecuteAction(ExeAction: TBasicAction): boolean; override;
procedure CommandProcessor(Command:TSynEditorCommand;
AChar: TUTF8Char;
Data:pointer); virtual;
Data:pointer;
ASkipHooks: THookedCommandFlags = []); virtual;
procedure ExecuteCommand(Command: TSynEditorCommand;
const AChar: TUTF8Char; Data: pointer); virtual;
@ -1010,6 +1015,9 @@ type
procedure RegisterBeforeUtf8KeyPressHandler(AHandlerProc: TUTF8KeyPressEvent);
procedure UnregisterBeforeUtf8KeyPressHandler(AHandlerProc: TUTF8KeyPressEvent);
procedure RegisterPaintEventHandler(APaintEventProc: TSynPaintEventProc; AnEvents: TSynPaintEvents);
procedure UnRegisterPaintEventHandler(APaintEventProc: TSynPaintEventProc);
function SearchReplace(const ASearch, AReplace: string;
AOptions: TSynSearchOptions): integer;
function SearchReplaceEx(const ASearch, AReplace: string;
@ -1289,6 +1297,15 @@ type
procedure CallStatusChangedHandlers(Sender: TObject; Changes: TSynStatusChanges);
end;
{ TSynPaintEventHandlerList }
TSynPaintEventHandlerList = Class(TSynFilteredMethodList)
public
procedure Add(AHandler: TSynPaintEventProc; Changes: TSynPaintEvents);
procedure Remove(AHandler: TSynPaintEventProc);
procedure CallPaintEventHandlers(Sender: TObject; AnEvents: TSynPaintEvents);
end;
{ TSynEditUndoCaret }
TSynEditUndoCaret = class(TSynEditUndoItem)
@ -1877,6 +1894,7 @@ begin
FRecalcCharsAndLinesLock := 0;
FStatusChangedList := TSynStatusChangedHandlerList.Create;
FPaintEventHandlerList := TSynPaintEventHandlerList.Create;
FDefaultBeautifier := TSynBeautifier.Create(self);
FBeautifier := FDefaultBeautifier;
@ -2400,6 +2418,7 @@ begin
FreeAndNil(fInternalCaret);
FreeAndNil(FScreenCaret);
FreeAndNil(FStatusChangedList);
FreeAndNil(FPaintEventHandlerList);
FBeautifier := nil;
FreeAndNil(FDefaultBeautifier);
FreeAndNil(FKeyDownEventList);
@ -3668,9 +3687,26 @@ begin
//DebugLn('TCustomSynEdit.MouseUp END Mouse=',X,',',Y,' Caret=',CaretX,',',CaretY,', BlockBegin=',BlockBegin.X,',',BlockBegin.Y,' BlockEnd=',BlockEnd.X,',',BlockEnd.Y);
end;
procedure TCustomSynEdit.PaintWindow(DC: HDC);
begin
//before canvas is substituded
Include(fStateFlags,sfPainting);
try
FScreenCaret.Hide;
TSynPaintEventHandlerList(FPaintEventHandlerList).CallPaintEventHandlers(Self, [peBeforePaintCanvas]);
inherited PaintWindow(DC);
// Doublebuffer has NOT yet painted back
UpdateCaret; // Todo: only ShowCaret() / do not create caret here / Issue 0021924
TSynPaintEventHandlerList(FPaintEventHandlerList).CallPaintEventHandlers(Self, [peAfterPaintCanvas]);
finally
Exclude(fStateFlags,sfPainting);
end;
end;
procedure TCustomSynEdit.Paint;
var
rcClip: TRect;
NoState: Boolean;
begin
// Get the invalidated rect. Compute the invalid area in lines / columns.
rcClip := Canvas.ClipRect;
@ -3696,6 +3732,14 @@ begin
exit;
end;
NoState := False;
if not(sfPainting in fStateFlags) then begin
debugln(['Warning TCustomSynEdit.Paint called outsid WMPaint']);
Include(fStateFlags,sfPainting);
FScreenCaret.Hide;
NoState := True;
end;
{$IFDEF EnableDoubleBuf}
//rcClip:=Rect(0,0,ClientWidth,ClientHeight);
StartPaintBuffer(rcClip);
@ -3706,8 +3750,8 @@ begin
Include(fStateFlags,sfPainting);
Exclude(fStateFlags, sfHasScrolled);
TSynPaintEventHandlerList(FPaintEventHandlerList).CallPaintEventHandlers(Self, [peBeforePaint]);
// Now paint everything while the caret is hidden.
FScreenCaret.Hide;
try
FPaintArea.Paint(Canvas, rcClip);
DoOnPaint;
@ -3715,8 +3759,12 @@ begin
{$IFDEF EnableDoubleBuf}
EndPaintBuffer(rcClip);
{$ENDIF}
UpdateCaret; // Todo: only ShowCaret() / do not create caret here / Issue 0021924
TSynPaintEventHandlerList(FPaintEventHandlerList).CallPaintEventHandlers(Self, [peAfterPaint]);
Exclude(fStateFlags,sfPainting);
if NoState then begin
UpdateCaret; // Todo: only ShowCaret() / do not create caret here / Issue 0021924
Exclude(fStateFlags,sfPainting);
end;
end;
end;
@ -4422,9 +4470,11 @@ begin
Invalidate;
end else
begin
TSynPaintEventHandlerList(FPaintEventHandlerList).CallPaintEventHandlers(Self, [peBeforeScroll]);
srect := FPaintArea.Bounds;
srect.Top := FTextArea.TextBounds.Top;
srect.Bottom := FTextArea.TextBounds.Bottom;
FScreenCaret.Hide;
if ScrollWindowEx(Handle, 0, LineHeight * Delta, @srect, @srect, 0, nil, SW_INVALIDATE)
then begin
{$IFDEF SYNSCROLLDEBUG}
@ -4438,6 +4488,7 @@ begin
debugln(['ScrollAfterTopLineChanged does invalidet (scroll failed) Delta=',Delta]);
{$ENDIF}
end;
TSynPaintEventHandlerList(FPaintEventHandlerList).CallPaintEventHandlers(Self, [peAfterScroll]);
end;
end;
FOldTopView := TopView;
@ -4690,6 +4741,7 @@ begin
FImeHandler.FocusKilled;
{$ENDIF}
inherited;
StatusChanged([scFocus]);
end;
procedure TCustomSynEdit.WMSetFocus(var Msg: TLMSetFocus);
@ -4706,6 +4758,7 @@ begin
// Invalidate;
inherited;
//DebugLn('[TCustomSynEdit.WMSetFocus] END');
StatusChanged([scFocus]);
end;
procedure TCustomSynEdit.DoOnResize;
@ -5428,6 +5481,7 @@ begin
FreeAndNil(FMarkList);
end;
end;
StatusChanged([scOptions]);
end;
procedure TCustomSynEdit.ChangeTextBuffer(NewBuffer: TSynEditStringList);
@ -5694,6 +5748,7 @@ begin
then FPaintArea.VisibleSpecialChars := AValue
else FPaintArea.VisibleSpecialChars := [];
if eoShowSpecialChars in Options then Invalidate;
StatusChanged([scOptions]);
end;
function TCustomSynEdit.GetLineState(ALine: Integer): TSynLineState;
@ -6032,6 +6087,7 @@ begin
FInsertCaret := Value;
if InsertMode then
FScreenCaret.DisplayType := fInsertCaret;
StatusChanged([scOptions]);
end;
end;
@ -6041,6 +6097,7 @@ begin
FOverwriteCaret := Value;
if not InsertMode then
FScreenCaret.DisplayType := fOverwriteCaret;
StatusChanged([scOptions]);
end;
end;
@ -6169,9 +6226,8 @@ begin
FRightGutter.ResetMouseActions;
end;
procedure TCustomSynEdit.CommandProcessor(Command: TSynEditorCommand;
AChar: TUTF8Char;
Data: pointer);
procedure TCustomSynEdit.CommandProcessor(Command: TSynEditorCommand; AChar: TUTF8Char;
Data: pointer; ASkipHooks: THookedCommandFlags);
var
InitialCmd: TSynEditorCommand;
BeautifyWorker: TSynCustomBeautifier;
@ -6184,7 +6240,8 @@ begin
{$ENDIF}
// first the program event handler gets a chance to process the command
InitialCmd := Command;
NotifyHookedCommandHandlers(Command, AChar, Data, hcfInit);
if not(hcfInit in ASkipHooks) then
NotifyHookedCommandHandlers(Command, AChar, Data, hcfInit);
DoOnProcessCommand(Command, AChar, Data);
if Command <> ecNone then begin
try
@ -6198,14 +6255,14 @@ begin
end;
// notify hooked command handlers before the command is executed inside of
// the class
if Command <> ecNone then
if (Command <> ecNone) and not(hcfPreExec in ASkipHooks) then
NotifyHookedCommandHandlers(Command, AChar, Data, hcfPreExec);
// internal command handler
if (Command <> ecNone) and (Command < ecUserFirst) then
ExecuteCommand(Command, AChar, Data);
// notify hooked command handlers after the command was executed inside of
// the class
if Command <> ecNone then
// the class (only if NOT handled by hcfPreExec)
if (Command <> ecNone) and not(hcfPostExec in ASkipHooks) then
NotifyHookedCommandHandlers(Command, AChar, Data, hcfPostExec);
if Command <> ecNone then
DoOnCommandProcessed(Command, AChar, Data);
@ -6227,7 +6284,9 @@ begin
{$ENDIF}
end;
end;
NotifyHookedCommandHandlers(Command, AChar, Data, hcfFinish);
Command := InitialCmd;
if not(hcfFinish in ASkipHooks) then
NotifyHookedCommandHandlers(Command, AChar, Data, hcfFinish);
finally
DecLCLRefCount;
end;
@ -7513,6 +7572,7 @@ begin
FOptions := Value; // undo changes applied by MouseOptions
StatusChanged([scOptions]);
end;
procedure TCustomSynEdit.UpdateOptions;
@ -7536,6 +7596,7 @@ begin
MoveCaretToVisibleArea;
if (eoAutoHideCursor in ChangedOptions) and not(eoAutoHideCursor in fOptions2) then
UpdateCursor;
StatusChanged([scOptions]);
end;
end;
@ -7570,6 +7631,7 @@ begin
fMarkupCtrlMouse.UpdateCtrlMouse;
UpdateCursor;
end;
StatusChanged([scOptions]);
end;
procedure TCustomSynEdit.UpdateMouseOptions;
@ -8916,6 +8978,17 @@ begin
FUtf8KeyPressEventList.Remove(TMethod(AHandlerProc));
end;
procedure TCustomSynEdit.RegisterPaintEventHandler(APaintEventProc: TSynPaintEventProc;
AnEvents: TSynPaintEvents);
begin
TSynPaintEventHandlerList(FPaintEventHandlerList).Add(APaintEventProc, AnEvents);
end;
procedure TCustomSynEdit.UnRegisterPaintEventHandler(APaintEventProc: TSynPaintEventProc);
begin
TSynPaintEventHandlerList(FPaintEventHandlerList).Remove(APaintEventProc);
end;
procedure TCustomSynEdit.NotifyHookedCommandHandlers(var Command: TSynEditorCommand;
var AChar: TUTF8Char; Data: pointer; ATime: THookedCommandFlag);
var
@ -8946,6 +9019,11 @@ begin
end;
end;
function TCustomSynEdit.GetPaintArea: TLazSynSurfaceManager;
begin
Result := FPaintArea;
end;
function TCustomSynEdit.DoOnReplaceText(const ASearch, AReplace: string;
Line, Column: integer): TSynReplaceAction;
begin
@ -9112,8 +9190,12 @@ end;
procedure TLazSynEditPlugin.DoEditorDestroyed(const AValue: TCustomSynEdit);
begin
if Editor <> AValue then exit;
if OwnedByEditor then
Free
if OwnedByEditor then begin
// if no DoEditorDestroyed
if TMethod(@DoEditorRemoving).Code = Pointer(@TLazSynEditPlugin.DoEditorDestroyed) then
DoEditorRemoving(AValue);
Free;
end
else
Editor := nil;
end;
@ -9248,6 +9330,29 @@ begin
TStatusChangeEvent(FItems[i].FHandler)(Sender, Changes);
end;
{ TSynPaintEventHandlerList }
procedure TSynPaintEventHandlerList.Add(AHandler: TSynPaintEventProc;
Changes: TSynPaintEvents);
begin
AddBitFilter(TMethod(AHandler), LongInt(Changes));
end;
procedure TSynPaintEventHandlerList.Remove(AHandler: TSynPaintEventProc);
begin
inherited Remove(TMethod(AHandler));
end;
procedure TSynPaintEventHandlerList.CallPaintEventHandlers(Sender: TObject;
AnEvents: TSynPaintEvents);
var
i: Integer;
begin
i:=Count;
while NextDownIndexBitFilter(i, LongInt(AnEvents)) do
TSynPaintEventProc(FItems[i].FHandler)(Sender, AnEvents);
end;
{ TSynEditMarkListInternal }
function TSynEditMarkListInternal.GetLinesView: TSynEditStrings;

41
components/synedit/syneditmiscclasses.pp
View File

@ -89,12 +89,15 @@ type
property WhiteChars: TSynIdentChars read FWhiteChars write SetWhiteChars;
end;
TLazSynSurface = class;
{ TSynEditBase }
TSynEditBase = class(TCustomControl)
protected
FWordBreaker: TSynWordBreaker;
FBlockSelection: TSynEditSelection;
FScreenCaret: TSynEditScreenCaret;
function GetMarkupMgr: TObject; virtual; abstract;
function GetLines: TStrings; virtual; abstract;
function GetCaretObj: TSynEditCaret; virtual; abstract;
@ -102,6 +105,7 @@ type
function GetViewedTextBuffer: TSynEditStrings; virtual; abstract;
function GetFoldedTextBuffer: TObject; virtual; abstract;
function GetTextBuffer: TSynEditStrings; virtual; abstract;
function GetPaintArea: TLazSynSurface; virtual; abstract; // TLazSynSurfaceManager
property MarkupMgr: TObject read GetMarkupMgr;
property FoldedTextBuffer: TObject read GetFoldedTextBuffer; // TSynEditFoldedView
@ -123,6 +127,8 @@ type
function GetIsRedoing: Boolean;
function GetIsUndoing: Boolean;
function GetMarkupMgr: TObject;
function GetPaintArea: TLazSynSurface; // TLazSynSurfaceManager
function GetScreenCaret: TSynEditScreenCaret;
function GetSelectionObj: TSynEditSelection;
function GetTextBuffer: TSynEditStrings;
function GetViewedTextBuffer: TSynEditStrings;
@ -133,7 +139,9 @@ type
property ViewedTextBuffer: TSynEditStrings read GetViewedTextBuffer; // As viewed internally (with uncommited spaces / TODO: expanded tabs, folds). This may change, use with care
property TextBuffer: TSynEditStrings read GetTextBuffer; // (TSynEditStringList)
property CaretObj: TSynEditCaret read GetCaretObj;
property ScreenCaret: TSynEditScreenCaret read GetScreenCaret; // TODO: should not be exposed
property SelectionObj: TSynEditSelection read GetSelectionObj;
property PaintArea: TLazSynSurface read GetPaintArea; // TLazSynSurfaceManager
property MarkupMgr: TObject read GetMarkupMgr;
property IsUndoing: Boolean read GetIsUndoing;
property IsRedoing: Boolean read GetIsRedoing;
@ -308,6 +316,7 @@ type
TLazSynSurface = class
private
FBounds: TRect;
FBoundsChangeList: TMethodList;
FDisplayView: TLazSynDisplayView;
FOwner: TWinControl;
function GetHandle: HWND;
@ -319,7 +328,11 @@ type
property Handle: HWND read GetHandle;
public
constructor Create(AOwner: TWinControl);
destructor Destroy; override;
procedure Assign(Src: TLazSynSurface); virtual;
procedure AddBoundsChangeHandler(AHandler: TNotifyEvent);
procedure RemoveBoundsChangeHandler(AHandler: TNotifyEvent);
procedure Paint(ACanvas: TCanvas; AClip: TRect);
procedure InvalidateLines(FirstTextLine, LastTextLine: TLineIdx); virtual;
procedure SetBounds(ATop, ALeft, ABottom, ARight: Integer);
@ -616,6 +629,16 @@ begin
Result := FFriendEdit.MarkupMgr;
end;
function TSynEditFriend.GetPaintArea: TLazSynSurface;
begin
Result := FFriendEdit.GetPaintArea;
end;
function TSynEditFriend.GetScreenCaret: TSynEditScreenCaret;
begin
Result := FFriendEdit.FScreenCaret;
end;
function TSynEditFriend.GetSelectionObj: TSynEditSelection;
begin
Result := FFriendEdit.FBlockSelection;
@ -1239,6 +1262,13 @@ end;
constructor TLazSynSurface.Create(AOwner: TWinControl);
begin
FOwner := AOwner;
FBoundsChangeList := TMethodList.Create;
end;
destructor TLazSynSurface.Destroy;
begin
inherited Destroy;
FreeAndNil(FBoundsChangeList);
end;
procedure TLazSynSurface.Assign(Src: TLazSynSurface);
@ -1247,6 +1277,16 @@ begin
DisplayView := Src.DisplayView;
end;
procedure TLazSynSurface.AddBoundsChangeHandler(AHandler: TNotifyEvent);
begin
FBoundsChangeList.Add(TMethod(AHandler));
end;
procedure TLazSynSurface.RemoveBoundsChangeHandler(AHandler: TNotifyEvent);
begin
FBoundsChangeList.Remove(TMethod(AHandler));
end;
procedure TLazSynSurface.Paint(ACanvas: TCanvas; AClip: TRect);
begin
if (AClip.Left >= Bounds.Right) or
@ -1280,6 +1320,7 @@ begin
FBounds.Right := ARight;
FBounds.Bottom := ABottom;
BoundsChanged;
FBoundsChangeList.CallNotifyEvents(Self);
end;
{ TSynBookMarkOpt }

1
components/synedit/syneditmousecmds.pp
View File

@ -277,6 +277,7 @@ const
emcMax = 29;
emcPluginFirstSyncro = 19000;
emcPluginFirstMultiCaret = 19010;
emcPluginFirst = 20000;
// Options

479
components/synedit/syneditpointclasses.pas
View File

@ -36,7 +36,7 @@ unit SynEditPointClasses;
interface
uses
Classes, SysUtils, Controls, LCLProc, LCLType, LCLIntf, ExtCtrls, Graphics,
Classes, SysUtils, Controls, LCLProc, LCLType, LCLIntf, ExtCtrls, Graphics, Forms,
{$IFDEF SYN_MBCSSUPPORT}
Imm,
{$ENDIF}
@ -81,10 +81,20 @@ type
sbpStrong // selstart/end are treated as inside the block
);
TSynBeforeSetSelTextEvent = procedure(Sender: TObject; AMode: TSynSelectionMode; ANewText: PChar) of object;
{ TSynBeforeSetSelTextList }
TSynBeforeSetSelTextList = Class(TMethodList)
public
procedure CallBeforeSetSelTextHandlers(Sender: TObject; AMode: TSynSelectionMode; ANewText: PChar);
end;
{ TSynEditSelection }
TSynEditSelection = class(TSynEditPointBase)
private
FOnBeforeSetSelText: TSynBeforeSetSelTextList;
FAutoExtend: Boolean;
FCaret: TSynEditCaret;
FHide: Boolean;
@ -150,6 +160,8 @@ type
procedure IncPersistentLock(AMode: TSynBlockPersistMode = sbpDefault); // Weak: Do not extend (but rather move) block, if at start/end
procedure DecPersistentLock;
procedure Clear;
procedure AddBeforeSetSelTextHandler(AHandler: TSynBeforeSetSelTextEvent);
procedure RemoveBeforeSetSelTextHandler(AHandler: TSynBeforeSetSelTextEvent);
property Enabled: Boolean read FEnabled write SetEnabled;
property ActiveSelectionMode: TSynSelectionMode
read FActiveSelectionMode write SetActiveSelectionMode;
@ -320,30 +332,70 @@ type
property SkipTabs: Boolean read FSkipTabs write SetSkipTabs;
property AllowPastEOL: Boolean read FAllowPastEOL write SetAllowPastEOL;
property KeepCaretX: Boolean read FKeepCaretX write SetKeepCaretX;
property MaxLeftChar: TMaxLeftCharFunc write FMaxLeftChar;
property MaxLeftChar: TMaxLeftCharFunc read FMaxLeftChar write FMaxLeftChar;
end;
TSynCaretType = (ctVerticalLine, ctHorizontalLine, ctHalfBlock, ctBlock, ctCostum);
TSynCaretLockFlags = set of (sclfUpdateDisplay, sclfUpdateDisplayType);
{ TSynEditScreenCaretTimer
Allow sync between carets which use an internal painter
}
TSynEditScreenCaretTimer = class
private
FDisplayCycle: Boolean;
FTimer: TTimer;
FTimerList: TMethodList;
FLocCount: Integer;
FLocFlags: set of (lfTimer, lfRestart);
FAsyncQueued: Boolean;
procedure DoRestartCycle(Data: PtrInt);
procedure DoTimer(Sender: TObject);
public
constructor Create;
destructor Destroy; override;
procedure AddHandler(AHandler: TNotifyEvent);
procedure RemoveHandler(AHandler: TNotifyEvent);
procedure RemoveHandler(AOwner: TObject);
procedure IncLock;
procedure DecLock;
procedure RestartCycle;
property DisplayCycle: Boolean read FDisplayCycle;
end;
TSynEditScreenCaret = class;
{ TSynEditScreenCaretPainter }
TSynEditScreenCaretPainter = class
private
FLeft, FTop, FHeight, FWidth: Integer;
function GetHandle: HWND;
function GetHandleAllocated: Boolean;
protected
FHandleOwner: TWinControl;
FOwner: TSynEditScreenCaret;
procedure Init; virtual;
property Handle: HWND read GetHandle;
property HandleAllocated: Boolean read GetHandleAllocated;
public
constructor Create(AHandleOwner: TWinControl);
function CreateCaret(w, h: Integer): Boolean; virtual; abstract;
constructor Create(AHandleOwner: TWinControl; AOwner: TSynEditScreenCaret);
function CreateCaret(w, h: Integer): Boolean; virtual;
function DestroyCaret: Boolean; virtual; abstract;
function HideCaret: Boolean; virtual; abstract;
function ShowCaret: Boolean; virtual; abstract;
function SetCaretPosEx(x, y: Integer): Boolean; virtual; abstract;
function SetCaretPosEx(x, y: Integer): Boolean; virtual;
property Left: Integer read FLeft;
property Top: Integer read FTop;
property Width: Integer read FWidth;
property Height: Integer read FHeight;
end;
TSynEditScreenCaretPainterClass = class of TSynEditScreenCaretPainter;
{ TSynEditScreenCaretPainterSystem }
TSynEditScreenCaretPainterSystem = class(TSynEditScreenCaretPainter)
@ -359,14 +411,14 @@ type
TSynEditScreenCaretPainterInternal = class(TSynEditScreenCaretPainter)
private
FTimer: TTimer;
FLeft, FTop, FHeight, FWidth: Integer;
FColor: TColor;
FIsDrawn: Boolean;
FShowing: Boolean;
FSavePen: TPen;
procedure DoTimer(Sender: TObject);
procedure Paint;
procedure SetColor(AValue: TColor);
protected
procedure Init; override;
public
@ -376,8 +428,13 @@ type
function HideCaret: Boolean; override;
function ShowCaret: Boolean; override;
function SetCaretPosEx(x, y: Integer): Boolean; override;
property Color: TColor read FColor write SetColor;
end;
// relative dimensions in percent from 0 to 1024 (=100%)
TSynCustomCaretSizeFlag = (ccsRelativeLeft, ccsRelativeTop, ccsRelativeWidth, ccsRelativeHeight);
TSynCustomCaretSizeFlags = set of TSynCustomCaretSizeFlag;
{ TSynEditScreenCaret }
TSynEditScreenCaret = class
@ -395,6 +452,8 @@ type
FVisible: Boolean;
FHandleOwner: TWinControl;
FCaretPainter: TSynEditScreenCaretPainter;
FPaintTimer: TSynEditScreenCaretTimer;
FPaintTimerOwned: Boolean;
function GetHandle: HWND;
function GetHandleAllocated: Boolean;
procedure SetCharHeight(const AValue: Integer);
@ -412,17 +471,19 @@ type
FOffsetX, FOffsetY: Integer;
FCustomPixelWidth, FCustomPixelHeight: Array [TSynCaretType] of Integer;
FCustomOffsetX, FCustomOffsetY: Array [TSynCaretType] of Integer;
FCustomFlags: Array [TSynCaretType] of TSynCustomCaretSizeFlags;
FCurrentPosX, FCurrentPosY: Integer;
FCurrentVisible, FCurrentCreated: Boolean;
FCurrentClippedWidth: Integer;
FLockCount: Integer;
FLockFlags: TSynCaretLockFlags;
function GetPaintTimer: TSynEditScreenCaretTimer;
procedure SetClipBottom(const AValue: Integer);
procedure SetClipExtraPixel(AValue: Integer);
procedure SetClipLeft(const AValue: Integer);
procedure SetClipRect(const AValue: TRect);
procedure SetClipTop(const AValue: Integer);
procedure CalcExtraLineChars;
procedure SetPaintTimer(AValue: TSynEditScreenCaretTimer);
procedure UpdateDisplayType;
procedure UpdateDisplay;
procedure ShowCaret;
@ -431,6 +492,8 @@ type
property HandleAllocated: Boolean read GetHandleAllocated;
public
constructor Create(AHandleOwner: TWinControl);
constructor Create(AHandleOwner: TWinControl; APainterClass: TSynEditScreenCaretPainterClass);
procedure ChangePainter(APainterClass: TSynEditScreenCaretPainterClass);
destructor Destroy; override;
procedure Hide; // Keep visible = true
procedure DestroyCaret(SkipHide: boolean = False);
@ -438,8 +501,11 @@ type
procedure UnLock;
procedure InvalidatePos;
procedure ResetCaretTypeSizes;
procedure SetCaretTypeSize(AType: TSynCaretType; AWidth, AHeight, AXOffs, AYOffs: Integer);
procedure SetCaretTypeSize(AType: TSynCaretType; AWidth, AHeight, AXOffs, AYOffs: Integer;
AFlags: TSynCustomCaretSizeFlags = []);
property HandleOwner: TWinControl read FHandleOwner;
property PaintTimer: TSynEditScreenCaretTimer read GetPaintTimer write SetPaintTimer;
property Painter: TSynEditScreenCaretPainter read FCaretPainter;
property CharWidth: Integer read FCharWidth write SetCharWidth;
property CharHeight: Integer read FCharHeight write SetCharHeight;
property ClipLeft: Integer read FClipLeft write SetClipLeft;
@ -458,86 +524,16 @@ type
implementation
{ TSynEditScreenCaretPainterInternal }
{ TSynBeforeSetSelTextList }
procedure TSynEditScreenCaretPainterInternal.DoTimer(Sender: TObject);
begin
if not FTimer.Enabled and FShowing then exit;
Paint;
end;
procedure TSynEditScreenCaretPainterInternal.Paint;
procedure TSynBeforeSetSelTextList.CallBeforeSetSelTextHandlers(Sender: TObject;
AMode: TSynSelectionMode; ANewText: PChar);
var
c: TCanvas;
i: Integer;
begin
FIsDrawn := not FIsDrawn;
c := TCustomControl(FHandleOwner).Canvas;
FSavePen.Assign(c.Pen);
c.MoveTo(FLeft, FTop);
c.Pen.Mode := pmNotXOR;
c.Pen.Style := psSolid;
c.Pen.Color := clBlack;
c.pen.EndCap := pecFlat;
c.pen.Width := FWidth;
c.LineTo(FLeft,FTop+FHeight);
c.Pen.Assign(FSavePen);
end;
procedure TSynEditScreenCaretPainterInternal.Init;
begin
FTimer := TTimer.Create(nil);
FTimer.Enabled := False;
FTimer.Interval := 500;
FTimer.OnTimer := @DoTimer;
FSavePen := TPen.Create;
inherited Init;
end;
destructor TSynEditScreenCaretPainterInternal.Destroy;
begin
FreeAndNil(FTimer);
FreeAndNil(FSavePen);
inherited Destroy;
end;
function TSynEditScreenCaretPainterInternal.CreateCaret(w, h: Integer): Boolean;
begin
FWidth := w;
FHeight := h;
end;
function TSynEditScreenCaretPainterInternal.DestroyCaret: Boolean;
begin
//
end;
function TSynEditScreenCaretPainterInternal.HideCaret: Boolean;
begin
FShowing := False;
FTimer.Enabled := False;
if FIsDrawn then Paint;
end;
function TSynEditScreenCaretPainterInternal.ShowCaret: Boolean;
begin
FShowing := True;
FTimer.Enabled := True;
if not FIsDrawn then Paint;
end;
function TSynEditScreenCaretPainterInternal.SetCaretPosEx(x, y: Integer): Boolean;
var
s: Boolean;
begin
s := FShowing;
HideCaret;
FLeft := x;
FTop := y;
if s then ShowCaret;
i:=Count;
while NextDownIndex(i) do
TSynBeforeSetSelTextEvent(Items[i])(Sender, AMode, ANewText);
end;
{ TSynEditBaseCaret }
@ -1360,6 +1356,7 @@ end;
constructor TSynEditSelection.Create(ALines : TSynEditStrings; aActOnLineChanges: Boolean);
begin
Inherited Create(ALines);
FOnBeforeSetSelText := TSynBeforeSetSelTextList.Create;
FInternalCaret := TSynEditBaseCaret.Create;
FInternalCaret.Lines := FLines;
@ -1381,6 +1378,7 @@ end;
destructor TSynEditSelection.Destroy;
begin
FreeAndNil(FOnBeforeSetSelText);
FreeAndNil(FInternalCaret);
if FHookedLines then begin
FLines.RemoveEditHandler(@DoLinesEdited);
@ -2013,6 +2011,7 @@ var
end;
begin
FOnBeforeSetSelText.CallBeforeSetSelTextHandlers(Self, PasteMode, Value);
FIsSettingText := True;
FStickyAutoExtend := False;
FLines.BeginUpdate; // Todo: can we get here, without paintlock?
@ -2357,6 +2356,113 @@ begin
StartLineBytePos := StartLineBytePos;
end;
procedure TSynEditSelection.AddBeforeSetSelTextHandler(AHandler: TSynBeforeSetSelTextEvent);
begin
FOnBeforeSetSelText.Add(TMethod(AHandler));
end;
procedure TSynEditSelection.RemoveBeforeSetSelTextHandler(AHandler: TSynBeforeSetSelTextEvent);
begin
FOnBeforeSetSelText.Remove(TMethod(AHandler));
end;
{ TSynEditScreenCaretTimer }
procedure TSynEditScreenCaretTimer.DoRestartCycle(Data: PtrInt);
begin
FAsyncQueued := False;
if FTimerList.Count = 0 then exit;
FTimer.Enabled := False;
FDisplayCycle := False;
DoTimer(nil);
FTimer.Enabled := True;
end;
procedure TSynEditScreenCaretTimer.DoTimer(Sender: TObject);
begin
if FAsyncQueued then begin
Application.RemoveAsyncCalls(Self);
FAsyncQueued := False;
end;
if FLocCount > 0 then begin
include(FLocFlags, lfTimer);
exit;
end;
FDisplayCycle := not FDisplayCycle;
FTimerList.CallNotifyEvents(Self);
end;
constructor TSynEditScreenCaretTimer.Create;
begin
FTimer := TTimer.Create(nil);
FTimer.Enabled := False;
FTimer.Interval := 500;
FTimer.OnTimer := @DoTimer;
FTimerList := TMethodList.Create;
end;
destructor TSynEditScreenCaretTimer.Destroy;
begin
Application.RemoveAsyncCalls(Self);
FreeAndNil(FTimer);
FreeAndNil(FTimerList);
inherited Destroy;
end;
procedure TSynEditScreenCaretTimer.AddHandler(AHandler: TNotifyEvent);
begin
FTimerList.Add(TMethod(AHandler));
if not FTimer.Enabled then
RestartCycle;
end;
procedure TSynEditScreenCaretTimer.RemoveHandler(AHandler: TNotifyEvent);
begin
FTimerList.Remove(TMethod(AHandler));
if FTimerList.Count = 0 then
FTimer.Enabled := False;
end;
procedure TSynEditScreenCaretTimer.RemoveHandler(AOwner: TObject);
begin
FTimerList.RemoveAllMethodsOfObject(AOwner);
if FTimerList.Count = 0 then FTimer.Enabled := False;
end;
procedure TSynEditScreenCaretTimer.IncLock;
begin
inc(FLocCount);
end;
procedure TSynEditScreenCaretTimer.DecLock;
begin
if FLocCount > 0 then
dec(FLocCount);
if FLocCount > 0 then
exit;
if lfRestart in FLocFlags then
RestartCycle
else;
if lfTimer in FLocFlags then
DoTimer(nil);
FLocFlags := [];
end;
procedure TSynEditScreenCaretTimer.RestartCycle;
begin
if FLocCount > 0 then begin
include(FLocFlags, lfRestart);
exit;
end;
if FTimerList.Count = 0 then exit;
FTimer.Enabled := False;
FDisplayCycle := True; // if anything paint before
FAsyncQueued := True;
Application.QueueAsyncCall(@DoRestartCycle, 0); // only needed if in paint
end;
{ TSynEditScreenCaretPainter }
function TSynEditScreenCaretPainter.GetHandle: HWND;
@ -2364,22 +2470,45 @@ begin
Result := FHandleOwner.Handle;
end;
function TSynEditScreenCaretPainter.GetHandleAllocated: Boolean;
begin
Result := FHandleOwner.HandleAllocated;
end;
procedure TSynEditScreenCaretPainter.Init;
begin
//
end;
constructor TSynEditScreenCaretPainter.Create(AHandleOwner: TWinControl);
constructor TSynEditScreenCaretPainter.Create(AHandleOwner: TWinControl;
AOwner: TSynEditScreenCaret);
begin
inherited Create;
FHandleOwner := AHandleOwner;
FOwner := AOwner;
Init;
end;
function TSynEditScreenCaretPainter.CreateCaret(w, h: Integer): Boolean;
begin
FWidth := w;
FHeight := h;
Result := True;
end;
function TSynEditScreenCaretPainter.SetCaretPosEx(x, y: Integer): Boolean;
begin
FLeft := x;
FTop := y;
Result := True;
end;
{ TSynEditScreenCaretPainterSystem }
function TSynEditScreenCaretPainterSystem.CreateCaret(w, h: Integer): Boolean;
begin
inherited CreateCaret(w, h);
inherited SetCaretPosEx(-1, -1);
Result := LCLIntf.CreateCaret(Handle, 0, w, h);
end;
@ -2400,15 +2529,130 @@ end;
function TSynEditScreenCaretPainterSystem.SetCaretPosEx(x, y: Integer): Boolean;
begin
inherited SetCaretPosEx(x, y);
Result := LCLIntf.SetCaretPosEx(Handle, x, y);
end;
{ TSynEditScreenCaretPainterInternal }
procedure TSynEditScreenCaretPainterInternal.DoTimer(Sender: TObject);
begin
if not FShowing then exit;
if FIsDrawn <> FOwner.PaintTimer.DisplayCycle then
Paint;
end;
procedure TSynEditScreenCaretPainterInternal.Paint;
var
c: TCanvas;
l: Integer;
begin
if not HandleAllocated then begin
FIsDrawn := False;
exit;
end;
FIsDrawn := not FIsDrawn;
c := TCustomControl(FHandleOwner).Canvas;
FSavePen.Assign(c.Pen);
l := Left + Width div 2;
c.MoveTo(l, Top);
c.Pen.Mode := pmNotXOR;
c.Pen.Style := psSolid;
c.Pen.Color := FColor;
c.pen.EndCap := pecFlat;
c.pen.Width := Width;
c.LineTo(l, Top+Height);
c.Pen.Assign(FSavePen);
end;
procedure TSynEditScreenCaretPainterInternal.SetColor(AValue: TColor);
var
d: Boolean;
begin
if FColor = AValue then Exit;
d := FIsDrawn;
if FIsDrawn then Paint;
FColor := AValue;
if d then Paint;
end;
procedure TSynEditScreenCaretPainterInternal.Init;
begin
FSavePen := TPen.Create;
FColor := clBlack;
inherited Init;
end;
destructor TSynEditScreenCaretPainterInternal.Destroy;
begin
if FOwner.PaintTimer <> nil then begin // In case this runs in finalization
FOwner.PaintTimer.RemoveHandler(Self);
HideCaret;
end;
FreeAndNil(FSavePen);
inherited Destroy;
end;
function TSynEditScreenCaretPainterInternal.CreateCaret(w, h: Integer): Boolean;
begin
DestroyCaret;
Result := inherited CreateCaret(w, h);
Result := True;
end;
function TSynEditScreenCaretPainterInternal.DestroyCaret: Boolean;
begin
HideCaret;
Result := True;
end;
function TSynEditScreenCaretPainterInternal.HideCaret: Boolean;
begin
FShowing := False;
FOwner.PaintTimer.RemoveHandler(@DoTimer);
if FIsDrawn then Paint;
Result := True;
end;
function TSynEditScreenCaretPainterInternal.ShowCaret: Boolean;
begin
if FShowing then exit;
FShowing := True;
FOwner.PaintTimer.AddHandler(@DoTimer);
FOwner.PaintTimer.RestartCycle;
//if FIsDrawn <> FOwner.PaintTimer.DisplayCycle then
// Paint;
//if not FIsDrawn then Paint;
Result := True;
end;
function TSynEditScreenCaretPainterInternal.SetCaretPosEx(x, y: Integer): Boolean;
var
s: Boolean;
begin
s := FShowing;
HideCaret;
inherited SetCaretPosEx(x, y);
if s then ShowCaret;
Result := True;
end;
{ TSynEditScreenCaret }
constructor TSynEditScreenCaret.Create(AHandleOwner: TWinControl);
begin
Create(AHandleOwner, TSynEditScreenCaretPainterSystem);
end;
constructor TSynEditScreenCaret.Create(AHandleOwner: TWinControl;
APainterClass: TSynEditScreenCaretPainterClass);
begin
inherited Create;
FCaretPainter := TSynEditScreenCaretPainterSystem.Create(AHandleOwner);
FCaretPainter := APainterClass.Create(AHandleOwner, Self);
FLockCount := -1;
ResetCaretTypeSizes;
FHandleOwner := AHandleOwner;
@ -2417,15 +2661,24 @@ begin
FCurrentCreated := False;
FCurrentPosX := -1;
FCurrentPosY := -1;
FCurrentClippedWidth := -1;
FClipExtraPixel := 0;
FLockCount := 0;
end;
procedure TSynEditScreenCaret.ChangePainter(APainterClass: TSynEditScreenCaretPainterClass);
begin
DestroyCaret;
FreeAndNil(FCaretPainter);
FCaretPainter := APainterClass.Create(FHandleOwner, Self);
UpdateDisplay;
end;
destructor TSynEditScreenCaret.Destroy;
begin
DestroyCaret;
FreeAndNil(FCaretPainter);
if FPaintTimerOwned then
FreeAndNil(FPaintTimer);
inherited Destroy;
end;
@ -2451,6 +2704,8 @@ end;
procedure TSynEditScreenCaret.Lock;
begin
inc(FLockCount);
if FPaintTimer <> nil then
FPaintTimer.IncLock;
end;
procedure TSynEditScreenCaret.UnLock;
@ -2460,6 +2715,8 @@ begin
if (sclfUpdateDisplayType in FLockFlags) then UpdateDisplayType;
if (sclfUpdateDisplay in FLockFlags) then UpdateDisplay;
end;
if FPaintTimer <> nil then
FPaintTimer.DecLock;
end;
procedure TSynEditScreenCaret.InvalidatePos;
@ -2479,12 +2736,13 @@ begin
end;
procedure TSynEditScreenCaret.SetCaretTypeSize(AType: TSynCaretType; AWidth, AHeight, AXOffs,
AYOffs: Integer);
AYOffs: Integer; AFlags: TSynCustomCaretSizeFlags);
begin
FCustomPixelWidth[AType] := AWidth;
FCustomPixelHeight[AType] := AHeight;
FCustomOffsetX[AType] := AXOffs;
FCustomOffsetY[AType] := AYOffs;
FCustomFlags[AType] := AFlags;
if FDisplayType = AType then UpdateDisplayType;
end;
@ -2587,13 +2845,21 @@ begin
end;
if (FCustomPixelWidth[FDisplayType] <> 0) then begin
FPixelWidth := FCustomPixelWidth[FDisplayType];
FOffsetX := FCustomOffsetX[FDisplayType];
if ccsRelativeWidth in FCustomFlags[FDisplayType]
then FPixelWidth := FCharWidth * FCustomPixelWidth[FDisplayType] div 1024
else FPixelWidth := FCustomPixelWidth[FDisplayType];
if ccsRelativeLeft in FCustomFlags[FDisplayType]
then FOffsetX := FCharWidth * FCustomOffsetX[FDisplayType] div 1024
else FOffsetX := FCustomOffsetX[FDisplayType];
FExtraLinePixel := Max(0, FPixelWidth + FOffsetX);
end;
if (FCustomPixelHeight[FDisplayType] <> 0) then begin
FPixelHeight := FCustomPixelHeight[FDisplayType];
FOffsetY := FCustomOffsetY[FDisplayType];
if ccsRelativeHeight in FCustomFlags[FDisplayType]
then FPixelHeight := FCharHeight * FCustomPixelHeight[FDisplayType] div 1024
else FPixelHeight := FCustomPixelHeight[FDisplayType];
if ccsRelativeTop in FCustomFlags[FDisplayType]
then FOffsetY := FCharHeight * FCustomOffsetY[FDisplayType] div 1024
else FOffsetY := FCustomOffsetY[FDisplayType];
end;
CalcExtraLineChars;
@ -2608,6 +2874,16 @@ begin
UpdateDisplay;
end;
function TSynEditScreenCaret.GetPaintTimer: TSynEditScreenCaretTimer;
begin
if FPaintTimer = nil then begin
FPaintTimer := TSynEditScreenCaretTimer.Create;
FPaintTimerOwned := True;
FPaintTimer.FLocCount := FLockCount;
end;
Result := FPaintTimer;
end;
procedure TSynEditScreenCaret.SetClipExtraPixel(AValue: Integer);
begin
if FClipExtraPixel = AValue then Exit;
@ -2654,6 +2930,7 @@ procedure TSynEditScreenCaret.CalcExtraLineChars;
var
OldExtraChars: Integer;
begin
if FCharWidth = 0 then exit;
OldExtraChars := FExtraLineChars;
FExtraLineChars := Max(0, FExtraLinePixel - FClipExtraPixel + FCharWidth - 1)
div FCharWidth;
@ -2661,6 +2938,13 @@ begin
FOnExtraLineCharsChanged(Self);
end;
procedure TSynEditScreenCaret.SetPaintTimer(AValue: TSynEditScreenCaretTimer);
begin
assert(FPaintTimer = nil, 'TSynEditScreenCaret.SetPaintTimer: FPaintTimer = nil');
if FPaintTimer = nil then
FPaintTimer := AValue;
end;
procedure TSynEditScreenCaret.UpdateDisplay;
begin
if FLockCount > 0 then begin
@ -2690,13 +2974,13 @@ begin
if x < FClipLeft then begin
w := w - (FClipLeft - w);
x := FClipLeft;
end;
end;
if y + h >= FClipBottom then
h := FClipBottom - y - 1;
if y < FClipTop then begin
h := h - (FClipTop - y);
y := FClipTop;
end;
end;
if (w <= 0) or (h < 0) or
(x < FClipLeft) or (x >= FClipRight) or
(y < FClipTop) or (y >= FClipBottom)
@ -2705,7 +2989,7 @@ begin
exit;
end;
if (not FCurrentCreated) or (FCurrentClippedWidth <> w) then begin
if (not FCurrentCreated) or (FCaretPainter.Width <> w) or (FCaretPainter.Height <> h) then begin
{$IFDeF SynCaretDebug}
debugln(['SynEditCaret CreateCaret for HandleOwner=',FHandleOwner, ' DebugShowCount=', FDebugShowCount, ' Width=', w, ' pref-width=', FPixelWidth, ' Height=', FPixelHeight, ' FCurrentCreated=',FCurrentCreated, ' FCurrentVisible=',FCurrentVisible]);
FDebugShowCount := 0;
@ -2716,7 +3000,6 @@ begin
FCaretPainter.CreateCaret(w, h);
FCurrentCreated := True;
FCurrentVisible := False;
FCurrentClippedWidth := w;
FCurrentPosX := x - 1;
SetCaretRespondToFocus(Handle, False); // Only for GTK
end;

2
components/synedit/synedittextbuffer.pp
View File

@ -1231,6 +1231,7 @@ procedure TSynEditStringList.SetUpdateState(Updating: Boolean; Sender: TObject);
begin
if FIsInDecPaintLock then exit;
if Updating then begin
SendNotification(senrBeforeIncPaintLock, Sender);
SendNotification(senrIncPaintLock, Sender); // DoIncPaintLock
SendNotification(senrAfterIncPaintLock, Sender);
FCachedNotify := False;
@ -1245,6 +1246,7 @@ begin
try
SendNotification(senrBeforeDecPaintLock, Sender);
SendNotification(senrDecPaintLock, Sender); // DoDecPaintLock
SendNotification(senrAfterDecPaintLock, Sender);
finally
FIsInDecPaintLock := False;
end;

12
components/synedit/synedittypes.pp
View File

@ -91,12 +91,22 @@ type
TSynStatusChange = (scCaretX, scCaretY,
scLeftChar, scTopLine, scLinesInWindow, scCharsInWindow,
scInsertMode, scModified, scSelection, scReadOnly
scInsertMode, scModified, scSelection, scReadOnly,
scFocus, // received or lost focus
scOptions // some Options were changed (only triggered by some optinos)
);
TSynStatusChanges = set of TSynStatusChange;
TStatusChangeEvent = procedure(Sender: TObject; Changes: TSynStatusChanges)
of object;
TSynPaintEvent = (
peBeforePaint, peAfterPaint,
peBeforePaintCanvas, peAfterPaintCanvas, // before the double buffer canvas is assigned
peBeforeScroll, peAfterScroll
);
TSynPaintEvents = set of TSynPaintEvent;
TSynPaintEventProc = procedure(Sender: TObject; Changes: TSynPaintEvents) of object;
TSynVisibleSpecialChar = (vscSpace, vscTabAtFirst, vscTabAtLast);
TSynVisibleSpecialChars = set of TSynVisibleSpecialChar;

1345
components/synedit/synpluginmulticaret.pp Normal file
View File

File diff suppressed because it is too large Load Diff

451
components/synedit/test/testmulticaret.pas Normal file
View File

@ -0,0 +1,451 @@
unit TestMultiCaret;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, TestBase, SynEditKeyCmds, SynPluginMultiCaret, SynEdit, Clipbrd,
testregistry;
type
TSynPluginMultiCaretTest = class(TSynPluginMultiCaret)
public
property Carets;
end;
{ TTestMultiCaret }
TTestMultiCaret = class(TTestBase)
protected
FMultiCaret: TSynPluginMultiCaretTest;
public
procedure ReCreateEdit; reintroduce;
procedure RunCmdSeq(cmds: Array of TSynEditorCommand; chars: array of String);
published
procedure Edit;
procedure ReplaceColSel;
procedure TabKey;
procedure Paste;
end;
implementation
{ TTestMultiCaret }
procedure TTestMultiCaret.ReCreateEdit;
begin
inherited;
FMultiCaret := TSynPluginMultiCaretTest.Create(SynEdit);
SynEdit.BlockIndent := 2;
SynEdit.BlockTabIndent := 0;
SynEdit.TabWidth := 4;
end;
procedure TTestMultiCaret.RunCmdSeq(cmds: array of TSynEditorCommand; chars: array of String);
var
i, j: Integer;
a: String;
begin
j := 0;
for i := 0 to high(cmds) do begin
a := '';
if (cmds[i] = ecChar) and (j <= high(chars)) then begin
a := chars[j];
inc(j);
end;
SynEdit.CommandProcessor(cmds[i], a, nil);
end;
end;
procedure TTestMultiCaret.Edit;
function TestText1: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1';
Result[1] := '2';
Result[2] := '3';
Result[3] := '4';
Result[4] := '5';
Result[5] := '6';
Result[6] := '7';
Result[7] := '';
end;
function TestText1A: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1';
Result[1] := 'A2';
Result[2] := 'A3';
Result[3] := 'A4';
Result[4] := 'A5';
Result[5] := 'A6';
Result[6] := '7';
Result[7] := '';
end;
function TestText1Del: TStringArray;
begin
SetLength(Result, 3);
Result[0] := '123456';
Result[1] := '7';
Result[2] := '';
end;
begin
ReCreateEdit;
SetLines(TestText1);
SetCaret(1,2);
RunCmdSeq([ecColSelDown, ecColSelDown, ecColSelDown, ecColSelDown], []);
TestIsFullText('', TestText1);
TestIsCaret('', 1,6);
RunCmdSeq([ecChar], ['A']);
TestIsFullText('', TestText1A);
TestIsCaret('', 2,6);
RunCmdSeq([ecDeleteLastChar], []);
TestIsFullText('', TestText1);
TestIsCaret('', 1,6);
// 4 extra carets + main caret
AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
RunCmdSeq([ecDeleteLastChar], []);
TestIsFullText('', TestText1Del);
TestIsCaret('', 6,1);
// 4 extra carets + main caret
AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
RunCmdSeq([ecDeleteLastChar], []);
TestIsFullText('', TestText1Del, [1, '6']);
TestIsCaret('', 1,1);
// NO extra carets
AssertEquals(BaseTestName+'', 0, FMultiCaret.Carets.Count);
end;
procedure TTestMultiCaret.ReplaceColSel;
function TestText1: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1aA';
Result[1] := '2bB';
Result[2] := '3cC';
Result[3] := '4dD';
Result[4] := '5eE';
Result[5] := '6fF';
Result[6] := '7gG';
Result[7] := '';
end;
function TestText1X: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1aA';
Result[1] := '2XB';
Result[2] := '3XC';
Result[3] := '4XD';
Result[4] := '5XE';
Result[5] := '6XF';
Result[6] := '7gG';
Result[7] := '';
end;
begin
ReCreateEdit;
SetLines(TestText1);
SetCaret(2,2);
RunCmdSeq([ecColSelDown, ecColSelDown, ecColSelDown, ecColSelDown, ecColSelRight], []);
TestIsFullText('', TestText1);
TestIsCaret('', 3,6);
RunCmdSeq([ecChar], ['X']);
TestIsFullText('', TestText1X);
TestIsCaret('', 3,6);
// 4 extra carets + main caret
AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
end;
procedure TTestMultiCaret.TabKey;
function TestText1: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1a';
Result[1] := '2b';
Result[2] := '3c';
Result[3] := '4d';
Result[4] := '5e';
Result[5] := '6f';
Result[6] := '7g';
Result[7] := '';
end;
function TestText1Tab: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1a';
Result[1] := '2'#9'b';
Result[2] := '3'#9'c';
Result[3] := '4'#9'd';
Result[4] := '5'#9'e';
Result[5] := '6'#9'f';
Result[6] := '7g';
Result[7] := '';
end;
function TestText1Indent: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1a';
Result[1] := ' 2b';
Result[2] := ' 3c';
Result[3] := ' 4d';
Result[4] := ' 5e';
Result[5] := ' 6f';
Result[6] := '7g';
Result[7] := '';
end;
function TestText1IndentX: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1a';
Result[1] := ' 2b';
Result[2] := ' 3c';
Result[3] := ' 4d';
Result[4] := ' 5e';
Result[5] := ' 6f';
Result[6] := '7g';
Result[7] := '';
end;
function TestText1TabOver: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1a';
Result[1] := '2'#9;
Result[2] := '3'#9;
Result[3] := '4'#9;
Result[4] := '5'#9;
Result[5] := '6'#9;
Result[6] := '7g';
Result[7] := '';
end;
begin
PushBaseName('ZERO width selection -- WITH eoTabIndent');
ReCreateEdit;
SynEdit.Options := SynEdit.Options + [eoTabIndent] - [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
SetLines(TestText1);
SetCaret(2,2);
RunCmdSeq([ecColSelDown, ecColSelDown, ecColSelDown, ecColSelDown], []);
TestIsFullText('', TestText1);
TestIsCaret('', 2,6);
RunCmdSeq([ecTab], []);
TestIsFullText('', TestText1Tab);
TestIsCaret('', 3,6);
// 4 extra carets + main caret
AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
PopPushBaseName('ONE width selection -- WITH eoTabIndent');
ReCreateEdit;
SynEdit.Options := SynEdit.Options + [eoTabIndent] - [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
SetLines(TestText1);
SetCaret(2,2);
RunCmdSeq([ecColSelDown, ecColSelDown, ecColSelDown, ecColSelDown, ecColSelRight], []);
TestIsFullText('', TestText1);
TestIsCaret('', 3,6);
RunCmdSeq([ecTab], []);
TestIsFullText('', TestText1TabOver);
TestIsCaret('', 3,6);
// 4 extra carets + main caret
AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
PopPushBaseName('ZERO width selection -- WITHOUT eoTabIndent');
ReCreateEdit;
SynEdit.Options := SynEdit.Options - [eoTabIndent] - [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
SetLines(TestText1);
SetCaret(2,2);
RunCmdSeq([ecColSelDown, ecColSelDown, ecColSelDown, ecColSelDown], []);
TestIsFullText('', TestText1);
TestIsCaret('', 2,6);
RunCmdSeq([ecTab], []);
TestIsFullText('', TestText1Tab);
TestIsCaret('', 3,6);
// 4 extra carets + main caret
AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
PopPushBaseName('ONE width selection -- WITHOUT eoTabIndent');
ReCreateEdit;
SynEdit.Options := SynEdit.Options - [eoTabIndent] - [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
SetLines(TestText1);
SetCaret(2,2);
RunCmdSeq([ecColSelDown, ecColSelDown, ecColSelDown, ecColSelDown, ecColSelRight], []);
TestIsFullText('', TestText1);
TestIsCaret('', 3,6);
RunCmdSeq([ecTab], []);
TestIsFullText('', TestText1TabOver);
TestIsCaret('', 3,6);
// 4 extra carets + main caret
AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
PopBaseName;
end;
procedure TTestMultiCaret.Paste;
function TestText1: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1a';
Result[1] := '2b';
Result[2] := '3c';
Result[3] := '4d';
Result[4] := '5e';
Result[5] := '6f';
Result[6] := '7g';
Result[7] := '';
end;
function TestText1PasteNorm: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1a';
Result[1] := '21ab';
Result[2] := '31ac';
Result[3] := '41ad';
Result[4] := '51ae';
Result[5] := '61af';
Result[6] := '7g';
Result[7] := '';
end;
function TestText1PasteNormOver: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1a';
Result[1] := '21a';
Result[2] := '31a';
Result[3] := '41a';
Result[4] := '51a';
Result[5] := '61a';
Result[6] := '7g';
Result[7] := '';
end;
function TestText1PasteCol: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1a';
Result[1] := '2b';
Result[2] := '3c';
Result[3] := '4d';
Result[4] := '5e';
Result[5] := '61f';
Result[6] := '72g';
Result[7] := '';
end;
function TestText1PasteColOver: TStringArray;
begin
SetLength(Result, 8);
Result[0] := '1a';
Result[1] := '21';
Result[2] := '32';
Result[3] := '4';
Result[4] := '5';
Result[5] := '6';
Result[6] := '7g';
Result[7] := '';
end;
begin
PushBaseName('ZERO width selection -- paste normal');
ReCreateEdit;
SynEdit.Options := SynEdit.Options + [eoTabIndent] - [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
SetLines(TestText1);
SetCaret(1,1);
RunCmdSeq([ecSelRight, ecSelRight, ecCopy], []); // copy
SetCaret(2,2);
RunCmdSeq([ecColSelDown, ecColSelDown, ecColSelDown, ecColSelDown], []);
TestIsFullText('', TestText1);
TestIsCaret('', 2,6);
RunCmdSeq([ecPaste], []);
TestIsFullText('', TestText1PasteNorm);
TestIsCaret('', 4,6);
// 4 extra carets + main caret
AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
PopPushBaseName('ONE width selection -- paste normal');
ReCreateEdit;
SynEdit.Options := SynEdit.Options + [eoTabIndent] - [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
SetLines(TestText1);
SetCaret(1,1);
RunCmdSeq([ecSelRight, ecSelRight, ecCopy], []); // copy
SetCaret(2,2);
RunCmdSeq([ecColSelDown, ecColSelDown, ecColSelDown, ecColSelDown, ecColSelRight], []);
TestIsFullText('', TestText1);
TestIsCaret('', 3,6);
RunCmdSeq([ecPaste], []);
TestIsFullText('', TestText1PasteNormOver);
TestIsCaret('', 4,6);
// 4 extra carets + main caret
AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
PushBaseName('ZERO width selection -- paste column');
ReCreateEdit;
SynEdit.Options := SynEdit.Options + [eoTabIndent] - [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
SetLines(TestText1);
SetCaret(1,1);
RunCmdSeq([ecColSelDown, ecColSelRight, ecCopy], []); // copy
SetCaret(2,2);
RunCmdSeq([ecColSelDown, ecColSelDown, ecColSelDown, ecColSelDown], []);
TestIsFullText('', TestText1);
TestIsCaret('', 2,6);
RunCmdSeq([ecPaste], []);
TestIsFullText('', TestText1PasteCol);
TestIsCaret('', 3,7);
AssertEquals(BaseTestName+'', 0, FMultiCaret.Carets.Count);
PopPushBaseName('ONE width selection -- paste column');
ReCreateEdit;
SynEdit.Options := SynEdit.Options + [eoTabIndent] - [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
SetLines(TestText1);
SetCaret(1,1);
RunCmdSeq([ecColSelDown, ecColSelRight, ecCopy], []); // copy
SetCaret(2,2);
RunCmdSeq([ecColSelDown, ecColSelDown, ecColSelDown, ecColSelDown, ecColSelRight], []);
TestIsFullText('', TestText1);
TestIsCaret('', 3,6);
RunCmdSeq([ecPaste], []);
TestIsFullText('', TestText1PasteColOver);
TestIsCaret('', 3,3);
AssertEquals(BaseTestName+'', 0, FMultiCaret.Carets.Count);
end;
initialization
RegisterTest(TTestMultiCaret);
end.

10
ide/sourcesyneditor.pas
View File

@ -56,7 +56,7 @@ uses
SynEditTextBuffer, SynEditFoldedView, SynTextDrawer, SynEditTextBase, LazSynEditText,
SynPluginTemplateEdit, SynPluginSyncroEdit, LazSynTextArea, SynEditHighlighter,
SynEditHighlighterFoldBase, SynHighlighterPas, SynEditMarkupHighAll, SynEditKeyCmds,
SynEditMarkupIfDef, SynEditMiscProcs,
SynEditMarkupIfDef, SynEditMiscProcs, SynPluginMultiCaret, SynEditPointClasses,
etSrcEditMarks, LazarusIDEStrConsts;
type
@ -216,6 +216,7 @@ type
FShowTopInfo: boolean;
FSyncroEdit: TSynPluginSyncroEdit;
FTemplateEdit: TSynPluginTemplateEdit;
FMultiCaret: TSynPluginMultiCaret;
FMarkupForGutterMark: TSynEditMarkupGutterMark;
FOnIfdefNodeStateRequest: TSynMarkupIfdefStateRequest;
FMarkupIfDef: TSourceSynEditMarkupIfDef;
@ -254,6 +255,7 @@ type
property ViewedTextBuffer;
property TemplateEdit: TSynPluginTemplateEdit read FTemplateEdit;
property SyncroEdit: TSynPluginSyncroEdit read FSyncroEdit;
property MultiCaret: TSynPluginMultiCaret read FMultiCaret;
//////
property TopInfoMarkup: TSynSelectedColor read FTopInfoMarkup write SetTopInfoMarkup;
property ShowTopInfo: boolean read FShowTopInfo write SetShowTopInfo;
@ -1608,6 +1610,12 @@ begin
FUserWordsList := TFPList.Create;
FTemplateEdit:=TSynPluginTemplateEdit.Create(Self);
FSyncroEdit := TSynPluginSyncroEdit.Create(Self);
{$IFDEF WithSynMultiCaret}
FMultiCaret := TSynPluginMultiCaret.Create(Self);
FMultiCaret.SetCaretTypeSize(ctVerticalLine, 2, 1024, -1, 0, [ccsRelativeHeight]);
FMultiCaret.SetCaretTypeSize(ctBlock, 1024, 1024, 0, 0, [ccsRelativeWidth, ccsRelativeHeight]);
FMultiCaret.Color := $606060;
{$ENDIF}
FMarkupForGutterMark := TSynEditMarkupGutterMark.Create(Self, FWordBreaker);
TSynEditMarkupManager(MarkupMgr).AddMarkUp(FMarkupForGutterMark);