lazarus/components/synedit/syneditpointclasses.pas

1369 lines
41 KiB
ObjectPascal

{-------------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.
Alternatively, the contents of this file may be used under the terms of the
GNU General Public License Version 2 or later (the "GPL"), in which case
the provisions of the GPL are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms
of the GPL and not to allow others to use your version of this file
under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the GPL.
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
(* Naming Conventions:
Byte = Logical: Refers to the location any TextToken has in the String.
In Utf8String some TextToken can have more than one byte
Char = Physical: Refers to the (x-)location on the screen matrix.
Some TextToken (like tab) can spawn multiply char locations
*)
unit SynEditPointClasses;
{$I synedit.inc}
interface
uses
Classes, SysUtils, LCLProc,
{$IFDEF SYN_MBCSSUPPORT}
Imm,
{$ENDIF}
SynEditTextBase, SynEditTypes, SynEditMiscProcs;//, SynEditTextBuffer;
type
TInvalidateLines = procedure(FirstLine, LastLine: integer) of Object;
TLinesCountChanged = procedure(FirstLine, Count: integer) of Object;
{ TSynEditPointBase }
TSynEditPointBase = class
private
function GetLocked: Boolean;
protected
FLines: TSynEditStrings;
FOnChangeList: TMethodList;
FLockCount: Integer;
procedure DoLock; virtual;
Procedure DoUnlock; virtual;
public
constructor Create;
constructor Create(Lines: TSynEditStrings);
destructor Destroy; override;
procedure AddChangeHandler(AHandler: TNotifyEvent);
procedure RemoveChangeHandler(AHandler: TNotifyEvent);
procedure Lock;
Procedure Unlock;
property Lines: TSynEditStrings read FLines write FLines;
property Locked: Boolean read GetLocked;
end;
TSynEditCaret = class;
{ TSynEditSelection }
TSynEditSelection = class(TSynEditPointBase)
private
FAutoExtend: Boolean;
FCaret: TSynEditCaret;
FHide: Boolean;
FInternalCaret: TSynEditCaret;
fUndoList: TSynEditUndoList;
FInvalidateLinesMethod: TInvalidateLines;
FEnabled: Boolean;
FHookedLines: Boolean;
FIsSettingText: Boolean;
FActiveSelectionMode: TSynSelectionMode;
FSelectionMode: TSynSelectionMode;
FStartLinePos: Integer; // 1 based
FStartBytePos: Integer; // 1 based
FEndLinePos: Integer; // 1 based
FEndBytePos: Integer; // 1 based
FPersistent: Boolean;
FPersistentLock: Integer;
FIgnoreNextCaretMove: Boolean;
(* On any modification, remember the position of the caret.
If it gets moved from there to either end of the block, this should be ignored
This happens, if Block and caret are adjusted directly
*)
FLastCarePos: TPoint;
function AdjustBytePosToCharacterStart(Line: integer; BytePos: integer): integer;
function GetFirstLineBytePos: TPoint;
function GetLastLineBytePos: TPoint;
procedure SetCaret(const AValue: TSynEditCaret);
procedure SetEnabled(const Value : Boolean);
procedure SetActiveSelectionMode(const Value: TSynSelectionMode);
procedure SetHide(const AValue: Boolean);
procedure SetPersistent(const AValue: Boolean);
procedure SetSelectionMode (const AValue: TSynSelectionMode);
function GetStartLineBytePos: TPoint;
procedure SetStartLineBytePos(Value: TPoint);
procedure AdjustStartLineBytePos(Value: TPoint);
function GetEndLineBytePos: TPoint;
procedure SetEndLineBytePos(Value: TPoint);
function GetSelText: string;
procedure SetSelText(const Value: string);
procedure DoCaretChanged(Sender: TObject);
procedure AdjustAfterTrimming; // TODO: Move into TrimView?
protected
Procedure LineChanged(Sender: TSynEditStrings; AIndex, ACount : Integer);
procedure DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
aLineBrkCnt: Integer; aText: String);
public
constructor Create(ALines: TSynEditStrings; aActOnLineChanges: Boolean);
destructor Destroy; override;
procedure AssignFrom(Src: TSynEditSelection);
procedure SetSelTextPrimitive(PasteMode: TSynSelectionMode; Value: PChar);
function SelAvail: Boolean;
function SelCanContinue(ACaret: TSynEditCaret): Boolean;
function IsBackwardSel: Boolean; // SelStart < SelEnd ?
procedure SortSelectionPoints;
procedure IgnoreNextCaretMove;
procedure IncPersistentLock;
procedure DecPersistentLock;
procedure Clear;
property Enabled: Boolean read FEnabled write SetEnabled;
property ActiveSelectionMode: TSynSelectionMode
read FActiveSelectionMode write SetActiveSelectionMode;
property SelectionMode: TSynSelectionMode
read FSelectionMode write SetSelectionMode;
property SelText: String read GetSelText write SetSelText;
// Start and End positions are in the order they where defined
// This may mean Startpos is behind EndPos in the text
property StartLineBytePos: TPoint
read GetStartLineBytePos write SetStartLineBytePos;
property StartLineBytePosAdjusted: TPoint
write AdjustStartLineBytePos;
property EndLineBytePos: TPoint
read GetEndLineBytePos write SetEndLineBytePos;
property StartLinePos: Integer read FStartLinePos;
property EndLinePos: Integer read FEndLinePos;
property StartBytePos: Integer read FStartBytePos;
property EndBytePos: Integer read FEndBytePos;
// First and Last Pos are ordered according to the text flow (LTR)
property FirstLineBytePos: TPoint read GetFirstLineBytePos;
property LastLineBytePos: TPoint read GetLastLineBytePos;
property InvalidateLinesMethod : TInvalidateLines write FInvalidateLinesMethod;
property Caret: TSynEditCaret read FCaret write SetCaret;
property UndoList: TSynEditUndoList read fUndoList write fUndoList;
property Persistent: Boolean read FPersistent write SetPersistent;
// automatically Start/Exctend selection if caret moves
// (depends if caret was at block border or not)
property AutoExtend: Boolean read FAutoExtend write FAutoExtend;
property Hide: Boolean read FHide write SetHide;
end;
{ TSynEditCaret }
TSynEditCaret = class(TSynEditPointBase)
private
FAllowPastEOL: Boolean;
FForcePastEOL: Integer;
FForceAdjustToNextChar: Integer;
FKeepCaretX: Boolean;
FLinePos: Integer; // 1 based
FCharPos: Integer; // 1 based
FLastCharPos: Integer; // used by KeepCaretX
FOldLinePos: Integer; // 1 based
FOldCharPos: Integer; // 1 based
FAdjustToNextChar: Boolean;
FMaxLeftChar: PInteger;
FChangeOnTouch: Boolean;
FTouched: Boolean;
procedure AdjustToChar;
procedure InternalSetLineCharPos(NewLine, NewCharPos: Integer;
KeepLastCharPos: Boolean = False;
ForceSet: Boolean = False);
procedure setCharPos(const AValue: Integer);
procedure SetAllowPastEOL(const AValue: Boolean);
procedure SetKeepCaretX(const AValue: Boolean);
procedure setLinePos(const AValue: Integer);
function GetLineCharPos: TPoint;
procedure SetLineCharPos(AValue: TPoint);
function GetBytePos: Integer;
procedure SetBytePos(const AValue: Integer);
function GetLineBytePos: TPoint;
procedure SetLineBytePos(const AValue: TPoint);
function GetLineText: string;
procedure SetLineText(const AValue : string);
protected
procedure DoLock; override;
Procedure DoUnlock; override;
public
constructor Create;
procedure AssignFrom(Src: TSynEditCaret);
procedure IncForcePastEOL;
procedure DecForcePastEOL;
procedure IncForceAdjustToNextChar;
procedure DecForceAdjustToNextChar;
procedure ChangeOnTouch;
function IsAtLineChar(aPoint: TPoint): Boolean;
function IsAtLineByte(aPoint: TPoint): Boolean;
function WasAtLineChar(aPoint: TPoint): Boolean;
function WasAtLineByte(aPoint: TPoint): Boolean;
function IsAtPos(aCaret: TSynEditCaret): Boolean;
property OldLinePos: Integer read FOldLinePos;
property OldCharPos: Integer read FOldCharPos;
property LinePos: Integer read fLinePos write setLinePos;
property CharPos: Integer read fCharPos write setCharPos;
property LineCharPos: TPoint read GetLineCharPos write SetLineCharPos;
property BytePos: Integer read GetBytePos write SetBytePos;
property LineBytePos: TPoint read GetLineBytePos write SetLineBytePos;
property LineText: string read GetLineText write SetLineText;
property AdjustToNextChar: Boolean read FAdjustToNextChar write FAdjustToNextChar;
property AllowPastEOL: Boolean read FAllowPastEOL write SetAllowPastEOL;
property KeepCaretX: Boolean read FKeepCaretX write SetKeepCaretX;
property MaxLeftChar: PInteger write FMaxLeftChar;
end;
implementation
{ TSynEditPointBase }
function TSynEditPointBase.GetLocked: Boolean;
begin
Result := FLockCount > 0;
end;
procedure TSynEditPointBase.DoLock;
begin
end;
procedure TSynEditPointBase.DoUnlock;
begin
end;
constructor TSynEditPointBase.Create;
begin
FOnChangeList := TMethodList.Create;
end;
constructor TSynEditPointBase.Create(Lines : TSynEditStrings);
begin
Create;
FLines := Lines;
end;
destructor TSynEditPointBase.Destroy;
begin
FreeAndNil(FOnChangeList);
inherited Destroy;
end;
procedure TSynEditPointBase.AddChangeHandler(AHandler : TNotifyEvent);
begin
FOnChangeList.Add(TMethod(AHandler));
end;
procedure TSynEditPointBase.RemoveChangeHandler(AHandler : TNotifyEvent);
begin
FOnChangeList.Remove(TMethod(AHandler));
end;
procedure TSynEditPointBase.Lock;
begin
if FLockCount = 0 then
DoLock;
inc(FLockCount);
end;
procedure TSynEditPointBase.Unlock;
begin
dec(FLockCount);
if FLockCount = 0 then
DoUnLock;
end;
{ TSynEditCaret }
constructor TSynEditCaret.Create;
begin
inherited Create;
FMaxLeftChar := nil;
fLinePos:= 1;
fCharPos:= 1;
FAllowPastEOL := True;
FForcePastEOL := 0;
end;
procedure TSynEditCaret.AssignFrom(Src: TSynEditCaret);
begin
FOldCharPos := FCharPos;
FOldLinePos := FLinePos;
FLines := Src.FLines;
FMaxLeftChar := Src.FMaxLeftChar;
FAllowPastEOL := Src.FAllowPastEOL;
FKeepCaretX := Src.FKeepCaretX;
FLinePos := Src.FLinePos;
FCharPos := Src.FCharPos;
FLastCharPos := Src.FLastCharPos;
end;
procedure TSynEditCaret.IncForcePastEOL;
begin
inc(FForcePastEOL);
end;
procedure TSynEditCaret.DecForcePastEOL;
begin
dec(FForcePastEOL);
end;
procedure TSynEditCaret.IncForceAdjustToNextChar;
begin
Inc(FForceAdjustToNextChar);
end;
procedure TSynEditCaret.DecForceAdjustToNextChar;
begin
Dec(FForceAdjustToNextChar);
end;
procedure TSynEditCaret.ChangeOnTouch;
begin
FChangeOnTouch := True;
if not Locked then
FTouched := False;
end;
function TSynEditCaret.IsAtLineChar(aPoint: TPoint): Boolean;
begin
Result := (FLinePos = aPoint.y) and (FCharPos = aPoint.x);
end;
function TSynEditCaret.IsAtLineByte(aPoint: TPoint): Boolean;
begin
Result := (FLinePos = aPoint.y) and (BytePos = aPoint.x);
end;
function TSynEditCaret.WasAtLineChar(aPoint: TPoint): Boolean;
begin
Result := (FOldLinePos = aPoint.y) and (FOldCharPos = aPoint.x);
end;
function TSynEditCaret.WasAtLineByte(aPoint: TPoint): Boolean;
begin
Result := (FOldLinePos = aPoint.y) and
(FLines.PhysicalToLogicalPos(Point(FOldCharPos, FOldLinePos)).X = aPoint.x);
end;
function TSynEditCaret.IsAtPos(aCaret: TSynEditCaret): Boolean;
begin
Result := IsAtLineChar(aCaret.LineCharPos);
end;
procedure TSynEditCaret.setLinePos(const AValue : Integer);
begin
InternalSetLineCharPos(AValue, FLastCharPos, True);
end;
procedure TSynEditCaret.AdjustToChar;
var
CharWidths: TPhysicalCharWidths;
LogLen: Integer;
ScreenPos: Integer;
LogPos: Integer;
L: String;
begin
L := LineText;
CharWidths := FLines.GetPhysicalCharWidths(L, FLinePos-1);
LogLen := Length(CharWidths);
ScreenPos := 1;
LogPos := 0;
while LogPos < LogLen do begin
if ScreenPos = FCharPos then exit;
if ScreenPos + CharWidths[LogPos] > FCharPos then begin
if L[LogPos+1] = #9 then exit;
if FAdjustToNextChar or (FForceAdjustToNextChar > 0) then
FCharPos := ScreenPos + CharWidths[LogPos]
else
FCharPos := ScreenPos;
exit;
end;
ScreenPos := ScreenPos + CharWidths[LogPos];
inc(LogPos);
end;
end;
procedure TSynEditCaret.setCharPos(const AValue : Integer);
begin
InternalSetLineCharPos(FLinePos, AValue);
end;
procedure TSynEditCaret.SetAllowPastEOL(const AValue: Boolean);
begin
if FAllowPastEOL = AValue then exit;
FAllowPastEOL := AValue;
if not FAllowPastEOL then
InternalSetLineCharPos(FLinePos, FCharPos, True, True);
end;
procedure TSynEditCaret.SetKeepCaretX(const AValue: Boolean);
begin
if FKeepCaretX = AValue then exit;
FKeepCaretX := AValue;
if FKeepCaretX then
FLastCharPos := FCharPos;
end;
function TSynEditCaret.GetLineCharPos : TPoint;
begin
Result := Point(fCharPos, fLinePos);
end;
procedure TSynEditCaret.SetLineCharPos(AValue : TPoint);
begin
InternalSetLineCharPos(AValue.y, AValue.X);
end;
procedure TSynEditCaret.InternalSetLineCharPos(NewLine, NewCharPos: Integer;
KeepLastCharPos: Boolean = False; ForceSet: Boolean = False);
var
nMaxX: Integer;
Line: string;
begin
Lock;
FTouched := True;
try
if (fCharPos <> NewCharPos) or (fLinePos <> NewLine) or ForceSet then begin
if FMaxLeftChar <> nil then
nMaxX := FMaxLeftChar^
else
nMaxX := MaxInt;
if NewLine > FLines.Count then
NewLine := FLines.Count;
if NewLine < 1 then begin
// this is just to make sure if Lines stringlist should be empty
NewLine := 1;
if (not FAllowPastEOL) and (FForcePastEOL = 0) then
nMaxX := 1;
end else
if (not FAllowPastEOL) and (FForcePastEOL = 0) then begin
Line := Lines[NewLine - 1];
nMaxX := Lines.LogicalToPhysicalCol(Line, NewLine - 1, length(Line)+1);
end;
if NewCharPos > nMaxX then
NewCharPos := nMaxX;
if NewCharPos < 1 then
NewCharPos := 1;
fCharPos:= NewCharPos;
fLinePos:= NewLine;
AdjustToChar;
if (not KeepLastCharPos) or (not FKeepCaretX) then
FLastCharPos := FCharPos;
end;
finally
Unlock;
end;
end;
function TSynEditCaret.GetBytePos: Integer;
begin
Result := LineBytePos.X;
end;
procedure TSynEditCaret.SetBytePos(const AValue: Integer);
begin
CharPos := FLines.LogicalToPhysicalPos(Point(AValue, LinePos)).X;
end;
function TSynEditCaret.GetLineBytePos: TPoint;
begin
Result := FLines.PhysicalToLogicalPos(LineCharPos);
end;
procedure TSynEditCaret.SetLineBytePos(const AValue: TPoint);
begin
LineCharPos := FLines.LogicalToPhysicalPos(AValue);
end;
function TSynEditCaret.GetLineText : string;
begin
if (LinePos >= 1) and (LinePos <= FLines.Count) then
Result := FLines[LinePos - 1]
else
Result := '';
end;
procedure TSynEditCaret.SetLineText(const AValue : string);
begin
if (LinePos >= 1) and (LinePos <= Max(1, FLines.Count)) then
FLines[LinePos - 1] := AValue;
end;
procedure TSynEditCaret.DoLock;
begin
FTouched := False;
FOldCharPos := FCharPos;
FOldLinePos := FLinePos;
end;
procedure TSynEditCaret.DoUnlock;
begin
if not FChangeOnTouch then
FTouched := False;
FChangeOnTouch := False;
if (FOldCharPos <> FCharPos) or (FOldLinePos <> FLinePos) or FTouched then
fOnChangeList.CallNotifyEvents(self);
// All notifications called, reset oldpos
FTouched := False;
FOldCharPos := FCharPos;
FOldLinePos := FLinePos;
end;
{ TSynEditSelection }
constructor TSynEditSelection.Create(ALines : TSynEditStrings; aActOnLineChanges: Boolean);
begin
Inherited Create(ALines);
FInternalCaret := TSynEditCaret.Create;
FInternalCaret.Lines := FLines;
FActiveSelectionMode := smNormal;
FStartLinePos := 1;
FStartBytePos := 1;
FEndLinePos := 1;
FEndBytePos := 1;
FEnabled := True;
FHookedLines := aActOnLineChanges;
FIsSettingText := False;
if FHookedLines then begin
FLines.AddEditHandler(@DoLinesEdited);
FLines.AddChangeHandler(senrLineChange, {$IFDEF FPC}@{$ENDIF}LineChanged);
end;
end;
destructor TSynEditSelection.Destroy;
begin
FreeAndNil(FInternalCaret);
if FHookedLines then begin
FLines.RemoveEditHandler(@DoLinesEdited);
FLines.RemoveChangeHandler(senrLineChange, {$IFDEF FPC}@{$ENDIF}LineChanged);
end;
inherited Destroy;
end;
procedure TSynEditSelection.AssignFrom(Src: TSynEditSelection);
begin
//FEnabled := src.FEnabled;
FHide := src.FHide;
FActiveSelectionMode := src.FActiveSelectionMode;
FSelectionMode := src.FSelectionMode;
FStartLinePos := src.FStartLinePos; // 1 based
FStartBytePos := src.FStartBytePos; // 1 based
FEndLinePos := src.FEndLinePos; // 1 based
FEndBytePos := src.FEndBytePos; // 1 based
FPersistent := src.FPersistent;
end;
procedure TSynEditSelection.AdjustAfterTrimming;
begin
if FStartBytePos > Length(FLines[FStartLinePos-1]) + 1 then
FStartBytePos := Length(FLines[FStartLinePos-1]) + 1;
if FEndBytePos > Length(FLines[FEndLinePos-1]) + 1 then
FEndBytePos := Length(FLines[FEndLinePos-1]) + 1;
// Todo: Call ChangeNotification
end;
function TSynEditSelection.GetSelText : string;
function CopyPadded(const S: string; Index, Count: integer): string;
var
SrcLen: Integer;
DstLen: integer;
P: PChar;
begin
SrcLen := Length(S);
DstLen := Index + Count;
if SrcLen >= DstLen then
Result := Copy(S, Index, Count)
else begin
SetLength(Result, DstLen);
P := PChar(Pointer(Result));
StrPCopy(P, Copy(S, Index, Count));
Inc(P, SrcLen);
FillChar(P^, DstLen - Srclen, $20);
end;
end;
procedure CopyAndForward(const S: string; Index, Count: Integer; var P:
PChar);
var
pSrc: PChar;
SrcLen: Integer;
DstLen: Integer;
begin
SrcLen := Length(S);
if (Index <= SrcLen) and (Count > 0) then begin
Dec(Index);
pSrc := PChar(Pointer(S)) + Index;
DstLen := Min(SrcLen - Index, Count);
Move(pSrc^, P^, DstLen);
Inc(P, DstLen);
P^ := #0;
end;
end;
procedure CopyPaddedAndForward(const S: string; Index, Count: Integer;
var P: PChar);
var
OldP: PChar;
Len: Integer;
begin
OldP := P;
CopyAndForward(S, Index, Count, P);
Len := Count - (P - OldP);
FillChar(P^, Len, #$20);
Inc(P, Len);
end;
const
sLineBreak = {$IFDEF SYN_LAZARUS}LineEnding{$ELSE}#$0D#$0A{$ENDIF};
var
First, Last, TotalLen: Integer;
ColFrom, ColTo: Integer;
I: Integer;
{$IFDEF SYN_MBCSSUPPORT}
l, r: Integer;
s: string;
{$ELSE}
ColLen: integer;
{$ENDIF}
P: PChar;
begin
if not SelAvail then
Result := ''
else begin
if IsBackwardSel then begin
ColFrom := FEndBytePos;
First := FEndLinePos - 1;
ColTo := FStartBytePos;
Last := FStartLinePos - 1;
end else begin
ColFrom := FStartBytePos;
First := FStartLinePos - 1;
ColTo := FEndBytePos;
Last := FEndLinePos - 1;
end;
TotalLen := 0;
case ActiveSelectionMode of
smNormal:
if (First = Last) then
Result := Copy(FLines[First], ColFrom, ColTo - ColFrom)
else begin
// step1: calculate total length of result string
TotalLen := Max(0, Length(FLines[First]) - ColFrom + 1);
for i := First + 1 to Last - 1 do
Inc(TotalLen, Length(FLines[i]));
Inc(TotalLen, ColTo - 1);
Inc(TotalLen, Length(sLineBreak) * (Last - First));
// step2: build up result string
SetLength(Result, TotalLen);
P := PChar(Pointer(Result));
CopyAndForward(FLines[First], ColFrom, MaxInt, P);
CopyAndForward(sLineBreak, 1, MaxInt, P);
for i := First + 1 to Last - 1 do begin
CopyAndForward(FLines[i], 1, MaxInt, P);
CopyAndForward(sLineBreak, 1, MaxInt, P);
end;
{$IFDEF SYN_LAZARUS}
CopyPaddedAndForward(FLines[Last], 1, ColTo - 1, P);
{$ELSE}
CopyAndForward(FLines[Last], 1, ColTo - 1, P);
{$ENDIF}
end;
smColumn:
begin
if ColFrom > ColTo then
SwapInt(ColFrom, ColTo);
// step1: calclate total length of result string
{$IFNDEF SYN_MBCSSUPPORT}
ColLen := ColTo - ColFrom;
TotalLen := ColLen + (ColLen + Length(sLineBreak)) * (Last - First);
// step2: build up result string
SetLength(Result, TotalLen);
P := PChar(Pointer(Result));
for i := First to Last - 1 do begin
CopyPaddedAndForward(FLines[i], ColFrom, ColLen, P);
CopyAndForward(sLineBreak, 1, MaxInt, P);
end;
CopyPaddedAndForward(FLines[Last], ColFrom, ColLen, P);
{$ELSE} //SYN_MBCSSUPPORT
for i := First to Last do begin
s := FLines[i];
l := ColFrom;
r := ColTo;
MBCSGetSelRangeInLineWhenColumnActiveSelectionMode(s, l, r);
Inc(TotalLen, r - l);
end;
Inc(TotalLen, Length(sLineBreak) * (Last - First));
// step2: build up result string
SetLength(Result, TotalLen);
P := PChar(Result);
for i := First to Last - 1 do begin
s := FLines[i];
l := ColFrom;
r := ColTo;
MBCSGetSelRangeInLineWhenColumnActiveSelectionMode(s, l, r);
CopyPaddedAndForward(s, l, r - l, P);
CopyAndForward(sLineBreak, 1, MaxInt, P);
end;
s := FLines[Last];
l := ColFrom;
r := ColTo;
MBCSGetSelRangeInLineWhenColumnActiveSelectionMode(s, l, r);
CopyPaddedAndForward(FLines[Last], l, r - l, P);
{$ENDIF}
end;
smLine:
begin
// If block selection includes LastLine,
// line break code(s) of the last line will not be added.
// step1: calclate total length of result string
for i := First to Last do
Inc(TotalLen, Length(FLines[i]) + Length(sLineBreak));
if Last = FLines.Count - 1 then
Dec(TotalLen, Length(sLineBreak));
// step2: build up result string
SetLength(Result, TotalLen);
P := PChar(Pointer(Result));
for i := First to Last - 1 do begin
CopyAndForward(FLines[i], 1, MaxInt, P);
CopyAndForward(sLineBreak, 1, MaxInt, P);
end;
CopyAndForward(FLines[Last], 1, MaxInt, P);
if Last < FLines.Count - 1 then
CopyAndForward(sLineBreak, 1, MaxInt, P);
end;
end;
end;
end;
procedure TSynEditSelection.SetSelText(const Value : string);
begin
SetSelTextPrimitive(smNormal, PChar(Value));
end;
procedure TSynEditSelection.DoCaretChanged(Sender: TObject);
begin
if FIgnoreNextCaretMove then begin
FIgnoreNextCaretMove := False;
FLastCarePos := Point(-1, -1);
exit;
end;
if (FCaret.IsAtLineByte(StartLineBytePos) or
FCaret.IsAtLineByte(EndLineBytePos)) and
FCaret.WasAtLineChar(FLastCarePos)
then
exit;
FLastCarePos := Point(-1, -1);
if FAutoExtend then begin
if (not FHide) and (FCaret.WasAtLineByte(EndLineBytePos)) then
SetEndLineBytePos(FCaret.LineBytePos)
else
if (not FHide) and (FCaret.WasAtLineByte(StartLineBytePos)) then
AdjustStartLineBytePos(FCaret.LineBytePos)
else begin
StartLineBytePos := Point(FCaret.OldCharPos, FCaret.OldLinePos);
EndLineBytePos := FCaret.LineBytePos;
if Persistent and IsBackwardSel then
SortSelectionPoints;
end;
exit;
end;
if FPersistent or (FPersistentLock > 0) then
exit;
StartLineBytePos := FCaret.LineBytePos;
end;
procedure TSynEditSelection.LineChanged(Sender: TSynEditStrings; AIndex, ACount: Integer);
begin
if (FCaret <> nil) and (not FCaret.AllowPastEOL) and (not FIsSettingText) then
AdjustAfterTrimming;
end;
procedure TSynEditSelection.DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
aLineBrkCnt: Integer; aText: String);
function AdjustPoint(aPoint: Tpoint): TPoint; inline;
begin
Result := aPoint;
if aLineBrkCnt < 0 then begin
(* Lines Deleted *)
if aPoint.y > aLinePos then begin
Result.y := Max(aLinePos, Result.y + aLineBrkCnt);
if Result.y = aLinePos then
Result.x := Result.x + aBytePos - 1;
end;
end
else
if aLineBrkCnt > 0 then begin
(* Lines Inserted *)
if (aPoint.y = aLinePos) and (aPoint.x >= aBytePos) then begin
Result.x := Result.x - aBytePos + 1;
Result.y := Result.y + aLineBrkCnt;
end;
if aPoint.y > aLinePos then begin
Result.y := Result.y + aLineBrkCnt;
end;
end
else
if aCount <> 0 then begin
(* Chars Insert/Deleted *)
if (aPoint.y = aLinePos) and (aPoint.x >= aBytePos) then
Result.x := Max(aBytePos, Result.x + aCount);
end;
end;
begin
if FIsSettingText then exit;
if FPersistent or (FPersistentLock > 0) then begin
if FActiveSelectionMode <> smColumn then begin
AdjustStartLineBytePos(AdjustPoint(StartLineBytePos));
EndLineBytePos := AdjustPoint(EndLineBytePos);
end;
end
else
if (FCaret <> nil) then
StartLineBytePos := FCaret.LineBytePos;
end;
procedure TSynEditSelection.SetSelTextPrimitive(PasteMode : TSynSelectionMode;
Value : PChar);
var
BB, BE: TPoint;
procedure DeleteSelection;
var
y, l, r, xb, xe: Integer;
begin
case ActiveSelectionMode of
smNormal:
begin
if FLines.Count > 0 then begin
if BE.Y > BB.Y + 1 then begin
FLines.EditLinesDelete(BB.Y + 1, BE.Y - BB.Y - 1);
BE.Y := BB.Y + 1;
end;
if BE.Y > BB.Y then begin
l := length(FLines[BB.Y - 1]);
if BB.X > l + 1 then BB.X := l + 1;
BE.X := BE.X + l;
FLines.EditLineJoin(BB.Y);
BE.Y := BB.Y;
end;
FLines.EditDelete(BB.X, BB.Y, BE.X - BB.X);
end;
FInternalCaret.LineBytePos := BB;
end;
smColumn:
begin
FInternalCaret.LineBytePos := BB;
l := FInternalCaret.CharPos;
FInternalCaret.LineBytePos := BE;
r := FInternalCaret.CharPos;
// swap l, r if needed
if l > r then
{$IFDEF SYN_COMPILER_3_UP}
SwapInt(l, r);
{$ELSE}
begin
y := l;
l := r;
r := y;
end;
{$ENDIF}
for y := BB.Y to BE.Y do begin
FInternalCaret.LineCharPos := Point(l, y);
xb := FInternalCaret.BytePos;
FInternalCaret.LineCharPos := Point(r, y);
xe := Min(FInternalCaret.BytePos, 1 + length(FInternalCaret.LineText));
if xe > xb then
FLines.EditDelete(xb, y, xe - xb);
end;
// FLines never get deleted completely, so keep caret at end.
FInternalCaret.LineCharPos := Point(l, FEndLinePos);
// Column deletion never removes a line entirely, so no mark
// updating is needed here.
end;
smLine:
begin
if BE.Y = FLines.Count then begin
// Keep the (CrLf of) last line, since no Line exists to replace it
FLines.EditDelete(1, BE.Y, length(FLines[BE.Y - 1]));
dec(BE.Y)
end;
if BE.Y >= BB.Y then
FLines.EditLinesDelete(BB.Y, BE.Y - BB.Y + 1);
FInternalCaret.LineCharPos := Point(1, BB.Y);
end;
end;
end;
procedure InsertText;
function CountLines(p: PChar): integer;
begin
Result := 0;
while p^ <> #0 do begin
if p^ = #13 then
Inc(p);
if p^ = #10 then
Inc(p);
Inc(Result);
p := GetEOL(p);
end;
end;
function InsertNormal: Integer;
var
Str: string;
Start: PChar;
P: PChar;
LogCaretXY: TPoint;
begin
Result := 0;
LogCaretXY := FInternalCaret.LineBytePos;
Start := PChar(Value);
P := GetEOL(Start);
if P^ = #0 then begin
FLines.EditInsert(LogCaretXY.X, LogCaretXY.Y, Value);
FInternalCaret.BytePos := FInternalCaret.BytePos + Length(Value);
end else begin
SetString(Str, Value, P - Start);
FLines.EditInsert(LogCaretXY.X, LogCaretXY.Y, Str);
FLines.EditLineBreak(LogCaretXY.X + Length(Str), LogCaretXY.Y);
Result := CountLines(P);
if Result > 1 then
FLines.EditLinesInsert(LogCaretXY.Y + 1, Result - 1);
while P^ <> #0 do begin
if P^ = #13 then
Inc(P);
if P^ = #10 then
Inc(P);
LogCaretXY.Y := LogCaretXY.Y + 1;
Start := P;
P := GetEOL(Start);
if P <> Start then begin
SetString(Str, Start, P - Start);
FLines.EditInsert(1, LogCaretXY.Y, Str);
end
else
Str := '';
end;
FInternalCaret.LinePos := LogCaretXY.Y;
FInternalCaret.BytePos := 1 + Length(Str);
end;
end;
function InsertColumn: Integer;
var
Str: string;
Start: PChar;
P: PChar;
begin
// Insert string at current position
Result := 0;
FInternalCaret.IncForcePastEOL;
Start := PChar(Value);
repeat
P := GetEOL(Start);
if P <> Start then begin
SetLength(Str, P - Start);
Move(Start^, Str[1], P - Start);
FLines.EditInsert(FInternalCaret.BytePos, FInternalCaret.LinePos, Str);
end;
if p^ in [#10,#13] then begin
if (p[1] in [#10,#13]) and (p[1]<>p^) then
inc(p,2)
else
Inc(P);
if FInternalCaret.LinePos = FLines.Count then
FLines.EditLinesInsert(FInternalCaret.LinePos + 1, 1);
// No need to inc result => adding at EOF
FInternalCaret.LinePos := FInternalCaret.LinePos + 1;
end;
Start := P;
until P^ = #0;
FInternalCaret.BytePos:= FInternalCaret.BytePos + Length(Str);
FInternalCaret.DecForcePastEOL;
end;
function InsertLine: Integer;
var
Start: PChar;
P: PChar;
Str: string;
begin
Result := 0;
FInternalCaret.CharPos := 1;
// Insert string before current line
Start := PChar(Value);
repeat
P := GetEOL(Start);
if P <> Start then begin
SetLength(Str, P - Start);
Move(Start^, Str[1], P - Start);
end else
Str := '';
if (P^ = #0) then begin // Not a full line?
FLines.EditInsert(1, FInternalCaret.LinePos, Str);
FInternalCaret.BytePos := 1 + Length(Str);
end else begin
FLines.EditLinesInsert(FInternalCaret.LinePos, 1, Str);
FInternalCaret.LinePos := FInternalCaret.LinePos + 1;
Inc(Result);
if P^ = #13 then
Inc(P);
if P^ = #10 then
Inc(P);
Start := P;
end;
until P^ = #0;
end;
begin
if Value = '' then
Exit;
if FLines.Count = 0 then
FLines.Add('');
// Using a TStringList to do this would be easier, but if we're dealing
// with a large block of text, it would be very inefficient. Consider:
// Assign Value parameter to TStringList.Text: that parses through it and
// creates a copy of the string for each line it finds. That copy is passed
// to the Add method, which in turn creates a copy. Then, when you actually
// use an item in the list, that creates a copy to return to you. That's
// 3 copies of every string vs. our one copy below. I'd prefer no copies,
// but we aren't set up to work with PChars that well.
case PasteMode of
smNormal:
InsertNormal;
smColumn:
InsertColumn;
smLine:
InsertLine;
end;
end;
begin
FIsSettingText := True;
FLines.BeginUpdate;
try
// BB is lower than BE
BB := FirstLineBytePos;
BE := LastLineBytePos;
if SelAvail then begin
DeleteSelection;
if FActiveSelectionMode = smLine then
BB.X := 1;
StartLineBytePos := BB; // deletes selection // calls selection changed
// Need to update caret (syncro edit follows on every edit)
if FCaret <> nil then
FCaret.LineCharPos := FInternalCaret.LineCharPos;
end
else
if FCaret <> nil then
StartLineBytePos := FCaret.LineBytePos;
FInternalCaret.LineBytePos := StartLineBytePos;
if (Value <> nil) and (Value[0] <> #0) then begin
InsertText;
StartLineBytePos := FInternalCaret.LineBytePos; // reset selection
end;
if FCaret <> nil then
FCaret.LineCharPos := FInternalCaret.LineCharPos;
finally
FLines.EndUpdate;
FIsSettingText := False;
end;
end;
function TSynEditSelection.GetStartLineBytePos : TPoint;
begin
Result.y := FStartLinePos;
Result.x := FStartBytePos;
end;
procedure TSynEditSelection.SetEnabled(const Value : Boolean);
begin
if FEnabled = Value then exit;
FEnabled := Value;
if not Enabled then SetStartLineBytePos(EndLineBytePos);
end;
procedure TSynEditSelection.SetStartLineBytePos(Value : TPoint);
// logical position (byte)
var
nInval1, nInval2: integer;
SelChanged: boolean;
begin
Value.y := MinMax(Value.y, 1, fLines.Count);
if (FCaret = nil) or FCaret.AllowPastEOL then
Value.x := Max(Value.x, 1)
else
Value.x := MinMax(Value.x, 1, length(Lines[Value.y - 1])+1);
if (ActiveSelectionMode = smNormal) then
if (Value.y >= 1) and (Value.y <= FLines.Count) then
Value.x := AdjustBytePosToCharacterStart(Value.y,Value.x)
else
Value.x := 1;
if SelAvail then begin
if FStartLinePos < FEndLinePos then begin
nInval1 := Min(Value.Y, FStartLinePos);
nInval2 := Max(Value.Y, FEndLinePos);
end else begin
nInval1 := Min(Value.Y, FEndLinePos);
nInval2 := Max(Value.Y, FStartLinePos);
end;
FInvalidateLinesMethod(nInval1, nInval2);
SelChanged := TRUE;
end else begin
SelChanged := (FStartBytePos <> Value.X) or (FStartLinePos <> Value.Y) or
(FEndBytePos <> Value.X) or (FEndLinePos <> Value.Y);
end;
FActiveSelectionMode := FSelectionMode;
FHide := False;
FStartLinePos := Value.Y;
FStartBytePos := Value.X;
FEndLinePos := Value.Y;
FEndBytePos := Value.X;
if FCaret <> nil then
FLastCarePos := Point(FCaret.OldCharPos, FCaret.OldLinePos);
if SelChanged then
fOnChangeList.CallNotifyEvents(self);
end;
procedure TSynEditSelection.AdjustStartLineBytePos(Value: TPoint);
begin
if FEnabled then begin
Value.y := MinMax(Value.y, 1, fLines.Count);
if (FCaret = nil) or FCaret.AllowPastEOL then
Value.x := Max(Value.x, 1)
else
Value.x := MinMax(Value.x, 1, length(Lines[Value.y - 1])+1);
if (ActiveSelectionMode = smNormal) then
if (Value.y >= 1) and (Value.y <= FLines.Count) then
Value.x := AdjustBytePosToCharacterStart(Value.y,Value.x)
else
Value.x := 1;
if (Value.X <> FStartBytePos) or (Value.Y <> FStartLinePos) then begin
if (ActiveSelectionMode = smColumn) and (Value.X <> FStartBytePos) then
FInvalidateLinesMethod(Min(FStartLinePos, Min(FEndLinePos, Value.Y)),
Max(FStartLinePos, Max(FEndLinePos, Value.Y)))
else
if (ActiveSelectionMode <> smColumn) or (FStartBytePos <> FEndBytePos) then
FInvalidateLinesMethod(FStartLinePos, Value.Y);
FStartLinePos := Value.Y;
FStartBytePos := Value.X;
if FCaret <> nil then
FLastCarePos := Point(FCaret.OldCharPos, FCaret.OldLinePos);
FOnChangeList.CallNotifyEvents(self);
end;
end;
end;
function TSynEditSelection.GetEndLineBytePos : TPoint;
begin
Result.y := FEndLinePos;
Result.x := FEndBytePos;
end;
procedure TSynEditSelection.SetEndLineBytePos(Value : TPoint);
{$IFDEF SYN_MBCSSUPPORT}
var
s: string;
{$ENDIF}
begin
if FEnabled then begin
Value.y := MinMax(Value.y, 1, fLines.Count);
if (FCaret = nil) or FCaret.AllowPastEOL then
Value.x := Max(Value.x, 1)
else
Value.x := MinMax(Value.x, 1, length(Lines[Value.y - 1])+1);
if (ActiveSelectionMode = smNormal) then
if (Value.y >= 1) and (Value.y <= fLines.Count) then
Value.x := AdjustBytePosToCharacterStart(Value.y,Value.x)
else
Value.x := 1;
if (Value.X <> FEndBytePos) or (Value.Y <> FEndLinePos) then begin
{$IFDEF SYN_MBCSSUPPORT}
if Value.Y <= fLines.Count then begin
s := fLines[Value.Y - 1];
if (Length(s) >= Value.X) and (mbTrailByte = ByteType(s, Value.X)) then
Dec(Value.X);
end;
{$ENDIF}
if (Value.X <> FEndBytePos) or (Value.Y <> FEndLinePos) then begin
if (ActiveSelectionMode = smColumn) and (Value.X <> FEndBytePos) then
FInvalidateLinesMethod(Min(FStartLinePos, Min(FEndLinePos, Value.Y)),
Max(FStartLinePos, Max(FEndLinePos, Value.Y)))
else
if (ActiveSelectionMode <> smColumn) or (FStartBytePos <> FEndBytePos) then
FInvalidateLinesMethod(FEndLinePos, Value.Y);
FEndLinePos := Value.Y;
FEndBytePos := Value.X;
if FCaret <> nil then
FLastCarePos := Point(FCaret.OldCharPos, FCaret.OldLinePos);
FOnChangeList.CallNotifyEvents(self);
end;
end;
end;
end;
procedure TSynEditSelection.SetSelectionMode(const AValue: TSynSelectionMode);
begin
FSelectionMode := AValue;
SetActiveSelectionMode(AValue);
fOnChangeList.CallNotifyEvents(self);
end;
procedure TSynEditSelection.SetActiveSelectionMode(const Value: TSynSelectionMode);
begin
if FActiveSelectionMode <> Value then begin
FActiveSelectionMode := Value;
if SelAvail then
FInvalidateLinesMethod(-1, -1);
FOnChangeList.CallNotifyEvents(self);
end;
end;
procedure TSynEditSelection.SetHide(const AValue: Boolean);
begin
if FHide = AValue then exit;
FHide := AValue;
FInvalidateLinesMethod(Min(FStartLinePos, FEndLinePos),
Max(FStartLinePos, FEndLinePos) );
FOnChangeList.CallNotifyEvents(self);
end;
procedure TSynEditSelection.SetPersistent(const AValue: Boolean);
begin
if FPersistent = AValue then exit;
FPersistent := AValue;
if (not FPersistent) and (FCaret <> nil) and
not ( FCaret.IsAtLineByte(StartLineBytePos) or
FCaret.IsAtLineByte(EndLineBytePos) )
then
Clear;
end;
// Only needed if the Selection is set from External
function TSynEditSelection.AdjustBytePosToCharacterStart(Line : integer; BytePos : integer) : integer;
var
s: string;
begin
Result := BytePos;
if Result < 1 then
Result := 1
else if (Line >= 1) and (Line <= FLines.Count) then begin
s := FLines[Line-1];
if (Result <= length(s)) and FLines.IsUtf8 then
Result:=UTF8FindNearestCharStart(PChar(Pointer(s)),length(s),Result - 1) + 1;
end;
if Result <> BytePos then debugln(['Selection needed byte adjustment Line=', Line, ' BytePos=', BytePos, ' Result=', Result]);
end;
function TSynEditSelection.GetFirstLineBytePos: TPoint;
begin
if IsBackwardSel then
Result := EndLineBytePos
else
Result := StartLineBytePos;
end;
function TSynEditSelection.GetLastLineBytePos: TPoint;
begin
if IsBackwardSel then
Result := StartLineBytePos
else
Result := EndLineBytePos;
end;
procedure TSynEditSelection.SetCaret(const AValue: TSynEditCaret);
begin
if FCaret = AValue then exit;
if FCaret <> nil then
Caret.RemoveChangeHandler(@DoCaretChanged);
FCaret := AValue;
if FCaret <> nil then
Caret.AddChangeHandler(@DoCaretChanged);
end;
function TSynEditSelection.SelAvail : Boolean;
begin
Result := (not FHide) and
( (FStartBytePos <> FEndBytePos) or
((FStartLinePos <> FEndLinePos) and (FActiveSelectionMode <> smColumn)) );
end;
function TSynEditSelection.SelCanContinue(ACaret: TSynEditCaret): Boolean;
begin
if SelAvail then exit(True);
Result := (not FHide) and
(FActiveSelectionMode = smColumn) and (FEndLinePos = ACaret.LinePos) and
(FEndBytePos = ACaret.BytePos);
end;
function TSynEditSelection.IsBackwardSel: Boolean;
begin
Result := (FStartLinePos > FEndLinePos)
or ((FStartLinePos = FEndLinePos) and (FStartBytePos > FEndBytePos));
end;
procedure TSynEditSelection.SortSelectionPoints;
begin
if IsBackwardSel then begin
SwapInt(FStartLinePos, FEndLinePos);
SwapInt(FStartBytePos, FEndBytePos);
end;
end;
procedure TSynEditSelection.IgnoreNextCaretMove;
begin
FIgnoreNextCaretMove := True;
end;
procedure TSynEditSelection.IncPersistentLock;
begin
inc(FPersistentLock)
end;
procedure TSynEditSelection.DecPersistentLock;
begin
dec(FPersistentLock)
end;
procedure TSynEditSelection.Clear;
begin
if Caret <> nil then
StartLineBytePos := Caret.LineBytePos
else
StartLineBytePos := StartLineBytePos;
end;
end.