mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-14 06:22:35 +02:00
433 lines
13 KiB
ObjectPascal
433 lines
13 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.
|
|
|
|
-------------------------------------------------------------------------------}
|
|
unit SynEditMarkupWordGroup;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Graphics, SynEditMarkup, SynEditMiscClasses, Controls,
|
|
LCLProc, SynEditHighlighter, SynEditHighlighterFoldBase;
|
|
|
|
type
|
|
|
|
TWordPoint = record
|
|
Y, X, X2: Integer;
|
|
end;
|
|
|
|
|
|
{ TSynEditMarkupWordGroup }
|
|
|
|
TSynEditMarkupWordGroup = class(TSynEditMarkup)
|
|
private
|
|
// Physical Position
|
|
FHighlightPos1: TWordPoint;
|
|
FHighlightPos2: TWordPoint;
|
|
FHighlightPos3: TWordPoint;
|
|
FHighlighter: TSynCustomHighlighter;
|
|
FNeedInvalidate: Boolean;
|
|
FForceInvalidate: Boolean;
|
|
procedure SetHighlighter(const AValue: TSynCustomHighlighter);
|
|
protected
|
|
procedure FindMatchingWords(PhysCaret: TPoint;
|
|
out Word1, Word2, Word3: TWordPoint);
|
|
procedure DoCaretChanged(Sender: TObject); override;
|
|
procedure DoTopLineChanged(OldTopLine : Integer); override;
|
|
procedure DoLinesInWindoChanged(OldLinesInWindow : Integer); override;
|
|
procedure DoTextChanged(StartLine, EndLine : Integer); override;
|
|
procedure DoMarkupChanged(AMarkup: TSynSelectedColor); override;
|
|
procedure InvalidateCurrentHighlight;
|
|
public
|
|
constructor Create(ASynEdit: TSynEditBase);
|
|
procedure DecPaintLock; override;
|
|
|
|
function GetMarkupAttributeAtRowCol(const aRow, aCol: Integer): TSynSelectedColor; override;
|
|
function GetNextMarkupColAfterRowCol(const aRow, aCol: Integer): Integer; override;
|
|
|
|
property Highlighter: TSynCustomHighlighter
|
|
read FHighlighter write SetHighlighter;
|
|
end;
|
|
|
|
implementation
|
|
|
|
Function CompareWordPoints(P1, P2: TWordPoint): Integer;
|
|
begin
|
|
if P1.Y < P2.Y then Exit(-1);
|
|
if P1.Y > P2.Y then Exit(+1);
|
|
If P1.X < P2.X then Exit(-1);
|
|
If P1.X > P2.X then Exit(+1);
|
|
If P1.X2 < P2.X2 then Exit(-1);
|
|
If P1.X2 > P2.X2 then Exit(+1);
|
|
Result := 0;
|
|
end;
|
|
|
|
Function PointToWordPoint(P1: TPoint): TWordPoint;
|
|
begin
|
|
Result.Y := P1.Y;
|
|
Result.X := P1.X;
|
|
Result.X2 := P1.X+1;
|
|
end;
|
|
|
|
{ TSynEditMarkupWordGroup }
|
|
|
|
constructor TSynEditMarkupWordGroup.Create(ASynEdit : TSynEditBase);
|
|
begin
|
|
inherited Create(ASynEdit);
|
|
FHighlightPos1.Y := -1;
|
|
FHighlightPos2.Y := -1;
|
|
MarkupInfo.Foreground := clNone;// clNone;
|
|
MarkupInfo.FrameColor := clred;// clNone;
|
|
MarkupInfo.Background := clNone;
|
|
MarkupInfo.Style := [];
|
|
MarkupInfo.StyleMask := [];
|
|
end;
|
|
|
|
procedure TSynEditMarkupWordGroup.DecPaintLock;
|
|
begin
|
|
inherited DecPaintLock;
|
|
if (FPaintLock = 0) and FNeedInvalidate then
|
|
InvalidateCurrentHighlight;
|
|
end;
|
|
|
|
procedure TSynEditMarkupWordGroup.SetHighlighter(const AValue: TSynCustomHighlighter);
|
|
begin
|
|
FHighlighter := AValue;
|
|
end;
|
|
|
|
procedure TSynEditMarkupWordGroup.FindMatchingWords(PhysCaret: TPoint;
|
|
out Word1, Word2, Word3: TWordPoint);
|
|
var
|
|
LCnt: Integer;
|
|
HL: TSynCustomFoldHighlighter;
|
|
|
|
function FindEndNode(StartNode: TSynFoldNodeInfo;
|
|
var YIndex, NIndex: Integer): TSynFoldNodeInfo;
|
|
function SearchLine(ALineIdx: Integer; var ANodeIdx: Integer): TSynFoldNodeInfo;
|
|
var
|
|
NodeList: TLazSynFoldNodeInfoList;
|
|
begin
|
|
NodeList := HL.FoldNodeInfo[ALineIdx];
|
|
NodeList.ActionFilter := [sfaMarkup];
|
|
repeat
|
|
inc(ANodeIdx);
|
|
Result := NodeList[ANodeIdx];
|
|
until (sfaInvalid in Result.FoldAction)
|
|
or (Result.NestLvlEnd <= StartNode.NestLvlStart);
|
|
end;
|
|
begin
|
|
Result := SearchLine(YIndex, NIndex);
|
|
if not (sfaInvalid in Result.FoldAction) then
|
|
exit;
|
|
|
|
inc(YIndex);
|
|
while (YIndex < LCnt) and
|
|
(HL.FoldBlockMinLevel(YIndex, StartNode.FoldGroup, [sfbIncludeDisabled])
|
|
> StartNode.NestLvlStart)
|
|
do
|
|
inc(YIndex);
|
|
if YIndex = LCnt then
|
|
exit;
|
|
|
|
NIndex := -1;
|
|
Result := SearchLine(YIndex, NIndex);
|
|
|
|
if (Result.LogXEnd = 0) or (sfaLastLineClose in Result.FoldAction) then
|
|
Result.FoldAction := [sfaInvalid]; // LastLine closed Node(maybe force-closed?)
|
|
end;
|
|
|
|
function FindStartNode(EndNode: TSynFoldNodeInfo;
|
|
var YIndex, NIndex: Integer): TSynFoldNodeInfo;
|
|
function SearchLine(ALineIdx: Integer; var ANodeIdx: Integer): TSynFoldNodeInfo;
|
|
var
|
|
NodeList: TLazSynFoldNodeInfoList;
|
|
begin
|
|
NodeList := HL.FoldNodeInfo[ALineIdx];
|
|
NodeList.ActionFilter := [sfaMarkup];
|
|
repeat
|
|
dec(ANodeIdx);
|
|
Result := NodeList[ANodeIdx];
|
|
until (sfaInvalid in Result.FoldAction)
|
|
or (Result.NestLvlStart <= EndNode.NestLvlEnd);
|
|
end;
|
|
begin
|
|
Result := SearchLine(YIndex, NIndex);
|
|
if not(sfaInvalid in Result.FoldAction) then
|
|
exit;
|
|
|
|
dec(YIndex);
|
|
while (YIndex >= 0) and
|
|
(HL.FoldBlockMinLevel(YIndex, EndNode.FoldGroup, [sfbIncludeDisabled]) > EndNode.NestLvlEnd)
|
|
do
|
|
dec(YIndex);
|
|
if YIndex < 0 then
|
|
exit;
|
|
|
|
NIndex := HL.FoldNodeInfo[YIndex].CountEx([sfaMarkup]);
|
|
Result := SearchLine(YIndex, NIndex);
|
|
|
|
if (Result.LogXEnd = 0) or (sfaLastLineClose in Result.FoldAction) then
|
|
Result.FoldAction := [sfaInvalid]; // LastLine closed Node(maybe force-closed?)
|
|
end;
|
|
|
|
var
|
|
LogCaretXY: TPoint;
|
|
i, i2, y, y2: integer;
|
|
Node1, Node2, Node3, TmpNode: TSynFoldNodeInfo;
|
|
NodeList: TLazSynFoldNodeInfoList;
|
|
begin
|
|
Word1.Y := -1;
|
|
Word2.Y := -1;
|
|
Word3.Y := -1;
|
|
if (not assigned(Lines)) or (not MarkupInfo.IsEnabled) or
|
|
(PhysCaret.Y < 1) or (PhysCaret.Y > Lines.Count) or (PhysCaret.X < 1)
|
|
then
|
|
Exit;
|
|
if not (FHighlighter is TSynCustomFoldHighlighter) then
|
|
exit;
|
|
|
|
hl := TSynCustomFoldHighlighter(FHighlighter);
|
|
LogCaretXY := Lines.PhysicalToLogicalPos(PhysCaret);
|
|
y := LogCaretXY.Y - 1;
|
|
LCnt := Lines.Count;
|
|
HL.CurrentLines := Lines;
|
|
HL.FoldNodeInfo[y].ClearFilter; // only needed once, in case the line was already used
|
|
|
|
i := 0;
|
|
NodeList := HL.FoldNodeInfo[y];
|
|
NodeList.ActionFilter := [sfaMarkup];
|
|
Node1 := NodeList[i];
|
|
while not(sfaInvalid in Node1.FoldAction) and (Node1.LogXEnd < LogCaretXY.X-1) do
|
|
begin
|
|
inc(i);
|
|
Node1 := NodeList[i];
|
|
end;
|
|
if (Node1.LogXStart > LogCaretXY.X - 1) or (sfaInvalid in Node1.FoldAction) then
|
|
exit;
|
|
|
|
if Node1.FoldAction * [sfaOpen, sfaOneLineOpen] <> [] then begin
|
|
//y1 := y;
|
|
Node2 := FindEndNode(Node1, y, i);
|
|
if (sfaInvalid in Node2.FoldAction) then
|
|
exit;
|
|
y2 := y;
|
|
i2 := i;
|
|
end else begin
|
|
Node2 := Node1;
|
|
y2 := y;
|
|
i2 := i;
|
|
Node1 := FindStartNode(Node2, y, i); // skip = endnode => do not skup anything
|
|
if (sfaInvalid in Node1.FoldAction) then
|
|
exit;
|
|
end;
|
|
|
|
Node3.FoldAction := [sfaInvalid];
|
|
i := i2;
|
|
y := y2;
|
|
TmpNode := HL.FoldNodeInfo[y2].NodeInfoEx(i2 - 1, [sfaMarkup]);
|
|
if (not (sfaInvalid in TmpNode.FoldAction)) and
|
|
(TmpNode.LogXStart = Node2.LogXStart) and (TmpNode.LogXEnd = Node2.LogXEnd)
|
|
then begin
|
|
// triple node => 3rd start after current start
|
|
TmpNode := FindStartNode(TmpNode, y2, i2);
|
|
if (not (sfaInvalid in TmpNode.FoldAction)) then begin
|
|
Node3 := Node2;
|
|
Node2 := TmpNode;
|
|
end;
|
|
end
|
|
else begin
|
|
y2 := y;
|
|
i2 := i;
|
|
TmpNode := HL.FoldNodeInfo[y2].NodeInfoEx(i2 + 1, [sfaMarkup]);
|
|
if (not (sfaInvalid in TmpNode.FoldAction)) and
|
|
(TmpNode.LogXStart = Node2.LogXStart) and (TmpNode.LogXEnd = Node2.LogXEnd)
|
|
then begin
|
|
// triple node => 3rd start before current start
|
|
TmpNode := FindStartNode(TmpNode, y2, i2);
|
|
if (not (sfaInvalid in TmpNode.FoldAction)) then begin
|
|
Node3 := Node2;
|
|
Node2 := Node1;
|
|
Node1 := TmpNode;
|
|
end;
|
|
end
|
|
end;
|
|
|
|
Word1.Y := Node1.LineIndex + 1;
|
|
Word1.X := Node1.LogXStart + 1;
|
|
Word1.X2 := Node1.LogXEnd + 1;
|
|
Word2.Y := Node2.LineIndex + 1;
|
|
Word2.X := Node2.LogXStart + 1;
|
|
Word2.X2 := Node2.LogXEnd + 1;
|
|
if not(sfaInvalid in Node3.FoldAction) then
|
|
begin
|
|
Word3.Y := Node3.LineIndex + 1;
|
|
Word3.X := Node3.LogXStart + 1;
|
|
Word3.X2 := Node3.LogXEnd + 1;
|
|
end;
|
|
|
|
if Word1.Y > 0 then begin
|
|
Word1.X := Lines.LogicalToPhysicalPos(Point(Word1.X, Word1.Y)).X;
|
|
Word1.X2 := Lines.LogicalToPhysicalPos(Point(Word1.X2, Word1.Y)).X;
|
|
end;
|
|
if Word2.Y > 0 then begin
|
|
Word2.X := Lines.LogicalToPhysicalPos(Point(Word2.X, Word2.Y)).X;
|
|
Word2.X2 := Lines.LogicalToPhysicalPos(Point(Word2.X2, Word2.Y)).X;
|
|
end;
|
|
if Word3.Y > 0 then begin
|
|
Word3.X := Lines.LogicalToPhysicalPos(Point(Word3.X, Word3.Y)).X;
|
|
Word3.X2 := Lines.LogicalToPhysicalPos(Point(Word3.X2, Word3.Y)).X;
|
|
end;
|
|
end;
|
|
|
|
procedure TSynEditMarkupWordGroup.DoCaretChanged(Sender: TObject);
|
|
var
|
|
C: TPoint;
|
|
begin
|
|
if Caret = nil then exit;
|
|
C := Caret.LineCharPos;
|
|
if ( (C.Y = FHighlightPos1.Y) and (C.X >= FHighlightPos1.X) and (C.X <= FHighlightPos1.X2) ) or
|
|
( (C.Y = FHighlightPos2.Y) and (C.X >= FHighlightPos2.X) and (C.X <= FHighlightPos2.X2) ) or
|
|
( (C.Y = FHighlightPos3.Y) and (C.X >= FHighlightPos3.X) and (C.X <= FHighlightPos3.X2) ) then
|
|
exit;
|
|
InvalidateCurrentHighlight;
|
|
end;
|
|
|
|
procedure TSynEditMarkupWordGroup.DoTopLineChanged(OldTopLine: Integer);
|
|
begin
|
|
end;
|
|
|
|
procedure TSynEditMarkupWordGroup.DoLinesInWindoChanged(OldLinesInWindow: Integer);
|
|
begin
|
|
end;
|
|
|
|
procedure TSynEditMarkupWordGroup.DoTextChanged(StartLine, EndLine: Integer);
|
|
begin
|
|
InvalidateCurrentHighlight;
|
|
end;
|
|
|
|
procedure TSynEditMarkupWordGroup.DoMarkupChanged(AMarkup: TSynSelectedColor);
|
|
begin
|
|
FForceInvalidate := True;
|
|
InvalidateCurrentHighlight;
|
|
end;
|
|
|
|
procedure TSynEditMarkupWordGroup.InvalidateCurrentHighlight;
|
|
var
|
|
NewPos, NewAntiPos, NewMiddlePos : TWordPoint;
|
|
begin
|
|
FNeedInvalidate := True;
|
|
if (Caret = nil) or (not SynEdit.HandleAllocated) or (FPaintLock > 0) then
|
|
exit;
|
|
|
|
FNeedInvalidate := False;
|
|
FindMatchingWords(Caret.LineCharPos, NewPos, NewAntiPos, NewMiddlePos);
|
|
|
|
// invalidate old highlighting, if changed
|
|
if (FHighlightPos1.Y > 0)
|
|
and ((CompareWordPoints(FHighlightPos1, NewPos) <> 0) or FForceInvalidate)
|
|
then
|
|
InvalidateSynLines(FHighlightPos1.Y,FHighlightPos1.Y);
|
|
|
|
if (FHighlightPos2.Y > 0)
|
|
and ((CompareWordPoints(FHighlightPos2, NewAntiPos) <> 0) or FForceInvalidate)
|
|
then
|
|
InvalidateSynLines(FHighlightPos2.Y,FHighlightPos2.Y);
|
|
|
|
if (FHighlightPos3.Y > 0)
|
|
and ((CompareWordPoints(FHighlightPos3, NewMiddlePos) <> 0) or FForceInvalidate)
|
|
then
|
|
InvalidateSynLines(FHighlightPos3.Y,FHighlightPos3.Y);
|
|
|
|
FForceInvalidate := False;
|
|
|
|
// invalidate new highlighting, if changed
|
|
if (NewPos.Y>0)
|
|
and (CompareWordPoints(FHighlightPos1, NewPos) <> 0) then
|
|
InvalidateSynLines(NewPos.Y, NewPos.Y);
|
|
|
|
if (NewAntiPos.Y>0)
|
|
and (CompareWordPoints(FHighlightPos2, NewAntiPos) <> 0) then
|
|
InvalidateSynLines(NewAntiPos.Y, NewAntiPos.Y);
|
|
|
|
if (NewMiddlePos.Y>0)
|
|
and (CompareWordPoints(FHighlightPos3, NewMiddlePos) <> 0) then
|
|
InvalidateSynLines(NewMiddlePos.Y, NewMiddlePos.Y);
|
|
|
|
FHighlightPos1 := NewPos;
|
|
FHighlightPos2 := NewAntiPos;
|
|
FHighlightPos3 := NewMiddlePos;
|
|
// DebugLn('TCustomSynEdit.InvalidateCurrentHighlight C P=',dbgs(NewPos),' A=',dbgs(NewAntiPos), ' LP=',dbgs(fLogicalPos),' LA',dbgs(fLogicalAntiPos));
|
|
end;
|
|
|
|
function TSynEditMarkupWordGroup.GetMarkupAttributeAtRowCol(const aRow, aCol: Integer) : TSynSelectedColor;
|
|
begin
|
|
Result := nil;
|
|
if (FHighlightPos1.y = aRow) and
|
|
(aCol >= FHighlightPos1.x) and (aCol < FHighlightPos1.X2) then
|
|
begin
|
|
Result := MarkupInfo;
|
|
MarkupInfo.StartX := FHighlightPos1.x;
|
|
MarkupInfo.EndX := FHighlightPos1.X2 - 1;
|
|
end
|
|
else
|
|
if (FHighlightPos3.y = aRow) and
|
|
(aCol >= FHighlightPos3.x) and (aCol < FHighlightPos3.X2) then
|
|
begin
|
|
Result := MarkupInfo;
|
|
MarkupInfo.StartX := FHighlightPos3.x;
|
|
MarkupInfo.EndX := FHighlightPos3.X2 - 1;
|
|
end
|
|
else
|
|
if (FHighlightPos2.y = aRow) and
|
|
(aCol >= FHighlightPos2.x) and (aCol < FHighlightPos2.X2) then
|
|
begin
|
|
Result := MarkupInfo;
|
|
MarkupInfo.StartX := FHighlightPos2.x;
|
|
MarkupInfo.EndX := FHighlightPos2.X2 - 1;
|
|
end;
|
|
end;
|
|
|
|
function TSynEditMarkupWordGroup.GetNextMarkupColAfterRowCol(const aRow, aCol: Integer) : Integer;
|
|
Procedure CheckCol(Column: Integer; var Result: Integer);
|
|
begin
|
|
if (Column <= aCol) or ((Result >= 0) and (Result < Column)) then exit;
|
|
Result := Column;
|
|
end;
|
|
begin
|
|
Result := -1;
|
|
if (FHighlightPos1.y = aRow) then begin
|
|
CheckCol(FHighlightPos1.X, Result);
|
|
CheckCol(FHighlightPos1.X2, Result);
|
|
end;
|
|
if (FHighlightPos3.y = aRow) then begin
|
|
CheckCol(FHighlightPos3.X, Result);
|
|
CheckCol(FHighlightPos3.X2, Result);
|
|
end;
|
|
if (FHighlightPos2.y = aRow) then begin
|
|
CheckCol(FHighlightPos2.X, Result);
|
|
CheckCol(FHighlightPos2.X2, Result);
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|