lazarus/ide/sourcesyneditor.pas

3450 lines
112 KiB
ObjectPascal

{
/***************************************************************************
SourceSynEditor
-------------------
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
Abstract:
SynEdit extensions for the IDE
- DebugMarks: Mark lines with debug info
}
unit SourceSynEditor;
{$mode objfpc}{$H+}
interface
{$IFDEF Windows}
{$IFnDEF WithoutWinIME}
{$DEFINE WinIME}
{$ENDIF}
{$ENDIF}
{$I ide.inc}
uses
LazSynIMMBase,
{$IFDEF WinIME}
LazSynIMM,
{$ENDIF}
Classes, SysUtils,
// LCL
Controls, LCLType, Graphics, Menus, ImgList,
LazLoggerBase,
// synedit
SynEdit, SynEditMiscClasses, SynGutter, SynGutterBase, SynEditMarks,
SynEditTypes, SynGutterLineNumber, SynGutterCodeFolding, SynGutterMarks,
SynGutterChanges, SynGutterLineOverview, SynEditMarkup,
SynEditMarkupGutterMark, SynEditMarkupSpecialLine, SynEditTextBuffer,
SynEditFoldedView, SynTextDrawer, SynEditTextBase, LazSynEditText,
SynPluginTemplateEdit, SynPluginSyncroEdit, LazSynTextArea,
SynEditHighlighter, SynEditHighlighterFoldBase, SynHighlighterPas,
SynEditMarkupHighAll, SynEditKeyCmds, SynEditMarkupIfDef, SynEditMiscProcs,
SynPluginMultiCaret, SynEditPointClasses,
SynEditMarkupFoldColoring, SynEditTextTabExpander, SynEditMouseCmds, SynEditWrappedView,
etSrcEditMarks, LazarusIDEStrConsts, SourceMarks;
type
TIDESynGutterMarks = class;
{$IFDEF WithSynDebugGutter}
TIDESynGutterDebugHL = class;
{$ENDIF}
{ TSourceLazSynTopInfoView }
TSourceLazSynTopInfoView = class(TLazSynDisplayViewEx)
private
FLineMapCount: integer;
FLineMap: array of integer;
FSkipTextToView: Boolean;
function GetLineMap(Index: Integer): Integer;
procedure SetLineMap(Index: Integer; AValue: Integer);
procedure SetLineMapCount(AValue: integer);
public
procedure SetHighlighterTokensLine(ALine: TLineIdx; out ARealLine: TLineIdx; out ASubLineIdx, AStartBytePos, AStartPhysPos, ALineByteLen: Integer); override;
function GetLinesCount: Integer; override;
function TextToViewIndex(AIndex: TLineIdx): TLineRange; override;
function ViewToTextIndex(AIndex: TLineIdx): TLineIdx; override;
public
constructor Create;
procedure ClearLineMap;
property LineMapCount: integer read FLineMapCount write SetLineMapCount;
property LineMap[Index: Integer]: Integer read GetLineMap write SetLineMap;
end;
{ TSourceLazSynSurfaceGutter }
TSourceLazSynSurfaceGutter = class(TLazSynGutterArea)
private
procedure TextSizeChanged(Sender: TObject);
protected
procedure DoPaint(ACanvas: TCanvas; AClip: TRect); override;
procedure SetTextArea(ATextArea: TLazSynTextArea); override;
end;
{ TSourceLazSynSurfaceManager }
TSourceLazSynSurfaceManager = class(TLazSynSurfaceManager)
private
FExtraManager: TLazSynSurfaceManager;
FOriginalManager: TLazSynSurfaceManager;
FTopLineCount: Integer;
procedure SetTopLineCount(AValue: Integer);
protected
function GetLeftGutterArea: TLazSynSurfaceWithText; override;
function GetRightGutterArea: TLazSynSurfaceWithText; override;
function GetTextArea: TLazSynTextArea; override;
protected
procedure SetBackgroundColor(AValue: TColor); override;
procedure SetExtraCharSpacing(AValue: integer); override;
procedure SetExtraLineSpacing(AValue: integer); override;
procedure SetForegroundColor(AValue: TColor); override;
procedure SetPadding(Side: TLazSynBorderSide; AValue: integer); override;
procedure SetRightEdgeColor(AValue: TColor); override;
procedure SetRightEdgeColumn(AValue: integer); override;
procedure SetRightEdgeVisible(AValue: boolean); override;
procedure SetVisibleSpecialChars(AValue: TSynVisibleSpecialChars); override;
procedure SetHighlighter(AValue: TSynCustomHighlighter); override;
protected
procedure DoPaint(ACanvas: TCanvas; AClip: TRect); override;
procedure DoDisplayViewChanged; override;
procedure BoundsChanged; override;
public
constructor Create(AOwner: TWinControl; AnOriginalManager: TLazSynSurfaceManager);
destructor Destroy; override;
procedure InvalidateLines(FirstTextLine, LastTextLine: TLineIdx; AScreenLineOffset: Integer = 0); override;
procedure InvalidateTextLines(FirstTextLine, LastTextLine: TLineIdx; AScreenLineOffset: Integer = 0); override;
procedure InvalidateGutterLines(FirstTextLine, LastTextLine: TLineIdx; AScreenLineOffset: Integer = 0); override;
property ExtraManager: TLazSynSurfaceManager read FExtraManager write FExtraManager;
property OriginalManager: TLazSynSurfaceManager read FOriginalManager write FOriginalManager;
property TopLineCount: Integer read FTopLineCount write SetTopLineCount;
end;
{ TSourceSynSearchTermList }
TSourceSynSearchTermList = class(TSynSearchTermList)
public
function FindMatchFor(ATerm: String; ACasesSensitive: Boolean;
ABoundaries: TSynSearchTermOptsBounds;
AStartAtIndex: Integer = 0;
AIgnoreIndex: Integer = -1): Integer;
function FindSimilarMatchFor(ATerm: String; ACasesSensitive: Boolean;
ABoundaries: TSynSearchTermOptsBounds;
AEnabled: Boolean;
AStartAtIndex: Integer = 0;
AIgnoreIndex: Integer = -1;
AnOnlyWeakerOrEqual: Boolean = False;
AnSkipDisabled: Boolean = False): Integer; // weaker = matches less (subset of stronger)
function FindSimilarMatchFor(ATerm: TSynSearchTerm;
AStartAtIndex: Integer = 0;
AIgnoreIndex: Integer = -1;
AnOnlyWeakerOrEqual: Boolean = False;
AnSkipDisabled: Boolean = False): Integer; // weaker = matches less (subset of stronger)
procedure ClearSimilarMatches;
end;
{ TSourceSynSearchTermDict }
TSourceSynSearchTermDict = class(TSynSearchTermDict)
private
FModifiedTerms: TSynSearchTermList;
FAddedByKeyWords: TSynSearchTermList;
FFirstLocal: Integer;
function GetTerms: TSourceSynSearchTermList;
function AddSearchTerm(ATerm: String): Integer;
public
constructor Create(ATermListClass: TSynSearchTermListClass);
destructor Destroy; override;
procedure AddTermByKey(ATerm: String; ACaseSensitive: Boolean;
ABounds: TSynSearchTermOptsBounds);
procedure RemoveTermByKey(RemoveIdx: Integer);
procedure RestoreLocalChanges;
property Terms: TSourceSynSearchTermList read GetTerms;
end;
{ TSourceSynEditMarkupHighlightAllMulti }
TSourceSynEditMarkupHighlightAllMulti = class(TSynEditMarkupHighlightAllMulti)
private
FAddTermCmd: TSynEditorCommand;
FKeyAddCase: Boolean;
FKeyAddSelectBoundMaxLen: Integer;
FKeyAddSelectSmart: Boolean;
FKeyAddWordBoundMaxLen: Integer;
FKeyAddTermBounds: TSynSearchTermOptsBounds;
FRemoveTermCmd: TSynEditorCommand;
FToggleTermCmd: TSynEditorCommand;
procedure ProcessSynCommand(Sender: TObject; {%H-}AfterProcessing: boolean;
var Handled: boolean; var Command: TSynEditorCommand;
var {%H-}AChar: TUTF8Char; {%H-}Data: pointer; {%H-}HandlerData: pointer);
protected
function CreateTermsList: TSynSearchTermDict; override;
public
constructor Create(ASynEdit: TSynEditBase);
destructor Destroy; override;
procedure RestoreLocalChanges;
property AddTermCmd: TSynEditorCommand read FAddTermCmd write FAddTermCmd;
property RemoveTermCmd: TSynEditorCommand read FRemoveTermCmd write FRemoveTermCmd;
property ToggleTermCmd: TSynEditorCommand read FToggleTermCmd write FToggleTermCmd;
property KeyAddTermBounds: TSynSearchTermOptsBounds read FKeyAddTermBounds write FKeyAddTermBounds;
property KeyAddCase: Boolean read FKeyAddCase write FKeyAddCase;
property KeyAddWordBoundMaxLen: Integer read FKeyAddWordBoundMaxLen write FKeyAddWordBoundMaxLen;
property KeyAddSelectBoundMaxLen: Integer read FKeyAddSelectBoundMaxLen write FKeyAddSelectBoundMaxLen;
property KeyAddSelectSmart: Boolean read FKeyAddSelectSmart write FKeyAddSelectSmart;
end;
TSourceSynEditMarkupIfDef = class(TSynEditMarkupIfDef)
public
property IfDefTree;
end;
TIdentWindowAhaColorRange = ahaIdentComplWindow..ahaIdentComplWindowEntryUnknown;
{ TSynMarkupIdentComplWindow }
TSynMarkupIdentComplWindow = class // don't inherit from TSynEditMarkup, no regular markup
private
FColor: array[TIdentWindowAhaColorRange] of TSynHighlighterAttributes;
FUseRecent: boolean;
function GetColor(AnIndex: TIdentWindowAhaColorRange): TSynHighlighterAttributes;
function GetForegroundColor(AnIndex: TAdditionalHilightAttribute): TColor;
function GetBackgroundColor(AnIndex: TAdditionalHilightAttribute): TColor;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Merge(AColors: TSynMarkupIdentComplWindow);
public
property Color [AnIndex: TIdentWindowAhaColorRange]: TSynHighlighterAttributes read GetColor; default;
property TextColor: TColor index ahaIdentComplWindow read GetForegroundColor;
property BackgroundColor: TColor index ahaIdentComplWindow read GetBackgroundColor;
property TextSelectedColor: TColor index ahaIdentComplWindowSelection read GetForegroundColor;
property BackgroundSelectedColor: TColor index ahaIdentComplWindowSelection read GetBackgroundColor;
property TextHilightColor : TColor index ahaIdentComplWindowHighlight read GetForegroundColor;
property RecentColor: TColor index ahaIdentComplRecent read GetForegroundColor;
property UseRecent: boolean read FUseRecent write FUseRecent;
end;
TSrcSynTopLineInfo = record
Line, Subline: IntIdx;
end;
{ TIDESynEditor }
TIDESynEditor = class(TSynEdit)
private
FCaretColor: TColor;
FCaretStamp: Int64;
FMarkupIdentComplWindow: TSynMarkupIdentComplWindow;
FShowTopInfo: boolean;
FFoldView: TSynEditFoldedView;
FWrapView: TLazSynEditLineWrapPlugin;
FTopInfoNestList: TLazSynEditNestedFoldsList;
FSyncroEdit: TSynPluginSyncroEdit;
FTemplateEdit: TSynPluginTemplateEdit;
FMultiCaret: TSynPluginMultiCaret;
FMarkupForGutterMark: TSynEditMarkupGutterMark;
FOnIfdefNodeStateRequest: TSynMarkupIfdefStateRequest;
FMarkupIfDef: TSourceSynEditMarkupIfDef;
FTopInfoDisplay: TSourceLazSynTopInfoView;
FMouseTopLineDownPos: TPoint;
FTopInfoLastTopLine: Integer;
FSrcSynCaretChangedLock, FSrcSynCaretChangedNeeded: boolean;
FExtraMarkupLine: TSynEditMarkupSpecialLine;
FExtraMarkupMgr: TSynEditMarkupManager;
FTopInfoMarkup: TSynSelectedColor;
FUserWordsList: TFPList;
function CatchMouseForTopInforLine(var AnInfo: TSynEditMouseActionInfo;
HandleActionProc: TSynEditMouseActionHandler): Boolean;
function DoIfDefNodeStateRequest(Sender: TObject; LinePos,
XStartPos: Integer; CurrentState: TSynMarkupIfdefNodeStateEx): TSynMarkupIfdefNodeState;
function GetHighlightUserWordCount: Integer;
function GetHighlightUserWords(AIndex: Integer): TSourceSynEditMarkupHighlightAllMulti;
function GetIDEGutterMarks: TIDESynGutterMarks;
function GetIsInMultiCaretMainExecution: Boolean;
function GetIsInMultiCaretRepeatExecution: Boolean;
function GetOnMultiCaretBeforeCommand: TSynMultiCaretBeforeCommand;
procedure GetTopInfoMarkupForLine(Sender: TObject; {%H-}Line: integer; var Special: boolean;
aMarkup: TSynSelectedColor);
procedure SetCaretColor(AValue: TColor);
procedure SetHighlightUserWordCount(AValue: Integer);
procedure SetOnMultiCaretBeforeCommand(AValue: TSynMultiCaretBeforeCommand);
procedure SetShowTopInfo(AValue: boolean);
procedure SetTopInfoMarkup(AValue: TSynSelectedColor);
procedure DoHighlightChanged(Sender: TSynEditStrings; {%H-}AIndex, {%H-}ACount : Integer);
function GetWordWrapEnabled: Boolean;
procedure SetWordWrapCaretWrapPos(AValue: TLazSynEditWrapCaretPos);
procedure SetWordWrapEnabled(AValue: Boolean);
procedure SetWordWrapForceHomeEnd(AValue: Boolean);
procedure SetWordWrapIndent(AValue: Integer);
procedure SetWordWrapIndentMax(AValue: Integer);
procedure SetWordWrapIndentMaxRel(AValue: Integer);
procedure SetWordWrapIndentMin(AValue: Integer);
procedure SetWordWrapIndentUseOffset(AValue: boolean);
procedure SetWordWrapMaxWidth(AValue: Integer);
procedure SetWordWrapMinWidth(AValue: Integer);
procedure SrcSynCaretChanged(Sender: TObject);
function GetHighlighter: TSynCustomFoldHighlighter;
protected
procedure DoOnStatusChange(Changes: TSynStatusChanges); override;
function CreateGutter(AOwner : TSynEditBase; ASide: TSynGutterSide;
ATextDrawer: TheTextDrawer): TSynGutter; override;
procedure SetHighlighter(const Value: TSynCustomHighlighter); override;
procedure AddLineWrapView;
procedure RemoveLineWrapView;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function TextIndexToViewPos(aTextIndex : Integer) : Integer; // Wrong name: argument is TextPos, not TextIdx
function GetTopLineBeforeFold: TSrcSynTopLineInfo;
procedure RestoreTopLineAfterFold(AnInfo: TSrcSynTopLineInfo);
property IDEGutterMarks: TIDESynGutterMarks read GetIDEGutterMarks;
property TopView;
property TextBuffer;
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;
{$IFDEF WinIME}
procedure CreateMinimumIme;
procedure CreateFullIme;
{$ENDIF}
property HighlightUserWordCount: Integer read GetHighlightUserWordCount write SetHighlightUserWordCount;
property HighlightUserWords[AIndex: Integer]: TSourceSynEditMarkupHighlightAllMulti read GetHighlightUserWords;
property MarkupMgr;
function IsIfdefMarkupActive: Boolean;
procedure InvalidateAllIfdefNodes;
procedure SetIfdefNodeState(ALinePos, AstartPos: Integer; AState: TSynMarkupIfdefNodeState);
property OnIfdefNodeStateRequest: TSynMarkupIfdefStateRequest read FOnIfdefNodeStateRequest write FOnIfdefNodeStateRequest;
property MarkupIfDef: TSourceSynEditMarkupIfDef read FMarkupIfDef;
property MarkupIdentComplWindow: TSynMarkupIdentComplWindow read FMarkupIdentComplWindow;
property IsInMultiCaretMainExecution: Boolean read GetIsInMultiCaretMainExecution;
property IsInMultiCaretRepeatExecution: Boolean read GetIsInMultiCaretRepeatExecution;
property OnMultiCaretBeforeCommand: TSynMultiCaretBeforeCommand read GetOnMultiCaretBeforeCommand write SetOnMultiCaretBeforeCommand;
property CaretStamp: Int64 read FCaretStamp;
property CaretColor: TColor read FCaretColor write SetCaretColor;
property WrapView: TLazSynEditLineWrapPlugin read FWrapView;
property WordWrapEnabled: Boolean read GetWordWrapEnabled write SetWordWrapEnabled;
property WordWrapCaretWrapPos: TLazSynEditWrapCaretPos write SetWordWrapCaretWrapPos;
property WordWrapForceHomeEnd: Boolean write SetWordWrapForceHomeEnd;
property WordWrapMinWidth: Integer write SetWordWrapMinWidth;
property WordWrapMaxWidth: Integer write SetWordWrapMaxWidth;
property WordWrapIndent: Integer write SetWordWrapIndent;
property WordWrapIndentUseOffset: boolean write SetWordWrapIndentUseOffset;
property WordWrapIndentMin: Integer write SetWordWrapIndentMin;
property WordWrapIndentMax: Integer write SetWordWrapIndentMax;
property WordWrapIndentMaxRel: Integer write SetWordWrapIndentMaxRel;
end;
TIDESynHighlighterPasRangeList = class(TSynHighlighterPasRangeList)
protected
FInterfaceLine, FImplementationLine,
FInitializationLine, FFinalizationLine: Integer;
end;
{ TSynHighlighterLazCustomPasAttribute }
TSynHighlighterLazCustomPasAttribute = class(TSynHighlighterAttributesModifier)
private
FCustomWords: TStrings;
FCustomWordTokenKind: TtkTokenKind;
procedure DoWordsChanged(Sender: TObject);
procedure SetCustomWordTokenKind(AValue: TtkTokenKind);
protected
procedure AssignFrom(Src: TLazSynCustomTextAttributes); override;
procedure DoClear; override;
procedure Init; override;
public
destructor Destroy; override;
property CustomWords: TStrings read FCustomWords;
published
property CustomWordTokenKind: TtkTokenKind read FCustomWordTokenKind write SetCustomWordTokenKind;
end;
{ TIDESynPasSyn }
TIDESynPasSyn = class(TSynPasSyn)
private
FCustomAttribs: array[0..9] of TSynHighlighterLazCustomPasAttribute;
procedure DoBuildCustomPasAttr(Sender: TObject);
function GetFinalizationLine: Integer;
function GetImplementationLine: Integer;
function GetInitializationLine: Integer;
function GetInterfaceLine: Integer;
protected
function CreateRangeList({%H-}ALines: TSynEditStringsBase): TSynHighlighterRangeList; override;
function StartCodeFoldBlock(ABlockType: Pointer = nil;
IncreaseLevel: Boolean = true; ForceDisabled: Boolean = False
): TSynCustomCodeFoldBlock; override;
public
constructor Create(AOwner: TComponent); override;
//procedure DefHighlightChange(Sender: TObject);
procedure SetLine({$IFDEF FPC}const {$ENDIF}NewValue: string;
LineNumber: Integer); override;
property InterfaceLine: Integer read GetInterfaceLine;
property ImplementationLine: Integer read GetImplementationLine;
property InitializationLine: Integer read GetInitializationLine;
property FinalizationLine: Integer read GetFinalizationLine;
end;
{ TIDESynFreePasSyn }
TIDESynFreePasSyn = class(TIDESynPasSyn)
public
constructor Create(AOwner: TComponent); override;
procedure ResetRange; override;
end;
{ TIDESynGutterLOvProviderPascal }
TIDESynGutterLOvProviderPascal = class(TSynGutterLineOverviewProvider)
private
FColor2: TColor;
FInterfaceLine, FImplementationLine,
FInitializationLine, FFinalizationLine: Integer;
FPixInterfaceLine, FPixImplementationLine,
FPixInitializationLine, FPixFinalizationLine: Integer;
FPixEndInterfaceLine, FPixEndImplementationLine,
FPixEndInitializationLine, FPixEndFinalizationLine: Integer;
FSingleLine: Boolean;
FRGBColor2: TColorRef;
procedure SetColor2(const AValue: TColor);
procedure SetSingleLine(const AValue: Boolean);
protected
procedure BufferChanged(Sender: TObject);
procedure HighlightChanged(Sender: TSynEditStrings; {%H-}AIndex, {%H-}ACount : Integer);
procedure ReCalc; override;
procedure Paint(Canvas: TCanvas; AClip: TRect; TopOffset: integer); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property SingleLine: Boolean read FSingleLine write SetSingleLine;
property Color2: TColor read FColor2 write SetColor2;
end;
{ TIDESynGutterLOvProviderIDEMarks }
TIDESynGutterLOvProviderIDEMarks = class(TSynGutterLOvProviderBookmarks)
// Bookmarks and breakpoints
private
FBreakColor: TColor;
FBreakDisabledColor: TColor;
FExecLineColor: TColor;
FRGBBreakColor: TColorRef;
FRGBBreakDisabledColor: TColor;
FRGBExecLineColor: TColor;
procedure SetBreakColor(const AValue: TColor);
procedure SetBreakDisabledColor(AValue: TColor);
procedure SetExecLineColor(AValue: TColor);
protected
procedure AdjustColorForMark(AMark: TSynEditMark; var AColor: TColor; var APriority: Integer); override;
public
constructor Create(AOwner: TComponent); override;
published
property BreakColor: TColor read FBreakColor write SetBreakColor;
property BreakDisabledColor: TColor read FBreakDisabledColor write SetBreakDisabledColor;
property ExecLineColor: TColor read FExecLineColor write SetExecLineColor;
end;
{ TIDESynGutter }
TIDESynGutter = class(TSynGutter)
protected
procedure CreateDefaultGutterParts; override;
public
{$IFDEF WithSynDebugGutter}
DebugGutter: TIDESynGutterDebugHL;
{$ENDIF}
end;
{ TIDESynDebugMarkInfo }
TIDESynDebugMarkInfo = class(TSynManagedStorageMem)
private
FRefCount: Integer;
function GetSrcLineToMarkLine(SrcIndex: Integer): Integer;
procedure SetSrcLineToMarkLine(SrcIndex: Integer; const AValue: Integer);
public
constructor Create;
procedure IncRefCount;
procedure DecRefCount;
// Index is the Current line-index (0 based) in editor (including source modification)
// Result is the original Line-pos (1 based) as known by the debugger
property SrcLineToMarkLine[SrcIndex: Integer]: Integer
read GetSrcLineToMarkLine write SetSrcLineToMarkLine; default;
property RefCount: Integer read FRefCount;
end;
{ TIDESynGutterMarks }
TIDESynGutterMarks = class(TSynGutterMarks)
private
FDebugMarkInfo: TIDESynDebugMarkInfo;
FMarkInfoTextBuffer: TSynEditStrings;
FCurLineHasDebugMark: boolean;
protected
procedure CheckTextBuffer; // Todo: Add a notification, when TextBuffer Changes
Procedure PaintLine(aScreenLine: Integer; Canvas : TCanvas; AClip : TRect); override;
function PreferedWidthAtCurrentPPI: Integer; override;
function GetImgListRes(const ACanvas: TCanvas;
const AImages: TCustomImageList): TScaledImageListResolution; override;
function MarksToDrawInfo(AMLine: TSynEditMarkLine; var ADrawInfo: TSynEditMarkDrawInfoArray;
AMaxEntries: integer; out aFirstCustomColumnIdx: integer; out AHasNonBookmark: boolean
): integer; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure BeginSetDebugMarks;
procedure EndSetDebugMarks;
procedure SetDebugMarks(AFirstLinePos, ALastLinePos: Integer);
procedure ClearDebugMarks;
function HasDebugMarks: Boolean;
function DebugLineToSourceLine(aLinePos: Integer): Integer;
function SourceLineToDebugLine(aLinePos: Integer; AdjustOnError: Boolean = False): Integer;
end;
{ TIDESynGutterCodeFolding }
TIDESynGutterCodeFolding = class(TSynGutterCodeFolding)
protected
procedure UnFoldIfdef(AInclDisabled, AInclEnabled: Boolean);
procedure FoldIfdef(AInclTemp: Boolean);
procedure PopClickedUnfoldAll(Sender: TObject);
procedure PopClickedUnfoldComment(Sender: TObject);
procedure PopClickedFoldComment(Sender: TObject);
procedure PopClickedHideComment(Sender: TObject);
procedure PopClickedFoldIfdef(Sender: TObject);
procedure PopClickedFoldIfdefNoMixed(Sender: TObject);
procedure PopClickedUnfoldIfdefActive(Sender: TObject);
procedure PopClickedUnfolDIfdefAll(Sender: TObject);
procedure PopClickedUnfoldIfdefInactiv(Sender: TObject);
procedure CreatePopUpMenuEntries(var APopUp: TPopupMenu; ALine: Integer); override;
end;
{$IFDEF WithSynDebugGutter}
{ TIDESynGutterDebugHL }
TIDESynGutterDebugHL = class(TSynGutterPartBase)
procedure PopContentClicked(Sender: TObject);
procedure PopSizeClicked(Sender: TObject);
private
FTheLinesView: TSynEditStrings;
FPopUp: TPopupMenu;
FContent: Integer;
protected
function PreferedWidth: Integer; override;
function MaybeHandleMouseAction(var AnInfo: TSynEditMouseActionInfo;
HandleActionProc: TSynEditMouseActionHandler): Boolean; override;
procedure PaintFoldLvl(Canvas: TCanvas; AClip: TRect; FirstLine, LastLine: integer);
procedure PaintCharWidths(Canvas: TCanvas; AClip: TRect; FirstLine, LastLine: integer);
public
constructor Create(AOwner: TComponent); override;
procedure Paint(Canvas: TCanvas; AClip: TRect; FirstLine, LastLine: integer);
override;
property TheLinesView: TSynEditStrings read FTheLinesView write FTheLinesView;
end;
{$ENDIF}
implementation
{ TSynMarkupIdentComplWindow }
function TSynMarkupIdentComplWindow.GetColor(AnIndex: TIdentWindowAhaColorRange
): TSynHighlighterAttributes;
begin
Result := FColor[AnIndex];
end;
function TSynMarkupIdentComplWindow.GetForegroundColor(AnIndex: TAdditionalHilightAttribute
): TColor;
begin
Result := FColor[AnIndex].Foreground;
end;
function TSynMarkupIdentComplWindow.GetBackgroundColor(AnIndex: TAdditionalHilightAttribute
): TColor;
begin
Result := FColor[AnIndex].Background
end;
constructor TSynMarkupIdentComplWindow.Create;
var
i: TIdentWindowAhaColorRange;
begin
inherited Create;
for i := low(TIdentWindowAhaColorRange) to high(TIdentWindowAhaColorRange) do
FColor[i] := TSynHighlighterAttributes.Create;
Clear;
end;
destructor TSynMarkupIdentComplWindow.Destroy;
var
i: TIdentWindowAhaColorRange;
begin
inherited Destroy;
for i := low(TIdentWindowAhaColorRange) to high(TIdentWindowAhaColorRange) do
FColor[i].Free;
end;
procedure TSynMarkupIdentComplWindow.Clear;
var
i: TIdentWindowAhaColorRange;
begin
FUseRecent := False;
for i := low(TIdentWindowAhaColorRange) to high(TIdentWindowAhaColorRange) do begin
FColor[i].Foreground := clNone;
FColor[i].Background := clNone;
end;
end;
procedure TSynMarkupIdentComplWindow.Merge(AColors: TSynMarkupIdentComplWindow);
var
i: TIdentWindowAhaColorRange;
begin
for i := low(TIdentWindowAhaColorRange) to high(TIdentWindowAhaColorRange) do begin
if AColors[i].Foreground <> clNone then
FColor[i].Foreground := AColors.FColor[i].Foreground;
if AColors[i].Background <> clNone then
FColor[i].Background := AColors.FColor[i].Background;
end;
end;
{ TSourceSynSearchTermDict }
function TSourceSynSearchTermDict.GetTerms: TSourceSynSearchTermList;
begin
Result := TSourceSynSearchTermList(inherited Terms);
end;
function TSourceSynSearchTermDict.AddSearchTerm(ATerm: String): Integer;
var
Itm: TSynSearchTerm;
begin
Itm := Terms.Add;
Itm.SearchTerm := ATerm;
Result := Itm.Index;
end;
constructor TSourceSynSearchTermDict.Create(ATermListClass: TSynSearchTermListClass);
begin
inherited Create(ATermListClass);
FModifiedTerms := TSynSearchTermList.Create;
FAddedByKeyWords := TSynSearchTermList.Create;
end;
destructor TSourceSynSearchTermDict.Destroy;
begin
inherited Destroy;
FreeAndNil(FModifiedTerms);
FreeAndNil(FAddedByKeyWords);
end;
procedure TSourceSynSearchTermDict.AddTermByKey(ATerm: String; ACaseSensitive: Boolean;
ABounds: TSynSearchTermOptsBounds);
var
i, j, PresetIdx: Integer;
begin
// check for pre-defined, compare text only
PresetIdx := Terms.IndexOfSearchTerm(ATerm, False);
if PresetIdx >= FFirstLocal then
PresetIdx := -1;
// Disable or remove weaker terms
i := Terms.FindSimilarMatchFor(ATerm, ACaseSensitive, ABounds, True, 0, -1, True, True);
while i >= 0 do begin
if i >= FFirstLocal then begin
j := FAddedByKeyWords.IndexOfSearchTerm(Terms[i]);
Terms.Delete(i);
if j >= 0 then
FAddedByKeyWords.Delete(j);
end
else begin
Terms[i].Enabled := False;
j := FModifiedTerms.IndexOfSearchTerm(Terms[i]);
if j < 0 then
FModifiedTerms.Add.Assign(Terms[i])
else
FModifiedTerms[j].Assign(Terms[i]);
end;
i := Terms.FindSimilarMatchFor(ATerm, ACaseSensitive, ABounds, True, 0, -1, True, True);
end;
if PresetIdx >= 0 then begin
while PresetIdx >= 0 do begin
Terms[PresetIdx].Enabled := True;
j := FModifiedTerms.IndexOfSearchTerm(Terms[PresetIdx]);
if j < 0 then
FModifiedTerms.Add.Assign(Terms[PresetIdx])
else
FModifiedTerms[j].Assign(Terms[PresetIdx]);
PresetIdx := Terms.IndexOfSearchTerm(ATerm, False, PresetIdx+1);
if PresetIdx >= FFirstLocal then
PresetIdx := -1;
end;
end
else begin
// Could be adding selection that is not at bounds, but forcing bounds
if Terms.FindMatchFor(ATerm, ACaseSensitive, ABounds) >= FFirstLocal then
exit;
i := AddSearchTerm(ATerm);
Terms[i].MatchCase := ACaseSensitive;
Terms[i].MatchWordBounds := ABounds;
FAddedByKeyWords.Add.Assign(Terms[i]);
end;
end;
procedure TSourceSynSearchTermDict.RemoveTermByKey(RemoveIdx: Integer);
var
i: Integer;
begin
if RemoveIdx >= FFirstLocal then begin
i := FAddedByKeyWords.IndexOfSearchTerm(Terms[RemoveIdx]);
Assert(i >= 0, 'FAddedByKeyWords.IndexOfSearchTerm(Terms[RemoveIdx])');
FAddedByKeyWords.Delete(i);
Terms.Delete(RemoveIdx);
end
else begin
Terms[RemoveIdx].Enabled := False;
i := FModifiedTerms.IndexOfSearchTerm(Terms[RemoveIdx]);
if i < 0 then
FModifiedTerms.Add.Assign(Terms[RemoveIdx])
else
FModifiedTerms[i].Assign(Terms[RemoveIdx]);
end;
end;
procedure TSourceSynSearchTermDict.RestoreLocalChanges;
var
i, j, k: Integer;
begin
FFirstLocal := Terms.Count;
IncChangeNotifyLock;
try
for i := FModifiedTerms.Count - 1 downto 0 do begin
j := Terms.IndexOfSearchTerm(FModifiedTerms[i]);
if (j < 0) or (Terms[j].Enabled = FModifiedTerms[i].Enabled) then
FModifiedTerms.Delete(i)
else
Terms[j].Enabled := FModifiedTerms[i].Enabled;
end;
for i := 0 to FAddedByKeyWords.Count - 1 do begin
// disable global (there may be new globals)
j := Terms.FindSimilarMatchFor(FAddedByKeyWords[i], 0, -1, True, True);
while j >= 0 do begin
Assert(j < FFirstLocal, 'DISABLE preset in RESTORE j < FFirstLocal');
if j < FFirstLocal then begin // should always be true
DebugLn(['DISABLE preset in RESTORE ',j]);
Terms[j].Enabled := False;
k := FModifiedTerms.IndexOfSearchTerm(Terms[j]);
if k < 0 then
FModifiedTerms.Add.Assign(Terms[j])
else
FModifiedTerms[k].Assign(Terms[j]);
end;
j := Terms.FindSimilarMatchFor(FAddedByKeyWords[i], 0, -1, True, True);
end;
Terms.Add.Assign(FAddedByKeyWords[i]);
end;
finally
DecChangeNotifyLock;
end;
end;
{ TSourceSynSearchTermList }
function TSourceSynSearchTermList.FindMatchFor(ATerm: String; ACasesSensitive: Boolean;
ABoundaries: TSynSearchTermOptsBounds; AStartAtIndex: Integer;
AIgnoreIndex: Integer): Integer;
var
c: Integer;
Entry: TSynSearchTerm;
begin
Result := AStartAtIndex - 1;
c := Count - 1;
while Result < c do begin
inc(Result);
if Result = AIgnoreIndex then
continue;
Entry := Items[Result];
if (ATerm = Entry.SearchTerm) and
(ACasesSensitive = Entry.MatchCase) and
(ABoundaries = Entry.MatchWordBounds)
then
exit;
end;
Result := -1;
end;
function TSourceSynSearchTermList.FindSimilarMatchFor(ATerm: String; ACasesSensitive: Boolean;
ABoundaries: TSynSearchTermOptsBounds; AEnabled: Boolean; AStartAtIndex: Integer;
AIgnoreIndex: Integer; AnOnlyWeakerOrEqual: Boolean; AnSkipDisabled: Boolean): Integer;
var
c: Integer;
Entry: TSynSearchTerm;
WeakerByEnabled, WeakerByCase, WeakerByBounds: (wParam, wEntry, wEqual);
begin
Result := AStartAtIndex - 1;
c := Count - 1;
while Result < c do begin
inc(Result);
if Result = AIgnoreIndex then
continue;
Entry := Items[Result];
(* if one has soBoundsAtStart, and the other has soBoundsAtEnd then they
match 2 different sets, which may overlap
In all other cases, one will match a subset of the other
*)
if [ABoundaries, Entry.MatchWordBounds] = [soBoundsAtStart, soBoundsAtEnd] then
Continue; // Match different sets
if AnSkipDisabled and not Entry.Enabled then
Continue;
WeakerByEnabled := wEqual;
if (not Entry.Enabled) and AEnabled then WeakerByEnabled := wEntry;
if Entry.Enabled and (not AEnabled) then WeakerByEnabled := wParam;
if AnOnlyWeakerOrEqual and (WeakerByEnabled = wParam) then // Entry can not be weaker
continue;
if (ATerm <> Entry.SearchTerm) and
( (ACasesSensitive and Entry.MatchCase) or
(CompareText(ATerm, Entry.SearchTerm) <> 0)
)
then
continue;
// which one is weakerByCase?
WeakerByCase := wEqual;
if (ACasesSensitive) and (not Entry.MatchCase) then
WeakerByCase := wParam // param matches a sub-set of entry
else
if (not ACasesSensitive) and (Entry.MatchCase) then
WeakerByCase := wEntry; // Entry matches a sub-set of param
if AnOnlyWeakerOrEqual and (WeakerByCase = wParam) then // Entry can not be weaker
continue;
WeakerByBounds := wEqual;
case ABoundaries of
soNoBounds: begin
if Entry.MatchWordBounds <> soNoBounds then
WeakerByBounds := wEntry; // Entry matches less
end;
soBoundsAtStart, soBoundsAtEnd: begin // Combination of one at Start, other at End has already been filtered
if Entry.MatchWordBounds = soNoBounds then
WeakerByBounds := wParam
else
if Entry.MatchWordBounds = soBothBounds then
WeakerByBounds := wEntry;
end;
soBothBounds: begin
if Entry.MatchWordBounds <> soBothBounds then
WeakerByBounds := wParam;
end;
end;
if AnOnlyWeakerOrEqual and (WeakerByBounds = wParam) then // Entry can not be weaker
continue;
if ( ([WeakerByEnabled, WeakerByBounds, WeakerByCase] - [wEqual] = [wEntry]) or
([WeakerByEnabled, WeakerByBounds, WeakerByCase] - [wEqual] = [wParam]) or
([WeakerByEnabled, WeakerByBounds, WeakerByCase] = [wEqual])
)
then
exit;
end;
Result := -1;
end;
function TSourceSynSearchTermList.FindSimilarMatchFor(ATerm: TSynSearchTerm;
AStartAtIndex: Integer; AIgnoreIndex: Integer; AnOnlyWeakerOrEqual: Boolean;
AnSkipDisabled: Boolean): Integer;
begin
Result := FindSimilarMatchFor(ATerm.SearchTerm, ATerm.MatchCase, ATerm.MatchWordBounds,
ATerm.Enabled, AStartAtIndex, AIgnoreIndex, AnOnlyWeakerOrEqual, AnSkipDisabled);
end;
procedure TSourceSynSearchTermList.ClearSimilarMatches;
var
i, j: Integer;
begin
i := 0;
while (i < Count) do begin
j := FindSimilarMatchFor(Items[i].SearchTerm,
Items[i].MatchCase, Items[i].MatchWordBounds, Items[i].Enabled,
0, i, True);
if (j >= 0) then begin
Delete(j);
if j < i then // May have more than one weaker duplicate
dec(i);
end
else
inc(i);
end;
end;
{ TSourceSynEditMarkupHighlightAllMulti }
procedure TSourceSynEditMarkupHighlightAllMulti.ProcessSynCommand(Sender: TObject;
AfterProcessing: boolean; var Handled: boolean; var Command: TSynEditorCommand;
var AChar: TUTF8Char; Data: pointer; HandlerData: pointer);
var
syn: TIDESynEditor;
TermDict: TSourceSynSearchTermDict;
function FindTermAtCaret: Integer;
var
i, y, x, x1, x2: Integer;
s: string;
b1, b2: Boolean;
t: TSynSearchTerm;
begin
Result := -1;
y := syn.CaretY;
i := Matches.IndexOfFirstMatchForLine(y);
if i < 0 then exit;
x := syn.LogicalCaretXY.x;
while (i < Matches.Count) and (Matches[i].StartPoint.y <= y) do begin
if ((Matches[i].StartPoint.y < y) or (Matches[i].StartPoint.x <= x)) and
((Matches[i].EndPoint.y > y) or (Matches[i].EndPoint.x >= x))
then
break;
inc(i);
end;
if (i >= Matches.Count) or (Matches[i].StartPoint.y > y) or (Matches[i].StartPoint.x > x) then
exit;
x1 := Matches[i].StartPoint.x;
x2 := Matches[i].EndPoint.x;
//if Matches[i].StartPoint.y < y then x1 := 1; // only one liners allowed
s := syn.ViewedTextBuffer[y-1];
b1 := (x1 = 1) or (s[x1-1] in WordBreakChars);
b2 := (x2 > length(s)) or (s[x2] in WordBreakChars);
s := copy(s, x1, x2-x1);
Result := 0;
while Result < Terms.Count do begin
t := Terms[Result];
if t.Enabled and
( (t.SearchTerm = s) or
( (not t.MatchCase) and (CompareText(t.SearchTerm,s)=0) ) ) and
( (t.MatchWordBounds = soNoBounds) or
( (t.MatchWordBounds = soBoundsAtStart) and b1 ) or
( (t.MatchWordBounds = soBoundsAtEnd) and b2 ) or
( (t.MatchWordBounds = soBothBounds) and b1 and b2 )
)
then
exit;
inc(Result);
end;
assert(false, 'TSourceSynEditMarkupHighlightAllMulti match not found');
Result := -1; // Should never reach
end;
procedure AddTermByKey;
var
NewTerm, LineTxt: String;
B1, B2: Boolean;
NewBounds: TSynSearchTermOptsBounds;
begin
NewTerm := '';
B1 := False;
B2 := False;
if syn.SelAvail and (syn.BlockBegin.y = syn.BlockEnd.y) then begin
NewTerm := syn.SelText;
LineTxt := syn.Lines[syn.CaretY-1];
B1 := (KeyAddTermBounds in [soBoundsAtStart, soBothBounds]) and
( (KeyAddSelectBoundMaxLen < 1) or (length(NewTerm) <= KeyAddSelectBoundMaxLen) ) and
( (not KeyAddSelectSmart) or
( (Syn.BlockBegin.X <= 1) or (LineTxt[Syn.BlockBegin.X-1] in WordBreakChars) )
);
B2 := (KeyAddTermBounds in [soBoundsAtEnd, soBothBounds]) and
( (KeyAddSelectBoundMaxLen < 1) or (length(NewTerm) <= KeyAddSelectBoundMaxLen) ) and
( (not KeyAddSelectSmart) or
( (Syn.BlockEnd.X > length(LineTxt)) or (LineTxt[Syn.BlockEnd.X] in WordBreakChars) )
);
end
else
if not syn.SelAvail then begin
NewTerm := syn.GetWordAtRowCol(syn.LogicalCaretXY);
if NewTerm <> '' then begin
B1 := (KeyAddTermBounds in [soBoundsAtStart, soBothBounds]) and
( (KeyAddWordBoundMaxLen < 1) or (length(NewTerm) <= KeyAddWordBoundMaxLen) );
B2 := (KeyAddTermBounds in [soBoundsAtEnd, soBothBounds]) and
( (KeyAddWordBoundMaxLen < 1) or (length(NewTerm) <= KeyAddWordBoundMaxLen) );
end;
end;
if B1 and B2 then NewBounds := soBothBounds
else if B1 then NewBounds := soBoundsAtStart
else if B2 then NewBounds := soBoundsAtEnd
else NewBounds := soNoBounds;
TermDict.AddTermByKey(NewTerm, FKeyAddCase, NewBounds);
end;
var
i: Integer;
begin
if Handled then
exit;
syn := TIDESynEditor(SynEdit);
TermDict := (Terms as TSourceSynSearchTermDict);
TermDict.IncChangeNotifyLock;
try
if Command = FAddTermCmd then begin
AddTermByKey;
Handled := True;
end;
if Command = FRemoveTermCmd then begin
i := FindTermAtCaret;
if i >= 0 then
TermDict.RemoveTermByKey(i);
Handled := True;
end;
if Command = FToggleTermCmd then begin
i := FindTermAtCaret;
if i >= 0 then
TermDict.RemoveTermByKey(i)
else
AddTermByKey;
Handled := True;
end;
finally
TermDict.DecChangeNotifyLock;
end;
end;
function TSourceSynEditMarkupHighlightAllMulti.CreateTermsList: TSynSearchTermDict;
begin
Result := TSourceSynSearchTermDict.Create(TSourceSynSearchTermList);
end;
constructor TSourceSynEditMarkupHighlightAllMulti.Create(ASynEdit: TSynEditBase);
begin
inherited Create(ASynEdit);
TCustomSynEdit(SynEdit).RegisterCommandHandler(@ProcessSynCommand, nil, [hcfInit]);
end;
destructor TSourceSynEditMarkupHighlightAllMulti.Destroy;
begin
inherited Destroy;
TCustomSynEdit(SynEdit).UnregisterCommandHandler(@ProcessSynCommand);
end;
procedure TSourceSynEditMarkupHighlightAllMulti.RestoreLocalChanges;
begin
(Terms as TSourceSynSearchTermDict).RestoreLocalChanges;
end;
{$IFDEF WithSynDebugGutter}
{ TIDESynGutterDebugHL }
procedure TIDESynGutterDebugHL.PopContentClicked(Sender: TObject);
begin
FContent := TMenuItem(Sender).Tag;
SynEdit.Invalidate;
end;
procedure TIDESynGutterDebugHL.PopSizeClicked(Sender: TObject);
begin
Width := TMenuItem(Sender).Tag;
end;
function TIDESynGutterDebugHL.PreferedWidth: Integer;
begin
Result := 15; // Gutter.TextDrawer.CharWidth * 15;
end;
function TIDESynGutterDebugHL.MaybeHandleMouseAction(var AnInfo: TSynEditMouseActionInfo;
HandleActionProc: TSynEditMouseActionHandler): Boolean;
begin
Result := False;
if (AnInfo.Button <> mbXRight) then exit;
Result := True;
if (AnInfo.Dir = cdUp) then begin
FPopUp.PopUp;
end;
end;
procedure TIDESynGutterDebugHL.PaintFoldLvl(Canvas: TCanvas; AClip: TRect; FirstLine,
LastLine: integer);
var
TextDrawer: TheTextDrawer;
c, i, iLine, LineHeight: Integer;
rcLine: TRect;
dc: HDC;
s: String;
RngLst: TSynHighlighterRangeList;
r: TSynPasSynRange;
begin
if TCustomSynEdit(SynEdit).Highlighter = nil then exit;
if not(TCustomSynEdit(SynEdit).Highlighter is TSynPasSyn) then exit;
TCustomSynEdit(SynEdit).Highlighter.CurrentLines := TheLinesView;
TextDrawer := Gutter.TextDrawer;
dc := Canvas.Handle;
//TSynHighlighterPasRangeList
RngLst := TSynHighlighterRangeList(TheLinesView.Ranges[TCustomSynEdit(SynEdit).Highlighter]);
// Clear all
TextDrawer.BeginDrawing(dc);
try
TextDrawer.SetBackColor(Gutter.Color);
TextDrawer.SetForeColor(TCustomSynEdit(SynEdit).Font.Color);
TextDrawer.SetFrameColor(clNone);
with AClip do
TextDrawer.ExtTextOut(Left, Top, ETO_OPAQUE, AClip, nil, 0);
rcLine := AClip;
rcLine.Bottom := AClip.Top;
LineHeight := TCustomSynEdit(SynEdit).LineHeight;
c := TCustomSynEdit(SynEdit).Lines.Count;
for i := FirstLine to LastLine do
begin
iLine := FoldView.ViewToTextIndex[i] + 1;
if (iLine < 0) or (iLine >= c) then break;
// next line rect
rcLine.Top := rcLine.Bottom;
rcLine.Bottom := rcLine.Bottom + LineHeight;
if i > 0 then begin
r := TSynPasSynRange(RngLst.Range[iLine-1]);
s:= format('%2d %2d %2d %2d %2d %2d ',
[r.PasFoldEndLevel, r.PasFoldMinLevel, r.PasFoldFixLevel,
r.CodeFoldStackSize, r.MinimumCodeFoldBlockLevel, r.LastLineCodeFoldLevelFix
]
);
end
else
s:= '';
TextDrawer.ExtTextOut(rcLine.Left, rcLine.Top, ETO_OPAQUE or ETO_CLIPPED, rcLine,
PChar(Pointer(S)),Length(S));
end;
finally
TextDrawer.EndDrawing;
end;
end;
procedure TIDESynGutterDebugHL.PaintCharWidths(Canvas: TCanvas; AClip: TRect; FirstLine,
LastLine: integer);
var
TextDrawer: TheTextDrawer;
c, i, iLine, LineHeight: Integer;
rcLine: TRect;
dc: HDC;
s, s2: String;
CW: TPhysicalCharWidths;
j: Integer;
begin
TextDrawer := Gutter.TextDrawer;
dc := Canvas.Handle;
TextDrawer.BeginDrawing(dc);
try
TextDrawer.SetBackColor(Gutter.Color);
TextDrawer.SetForeColor(TCustomSynEdit(SynEdit).Font.Color);
TextDrawer.SetFrameColor(clNone);
with AClip do
TextDrawer.ExtTextOut(Left, Top, ETO_OPAQUE, AClip, nil, 0);
rcLine := AClip;
rcLine.Bottom := AClip.Top;
LineHeight := TCustomSynEdit(SynEdit).LineHeight;
c := TCustomSynEdit(SynEdit).Lines.Count;
for i := FirstLine to LastLine do
begin
iLine := FoldView.ViewToTextIndex[i] + 1;
if (iLine < 0) or (iLine >= c) then break;
// next line rect
rcLine.Top := rcLine.Bottom;
rcLine.Bottom := rcLine.Bottom + LineHeight;
if i >= 0 then begin
CW := FTheLinesView.GetPhysicalCharWidths(iLine-1);
s2 := FTheLinesView.Strings[iLine-1];
s := '';
for j := 0 to length(CW) - 1 do begin
case FContent of
1: s := s + IntToStr(CW[j]) + ',';
2: s := s + IntToHex(ord(s2[j+1]),2) + ',';
3: s := s + IntToHex(ord(s2[j+1]),2) + '(' + IntToStr(CW[j]) + '),';
end;
if (j+1 < length(s2)) and (s2[j+2] in [#$00..#$7f,#$C0..#$FF]) then
s := s + ' ';
end;
end
else
s:= '';
TextDrawer.ExtTextOut(rcLine.Left, rcLine.Top, ETO_OPAQUE or ETO_CLIPPED, rcLine,
PChar(Pointer(S)),Length(S));
end;
finally
TextDrawer.EndDrawing;
end;
end;
constructor TIDESynGutterDebugHL.Create(AOwner: TComponent);
var
Item: TMenuItem;
begin
inherited Create(AOwner);
FPopUp := TPopupMenu.Create(Self);
AutoSize := False;
Width := PreferedWidth;
FContent := 0;
Item := TMenuItem.Create(FPopUp);
Item.OnClick := @PopSizeClicked;
Item.Caption := 'Size 15';
Item.Tag := 15;
FPopUp.Items.Add(Item);
Item := TMenuItem.Create(FPopUp);
Item.OnClick := @PopSizeClicked;
Item.Caption := 'Size 100';
Item.Tag := 100;
FPopUp.Items.Add(Item);
Item := TMenuItem.Create(FPopUp);
Item.OnClick := @PopSizeClicked;
Item.Caption := 'Size 250';
Item.Tag := 240;
FPopUp.Items.Add(Item);
Item := TMenuItem.Create(FPopUp);
Item.OnClick := @PopSizeClicked;
Item.Caption := 'Size 500';
Item.Tag := 500;
FPopUp.Items.Add(Item);
Item := TMenuItem.Create(FPopUp);
Item.Caption := '-';
FPopUp.Items.Add(Item);
Item := TMenuItem.Create(FPopUp);
Item.OnClick := @PopContentClicked;
Item.Caption := 'Content: Fold Level';
Item.Tag := 0;
FPopUp.Items.Add(Item);
Item := TMenuItem.Create(FPopUp);
Item.OnClick := @PopContentClicked;
Item.Caption := 'Content: CharWidths';
Item.Tag := 1;
FPopUp.Items.Add(Item);
Item := TMenuItem.Create(FPopUp);
Item.OnClick := @PopContentClicked;
Item.Caption := 'Content: Hex';
Item.Tag := 2;
FPopUp.Items.Add(Item);
Item := TMenuItem.Create(FPopUp);
Item.OnClick := @PopContentClicked;
Item.Caption := 'Content: CharWidths + hex';
Item.Tag := 3;
FPopUp.Items.Add(Item);
end;
procedure TIDESynGutterDebugHL.Paint(Canvas: TCanvas; AClip: TRect; FirstLine,
LastLine: integer);
begin
case FContent of
0: PaintFoldLvl(Canvas, AClip, FirstLine, LastLine);
1,2,3: PaintCharWidths(Canvas, AClip, FirstLine, LastLine);
end;
end;
{$ENDIF}
{ TSourceLazSynTopInfoView }
function TSourceLazSynTopInfoView.GetLineMap(Index: Integer): Integer;
begin
Result := FLineMap[Index];
end;
procedure TSourceLazSynTopInfoView.SetLineMap(Index: Integer; AValue: Integer);
begin
FLineMap[Index] := AValue;
end;
procedure TSourceLazSynTopInfoView.SetLineMapCount(AValue: integer);
begin
if FLineMapCount = AValue then Exit;
FLineMapCount := AValue;
if (length(FLineMap) < AValue) or (length(FLineMap) > (AValue+1) * 2) then
SetLength(FLineMap, AValue);
end;
procedure TSourceLazSynTopInfoView.SetHighlighterTokensLine(ALine: TLineIdx;
out ARealLine: TLineIdx; out ASubLineIdx, AStartBytePos, AStartPhysPos, ALineByteLen: Integer);
begin
CurrentTokenLine := ALine;
inherited SetHighlighterTokensLine(FLineMap[ALine], ARealLine, ASubLineIdx, AStartBytePos, AStartPhysPos, ALineByteLen);
end;
function TSourceLazSynTopInfoView.GetLinesCount: Integer;
begin
Result := LineMapCount;
end;
function TSourceLazSynTopInfoView.TextToViewIndex(AIndex: TLineIdx): TLineRange;
var
i: Integer;
r: TLineRange;
begin
if FSkipTextToView then begin
Result.Top := AIndex;
Result.Bottom := AIndex;
exit;
end;
Result.Top := -1;
Result.Bottom := -1;
r := inherited TextToViewIndex(AIndex);
for i := 0 to LineMapCount - 1 do begin
if LineMap[i] = r.Top then Result.Top := i;
if LineMap[i] = r.Bottom then Result.Bottom := i;
end;
if Result.Bottom < Result.Top then
Result.Bottom := Result.Top;
end;
function TSourceLazSynTopInfoView.ViewToTextIndex(AIndex: TLineIdx): TLineIdx;
begin
Result := inherited ViewToTextIndex(AIndex);
end;
constructor TSourceLazSynTopInfoView.Create;
begin
ClearLineMap;
end;
procedure TSourceLazSynTopInfoView.ClearLineMap;
begin
FLineMapCount := 0;
SetLength(FLineMap, 0);
end;
{ TSourceLazSynSurfaceGutter }
procedure TSourceLazSynSurfaceGutter.DoPaint(ACanvas: TCanvas; AClip: TRect);
begin
// prevent output
Gutter.Paint(ACanvas, Self, AClip, 0, -1);
end;
procedure TSourceLazSynSurfaceGutter.SetTextArea(ATextArea: TLazSynTextArea);
begin
inherited SetTextArea(ATextArea);
ATextArea.AddTextSizeChangeHandler(@TextSizeChanged);
end;
procedure TSourceLazSynSurfaceGutter.TextSizeChanged(Sender: TObject);
begin
Gutter.DoAutoSize;
end;
{ TSourceLazSynSurfaceManager }
procedure TSourceLazSynSurfaceManager.SetTopLineCount(AValue: Integer);
begin
if FTopLineCount = AValue then Exit;
FTopLineCount := AValue;
BoundsChanged;
end;
function TSourceLazSynSurfaceManager.GetLeftGutterArea: TLazSynSurfaceWithText;
begin
Result := FOriginalManager.LeftGutterArea;
end;
function TSourceLazSynSurfaceManager.GetRightGutterArea: TLazSynSurfaceWithText;
begin
Result := FOriginalManager.RightGutterArea;
end;
function TSourceLazSynSurfaceManager.GetTextArea: TLazSynTextArea;
begin
Result := FOriginalManager.TextArea;
end;
procedure TSourceLazSynSurfaceManager.SetBackgroundColor(AValue: TColor);
begin
FOriginalManager.BackgroundColor := AValue;
FExtraManager.BackgroundColor := AValue;
end;
procedure TSourceLazSynSurfaceManager.SetExtraCharSpacing(AValue: integer);
begin
FOriginalManager.ExtraCharSpacing := AValue;
FExtraManager.ExtraCharSpacing := AValue;
end;
procedure TSourceLazSynSurfaceManager.SetExtraLineSpacing(AValue: integer);
begin
FOriginalManager.ExtraLineSpacing := AValue;
FExtraManager.ExtraLineSpacing := AValue;
BoundsChanged;
end;
procedure TSourceLazSynSurfaceManager.SetForegroundColor(AValue: TColor);
begin
FOriginalManager.ForegroundColor := AValue;
FExtraManager.ForegroundColor := AValue;
end;
procedure TSourceLazSynSurfaceManager.SetPadding(Side: TLazSynBorderSide; AValue: integer);
begin
FOriginalManager.Padding[Side] := AValue;
FExtraManager.Padding[Side] := AValue;
end;
procedure TSourceLazSynSurfaceManager.SetRightEdgeColor(AValue: TColor);
begin
FOriginalManager.RightEdgeColor := AValue;
FExtraManager.RightEdgeColor := AValue;
end;
procedure TSourceLazSynSurfaceManager.SetRightEdgeColumn(AValue: integer);
begin
FOriginalManager.RightEdgeColumn := AValue;
FExtraManager.RightEdgeColumn := AValue;
end;
procedure TSourceLazSynSurfaceManager.SetRightEdgeVisible(AValue: boolean);
begin
FOriginalManager.RightEdgeVisible := AValue;
FExtraManager.RightEdgeVisible := AValue;
end;
procedure TSourceLazSynSurfaceManager.SetVisibleSpecialChars(AValue: TSynVisibleSpecialChars);
begin
FOriginalManager.VisibleSpecialChars := AValue;
FExtraManager.VisibleSpecialChars := AValue;
end;
procedure TSourceLazSynSurfaceManager.SetHighlighter(AValue: TSynCustomHighlighter);
begin
FOriginalManager.Highlighter := AValue;
FExtraManager.Highlighter := AValue;
end;
procedure TSourceLazSynSurfaceManager.DoPaint(ACanvas: TCanvas; AClip: TRect);
begin
FOriginalManager.Paint(ACanvas, AClip);
FExtraManager.Paint(ACanvas, AClip);
end;
procedure TSourceLazSynSurfaceManager.DoDisplayViewChanged;
begin
FOriginalManager.DisplayView := DisplayView;
end;
procedure TSourceLazSynSurfaceManager.BoundsChanged;
var
t: Integer;
begin
FExtraManager.LeftGutterWidth := LeftGutterWidth;
FExtraManager.RightGutterWidth := RightGutterWidth;
FOriginalManager.LeftGutterWidth := LeftGutterWidth;
FOriginalManager.RightGutterWidth := RightGutterWidth;
t := Min(Top + FTopLineCount * FExtraManager.TextArea.LineHeight,
Max(Top, Bottom - FOriginalManager.TextArea.LineHeight)
);
FExtraManager.SetBounds(Top, Left, t, Right);
FOriginalManager.SetBounds(t, Left, Bottom, Right);
end;
constructor TSourceLazSynSurfaceManager.Create(AOwner: TWinControl; AnOriginalManager: TLazSynSurfaceManager);
var
txt: TLazSynTextArea;
lgutter, rgutter: TLazSynGutterArea;
begin
inherited Create(AOwner);
FTopLineCount := 0;
FOriginalManager := AnOriginalManager;
txt := TLazSynTextArea.Create(AOwner, FOriginalManager.TextArea.TextDrawer);
txt.Assign(FOriginalManager.TextArea);
txt.TopLine := 1;
txt.LeftChar := 1;
lgutter:= TSourceLazSynSurfaceGutter.Create(AOwner);
lgutter.Assign(FOriginalManager.LeftGutterArea);
lgutter.TextArea := txt;
rgutter:= TSourceLazSynSurfaceGutter.Create(AOwner);
rgutter.Assign(FOriginalManager.RightGutterArea);
rgutter.TextArea := txt;
FExtraManager := TLazSynSurfaceManager.Create(AOwner);
FExtraManager.TextArea := txt;
FExtraManager.LeftGutterArea := lgutter;
FExtraManager.RightGutterArea := rgutter;
end;
destructor TSourceLazSynSurfaceManager.Destroy;
begin
inherited Destroy;
FExtraManager.LeftGutterArea.Free;
FExtraManager.RightGutterArea.Free;
FExtraManager.TextArea.Free;
FExtraManager.Free;
FOriginalManager.Free;
end;
procedure TSourceLazSynSurfaceManager.InvalidateLines(FirstTextLine,
LastTextLine: TLineIdx; AScreenLineOffset: Integer);
begin
FOriginalManager.InvalidateLines(FirstTextLine, LastTextLine, AScreenLineOffset);
FExtraManager.InvalidateLines(FirstTextLine, LastTextLine);
end;
procedure TSourceLazSynSurfaceManager.InvalidateTextLines(FirstTextLine,
LastTextLine: TLineIdx; AScreenLineOffset: Integer);
begin
FOriginalManager.InvalidateTextLines(FirstTextLine, LastTextLine, AScreenLineOffset);
FExtraManager.InvalidateTextLines(FirstTextLine, LastTextLine);
end;
procedure TSourceLazSynSurfaceManager.InvalidateGutterLines(FirstTextLine,
LastTextLine: TLineIdx; AScreenLineOffset: Integer);
begin
FOriginalManager.InvalidateGutterLines(FirstTextLine, LastTextLine, AScreenLineOffset);
FExtraManager.InvalidateGutterLines(FirstTextLine, LastTextLine);
end;
{ TIDESynEditor }
procedure TIDESynEditor.DoHighlightChanged(Sender: TSynEditStrings; AIndex, ACount: Integer);
begin
FTopInfoNestList.Clear;
if (AIndex = -1) and (ACount = -1) then begin
// New Highlighter was assigned
if (FFoldView.HighLighter = nil) or not(FFoldView.HighLighter is TSynPasSyn) then begin
FSrcSynCaretChangedNeeded := False;
FTopInfoDisplay.ClearLineMap;
if TSourceLazSynSurfaceManager(FPaintArea).TopLineCount <> 0 then begin
TSourceLazSynSurfaceManager(FPaintArea).TopLineCount := 0;
Invalidate; // TODO: move to PaintArea
end;
end
end;
if FSrcSynCaretChangedNeeded then
SrcSynCaretChanged(nil);
end;
function TIDESynEditor.GetWordWrapEnabled: Boolean;
begin
Result := FWrapView <> nil;
end;
procedure TIDESynEditor.SetWordWrapCaretWrapPos(AValue: TLazSynEditWrapCaretPos);
begin
if FWrapView <> nil then
FWrapView.CaretWrapPos := AValue;
end;
procedure TIDESynEditor.SetWordWrapEnabled(AValue: Boolean);
begin
if AValue = WordWrapEnabled then
exit;
if AValue then
AddLineWrapView
else
RemoveLineWrapView;
end;
procedure TIDESynEditor.SetWordWrapForceHomeEnd(AValue: Boolean);
begin
if FWrapView <> nil then
FWrapView.OverrideHomeEndKeyDefaults:= AValue;
end;
procedure TIDESynEditor.SetWordWrapIndent(AValue: Integer);
begin
if FWrapView <> nil then
FWrapView.WrapIndentWidth := AValue;
end;
procedure TIDESynEditor.SetWordWrapIndentMax(AValue: Integer);
begin
if FWrapView <> nil then
FWrapView.WrapIndentMaxAbs := AValue;
end;
procedure TIDESynEditor.SetWordWrapIndentMaxRel(AValue: Integer);
begin
if FWrapView <> nil then
FWrapView.WrapIndentMaxRel := AValue;
end;
procedure TIDESynEditor.SetWordWrapIndentMin(AValue: Integer);
begin
if FWrapView <> nil then
FWrapView.WrapIndentMinAbs := AValue;
end;
procedure TIDESynEditor.SetWordWrapIndentUseOffset(AValue: boolean);
begin
if FWrapView <> nil then
FWrapView.WrapIndentIsOffset := AValue;
end;
procedure TIDESynEditor.SetWordWrapMaxWidth(AValue: Integer);
begin
if FWrapView <> nil then
FWrapView.MaxWrapWidth := AValue;
end;
procedure TIDESynEditor.SetWordWrapMinWidth(AValue: Integer);
begin
if FWrapView <> nil then
FWrapView.MinWrapWidth := AValue;
end;
procedure TIDESynEditor.SrcSynCaretChanged(Sender: TObject);
function RealTopLine: Integer;
begin
Result := TopLine - TSourceLazSynSurfaceManager(FPaintArea).TopLineCount;
end;
var
InfCnt, i, t, ListCnt: Integer;
InfList: array [0..1] of
record
LineIndex: Integer;
FoldType: TPascalCodeFoldBlockType;
end;
NodeFoldType: TPascalCodeFoldBlockType;
begin
if (not FShowTopInfo) or (not HandleAllocated) or (FFoldView.HighLighter = nil) then exit;
if FSrcSynCaretChangedLock or not(FFoldView.HighLighter is TSynPasSyn) then exit;
if FFoldView.HighLighter.NeedScan then begin
FSrcSynCaretChangedNeeded := True;
FTopInfoDisplay.LineMapCount := 0;
exit;
end;
FSrcSynCaretChangedNeeded := False;
FSrcSynCaretChangedLock := True;
try
ListCnt := 0;
if CaretY >= RealTopLine then begin
FTopInfoNestList.Lines := TextBuffer; // in case it changed
FTopInfoNestList.Line := CaretY-1;
FTopInfoNestList := FTopInfoNestList;
InfCnt := FTopInfoNestList.Count;
for i := InfCnt-1 downto 0 do begin
NodeFoldType := TPascalCodeFoldBlockType({%H-}PtrUInt(FTopInfoNestList.NodeFoldType[i]));
if not(NodeFoldType in
[cfbtClass, cfbtClassSection, cfbtProcedure])
then
continue;
if (NodeFoldType in [cfbtClassSection]) and (ListCnt = 0) then begin
InfList[ListCnt].LineIndex := FTopInfoNestList.NodeLine[i];
InfList[ListCnt].FoldType := NodeFoldType;
inc(ListCnt);
end;
if (NodeFoldType in [cfbtClass]) and (ListCnt < 2) then begin
InfList[ListCnt].LineIndex := FTopInfoNestList.NodeLine[i];
InfList[ListCnt].FoldType := NodeFoldType;
inc(ListCnt);
end;
if (NodeFoldType in [cfbtProcedure]) and (ListCnt < 2) then begin
InfList[ListCnt].LineIndex := FTopInfoNestList.NodeLine[i];
InfList[ListCnt].FoldType := NodeFoldType;
inc(ListCnt);
end;
if (NodeFoldType in [cfbtProcedure]) and (ListCnt = 2) and
(InfList[ListCnt-1].FoldType = cfbtProcedure)
then begin
InfList[ListCnt-1].LineIndex := FTopInfoNestList.NodeLine[i];
InfList[ListCnt-1].FoldType := NodeFoldType;
end;
end;
end;
if TopLine <> FTopInfoLastTopLine then // if Sender = nil;
ListCnt := Min(ListCnt, Max(0, CaretY - RealTopLine));
t := TopLine + ListCnt - TSourceLazSynSurfaceManager(FPaintArea).TopLineCount;
if (CaretY >= TopLine) and (CaretY < t) then
t := CaretY;
while ListCnt > 0 do begin
if InfList[0].LineIndex + 1 >= t-1 then begin
InfList[0] := InfList[1];
dec(ListCnt);
t := TopLine + ListCnt - TSourceLazSynSurfaceManager(FPaintArea).TopLineCount;
if (CaretY >= TopLine) and (CaretY < t) then
t := CaretY;
end
else
break;
end;
FTopInfoDisplay.LineMapCount := ListCnt;
if ListCnt <> TSourceLazSynSurfaceManager(FPaintArea).TopLineCount then begin
TSourceLazSynSurfaceManager(FPaintArea).TopLineCount := ListCnt;
TopLine := t;
SizeOrFontChanged(FALSE);
Invalidate; // TODO: move to PaintArea
end;
FTopInfoDisplay.FSkipTextToView := True;
for i := 0 to ListCnt - 1 do begin
if FTopInfoDisplay.LineMap[ListCnt-1-i] <> InfList[i].LineIndex then
TSourceLazSynSurfaceManager(FPaintArea).ExtraManager.InvalidateLines(ListCnt-1-i, ListCnt-1-i);
FTopInfoDisplay.LineMap[ListCnt-1-i] := InfList[i].LineIndex;
end;
FTopInfoDisplay.FSkipTextToView := False;
finally
FSrcSynCaretChangedLock := False;
FTopInfoLastTopLine := TopLine;
end;
end;
function TIDESynEditor.GetHighlighter: TSynCustomFoldHighlighter;
begin
if Highlighter is TSynCustomFoldHighlighter then
Result := TSynCustomFoldHighlighter(Highlighter)
else
Result := nil;
end;
function TIDESynEditor.GetTopLineBeforeFold: TSrcSynTopLineInfo;
var
r: TLineRange;
tv: Integer;
begin
tv := ToIdx(TopView);
Result.Line := TextView.DisplayView.ViewToTextIndexEx(tv, r);
Result.Subline := tv - r.Top;
end;
procedure TIDESynEditor.RestoreTopLineAfterFold(AnInfo: TSrcSynTopLineInfo);
var
tv: Integer;
begin
tv := TextView.TextToViewIndex(AnInfo.Line);
if TextView.IsTextIdxVisible(AnInfo.Line) then
tv := tv + AnInfo.Subline
else
tv := tv + 1;
Topview := ToPos(tv);
end;
procedure TIDESynEditor.DoOnStatusChange(Changes: TSynStatusChanges);
begin
inherited DoOnStatusChange(Changes);
if Changes * [scTopLine, scLinesInWindow] <> []then
SrcSynCaretChanged(nil);
{$push}{$R-} // range check off
if Changes * [scCaretX, scCaretY, scSelection] <> []then
Inc(FCaretStamp);
{$pop}
end;
procedure TIDESynEditor.GetTopInfoMarkupForLine(Sender: TObject; Line: integer;
var Special: boolean; aMarkup: TSynSelectedColor);
begin
Special := True;
aMarkup.Assign(FTopInfoMarkup);
end;
procedure TIDESynEditor.SetCaretColor(AValue: TColor);
begin
if FCaretColor = AValue then Exit;
FCaretColor := AValue;
if (AValue = clDefault) or (AValue = clNone) then begin
FScreenCaretPainterClass{%H-} := TSynEditScreenCaretPainterSystem;
if ScreenCaret.Painter.ClassType <> TSynEditScreenCaretPainterSystem then begin
MultiCaret.ActiveMode := mcmNoCarets; // clear all carets, before changing the caret class
ScreenCaret.ChangePainter(TSynEditScreenCaretPainterSystem);
end;
end
else begin
FScreenCaretPainterClass{%H-} := TSynEditScreenCaretPainterInternal;
if ScreenCaret.Painter.ClassType <> TSynEditScreenCaretPainterInternal then begin
MultiCaret.ActiveMode := mcmNoCarets; // clear all carets, before changing the caret class
ScreenCaret.ChangePainter(TSynEditScreenCaretPainterInternal);
end;
TSynEditScreenCaretPainterInternal(ScreenCaret.Painter).Color := AValue;
end;
end;
procedure TIDESynEditor.SetHighlightUserWordCount(AValue: Integer);
var
m: TSourceSynEditMarkupHighlightAllMulti;
begin
if AValue = FUserWordsList.Count then
exit;
while FUserWordsList.Count > AValue do begin
TSynEditMarkupManager(MarkupMgr).RemoveMarkUp(TSourceSynEditMarkupHighlightAllMulti(FUserWordsList[AValue]));
TSourceSynEditMarkupHighlightAllMulti(FUserWordsList[AValue]).Free;
FUserWordsList.Delete(AValue);
end;
while AValue > FUserWordsList.Count do begin
m := TSourceSynEditMarkupHighlightAllMulti.Create(self);
if PaintLock > 0 then
m.IncPaintLock;
if Highlighter <> nil then
m.WordBreakChars := Highlighter.WordBreakChars + TSynWhiteChars;
FUserWordsList.Add(m);
TSynEditMarkupManager(MarkupMgr).AddMarkUp(m);
end;
end;
procedure TIDESynEditor.SetOnMultiCaretBeforeCommand(AValue: TSynMultiCaretBeforeCommand);
begin
FMultiCaret.OnBeforeCommand := AValue;
end;
procedure TIDESynEditor.SetShowTopInfo(AValue: boolean);
begin
if FShowTopInfo = AValue then Exit;
FShowTopInfo := AValue;
if FShowTopInfo then begin
SrcSynCaretChanged(nil)
end
else
if TSourceLazSynSurfaceManager(FPaintArea).TopLineCount <> 0 then begin
TSourceLazSynSurfaceManager(FPaintArea).TopLineCount := 0;
Invalidate; // TODO: move to PaintArea
end;
end;
procedure TIDESynEditor.SetTopInfoMarkup(AValue: TSynSelectedColor);
begin
if FTopInfoMarkup = AValue then Exit;
FTopInfoMarkup.Assign(AValue);
end;
function TIDESynEditor.GetIDEGutterMarks: TIDESynGutterMarks;
begin
Result := TIDESynGutterMarks(Gutter.Parts.ByClass[TIDESynGutterMarks, 0]);
end;
function TIDESynEditor.GetIsInMultiCaretMainExecution: Boolean;
begin
Result := FMultiCaret.IsInMainExecution;
end;
function TIDESynEditor.GetIsInMultiCaretRepeatExecution: Boolean;
begin
Result := FMultiCaret.IsInRepeatExecution;
end;
function TIDESynEditor.GetOnMultiCaretBeforeCommand: TSynMultiCaretBeforeCommand;
begin
Result := FMultiCaret.OnBeforeCommand;
end;
function TIDESynEditor.IsIfdefMarkupActive: Boolean;
begin
Result := FMarkupIfDef.RealEnabled;
end;
function TIDESynEditor.DoIfDefNodeStateRequest(Sender: TObject; LinePos,
XStartPos: Integer; CurrentState: TSynMarkupIfdefNodeStateEx): TSynMarkupIfdefNodeState;
begin
//debugln(['TIDESynEditor.DoIfDefNodeStateRequest x=',XStartPos,' y=',LinePos,' ',DbgSName(Sender)]);
if FOnIfdefNodeStateRequest <> nil then
Result := FOnIfdefNodeStateRequest(Self, LinePos, XStartPos, CurrentState)
else
Result := idnInvalid;
end;
function TIDESynEditor.CatchMouseForTopInforLine(var AnInfo: TSynEditMouseActionInfo;
HandleActionProc: TSynEditMouseActionHandler): Boolean;
var
p: TPoint;
l: LongInt;
begin
Result :=
AnInfo.MouseY < TSourceLazSynSurfaceManager(FPaintArea).ExtraManager.Bounds.Bottom;
if not Result then
exit;
if AnInfo.Button <> TSynMouseButton.mbLeft then
exit;
p := TSourceLazSynSurfaceManager(FPaintArea).ExtraManager.TextArea.PixelsToRowColumn(Point(AnInfo.MouseX, AnInfo.MouseY), []);
if AnInfo.Dir = cdDown then begin
FMouseTopLineDownPos := p;
exit;
end;
if (p.y <> FMouseTopLineDownPos.Y) or (abs(p.X - FMouseTopLineDownPos.x) > 1) then
exit;
if (p.y < 0) or (p.y >= FTopInfoDisplay.LineMapCount) then
exit;
l := ToPos(FTopInfoDisplay.LineMap[p.y]);
TopLine := l+1;
CaretXY := Point(p.X, l);
end;
procedure TIDESynEditor.InvalidateAllIfdefNodes;
begin
FMarkupIfDef.InvalidateAll;
end;
procedure TIDESynEditor.SetIfdefNodeState(ALinePos, AstartPos: Integer;
AState: TSynMarkupIfdefNodeState);
begin
FMarkupIfDef.SetNodeState(ALinePos, AstartPos, AState);
end;
function TIDESynEditor.GetHighlightUserWordCount: Integer;
begin
Result := FUserWordsList.Count;
end;
function TIDESynEditor.GetHighlightUserWords(AIndex: Integer): TSourceSynEditMarkupHighlightAllMulti;
begin
Result := TSourceSynEditMarkupHighlightAllMulti(FUserWordsList[AIndex])
end;
function TIDESynEditor.CreateGutter(AOwner: TSynEditBase; ASide: TSynGutterSide;
ATextDrawer: TheTextDrawer): TSynGutter;
begin
Result := TIDESynGutter.Create(AOwner, ASide, ATextDrawer);
end;
procedure TIDESynEditor.SetHighlighter(const Value: TSynCustomHighlighter);
var
i: Integer;
begin
if Value = Highlighter then begin
inherited SetHighlighter(Value);
exit
end;
IncPaintLock;
try
FMarkupIfDef.Highlighter := nil;
inherited SetHighlighter(Value);
//TSynEditMarkupFoldColors(MarkupByClass[TSynEditMarkupFoldColors]).Highlighter := Highlighter; // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
if Highlighter is TSynPasSyn then
FMarkupIfDef.Highlighter := TSynPasSyn(Highlighter)
else
FMarkupIfDef.Highlighter := nil;
if Highlighter is TSynCustomFoldHighlighter then
FTopInfoNestList.Highlighter := TSynCustomFoldHighlighter(Highlighter)
else
FTopInfoNestList.Highlighter := nil;
if FUserWordsList = nil then
exit;
if Highlighter <> nil then
for i := 0 to FUserWordsList.Count - 1 do
HighlightUserWords[i].WordBreakChars := Highlighter.WordBreakChars + TSynWhiteChars
else
for i := 0 to FUserWordsList.Count - 1 do
HighlightUserWords[i].ResetWordBreaks;
finally
DecPaintLock;
end;
end;
procedure TIDESynEditor.AddLineWrapView;
begin
if FWrapView <> nil then
RemoveLineWrapView;
FWrapView := TLazSynEditLineWrapPlugin.Create(Self);
end;
procedure TIDESynEditor.RemoveLineWrapView;
begin
FreeAndNil(FWrapView);
end;
constructor TIDESynEditor.Create(AOwner: TComponent);
var
MarkupFoldColors: TSynEditMarkupFoldColors;
begin
inherited Create(AOwner);
FFoldView := TSynEditFoldedView(TextViewsManager.SynTextViewByClass[TSynEditFoldedView]);
FCaretColor := clNone;
FUserWordsList := TFPList.Create;
FTemplateEdit:=TSynPluginTemplateEdit.Create(Self);
FSyncroEdit := TSynPluginSyncroEdit.Create(Self);
FMultiCaret := TSynPluginMultiCaret.Create(Self);
FMultiCaret.MouseActions.Clear; // will be added to SynEdit
FMultiCaret.KeyStrokes.Clear;
FMultiCaret.SetCaretTypeSize(ctVerticalLine, 2, 1024, -1, 0, [ccsRelativeHeight]);
FMultiCaret.SetCaretTypeSize(ctBlock, 1024, 1024, 0, 0, [ccsRelativeWidth, ccsRelativeHeight]);
FMultiCaret.Color := $606060;
FMarkupForGutterMark := TSynEditMarkupGutterMark.Create(Self, FWordBreaker);
TSynEditMarkupManager(MarkupMgr).AddMarkUp(FMarkupForGutterMark);
MarkupFoldColors := TSynEditMarkupFoldColors.Create(Self);
//MarkupFoldColors.DefaultGroup := 0;
TSynEditMarkupManager(MarkupMgr).AddMarkUp(MarkupFoldColors);
FMarkupIfDef := TSourceSynEditMarkupIfDef.Create(Self);
FMarkupIfDef.FoldView := TSynEditFoldedView(FoldedTextBuffer);
//FMarkupIfDef.OnNodeStateRequest := @DoIfDefNodeStateRequest;
TSynEditMarkupManager(MarkupMgr).AddMarkUp(FMarkupIfDef);
FMarkupIdentComplWindow := TSynMarkupIdentComplWindow.Create;
FPaintArea := TSourceLazSynSurfaceManager.Create(Self, FPaintArea);
GetCaretObj.AddChangeHandler(@SrcSynCaretChanged);
FTopInfoDisplay := TSourceLazSynTopInfoView.Create;
FTopInfoDisplay.NextView := TextViewsManager.SynTextViewByClass[TSynEditStringTabExpander].DisplayView;
TSourceLazSynSurfaceManager(FPaintArea).TopLineCount := 0;
// TSourceLazSynSurfaceManager(FPaintArea).ExtraManager.TextArea.BackgroundColor := clSilver;
TSourceLazSynSurfaceManager(FPaintArea).ExtraManager.DisplayView := FTopInfoDisplay;
RegisterMouseActionSearchHandler(@CatchMouseForTopInforLine);
FTopInfoNestList := TLazSynEditNestedFoldsList.Create(TextBuffer);
FTopInfoNestList.ResetFilter;
FTopInfoNestList.FoldGroup := FOLDGROUP_PASCAL;
FTopInfoNestList.FoldFlags := [sfbIncludeDisabled];
FTopInfoNestList.IncludeOpeningOnLine := False;
FTopInfoMarkup := TSynSelectedColor.Create;
FTopInfoMarkup.Clear;
ViewedTextBuffer.AddChangeHandler(senrHighlightChanged, @DoHighlightChanged);
// Markup for top info hint
FExtraMarkupLine := TSynEditMarkupSpecialLine.Create(Self);
FExtraMarkupLine.OnSpecialLineMarkup := @GetTopInfoMarkupForLine;
FExtraMarkupMgr := TSynEditMarkupManager.Create(Self);
FExtraMarkupMgr.AddMarkUp(TSynEditMarkup(MarkupMgr));
FExtraMarkupMgr.AddMarkUp(FExtraMarkupLine);
FExtraMarkupMgr.Lines := ViewedTextBuffer;
FExtraMarkupMgr.Caret := GetCaretObj;
FExtraMarkupMgr.InvalidateLinesMethod := @InvalidateLines;
TSourceLazSynSurfaceManager(FPaintArea).ExtraManager.TextArea.MarkupManager :=
FExtraMarkupMgr;
{$IFDEF WithSynDebugGutter}
TIDESynGutter(RightGutter).DebugGutter.TheLinesView := ViewedTextBuffer;
{$ENDIF}
end;
destructor TIDESynEditor.Destroy;
begin
RemoveLineWrapView;
UnRegisterMouseActionSearchHandler(@CatchMouseForTopInforLine);
ViewedTextBuffer.RemoveChangeHandler(senrHighlightChanged, @DoHighlightChanged);
HighlightUserWordCount := 0;
Highlighter := nil;
FreeAndNil(FUserWordsList);
FExtraMarkupMgr.RemoveMarkUp(TSynEditMarkup(MarkupMgr));
FreeAndNil(FTopInfoDisplay);
FreeAndNil(FExtraMarkupMgr);
FreeAndNil(FTopInfoMarkup);
FreeAndNil(FTopInfoNestList);
FreeAndNil(FMarkupIdentComplWindow);
inherited Destroy;
end;
function TIDESynEditor.TextIndexToViewPos(aTextIndex: Integer): Integer;
begin
Result := ToPos(TextView.TextToViewIndex(ToIdx(aTextIndex)));
end;
{$IFDEF WinIME}
procedure TIDESynEditor.CreateMinimumIme;
var
Ime: LazSynIme;
begin
if ImeHandler is LazSynImeSimple then exit;
Ime := LazSynImeSimple.Create(Self);
LazSynImeSimple(Ime).TextDrawer := TextDrawer;
Ime.InvalidateLinesMethod := @InvalidateLines;
ImeHandler := Ime;
end;
procedure TIDESynEditor.CreateFullIme;
var
Ime: LazSynIme;
begin
if ImeHandler is LazSynImeFull then exit;
Ime := LazSynImeFull.Create(Self);
Ime.InvalidateLinesMethod := @InvalidateLines;
ImeHandler := Ime;
end;
{$ENDIF}
{ TSynHighlighterLazCustomPasAttribute }
procedure TSynHighlighterLazCustomPasAttribute.SetCustomWordTokenKind(AValue: TtkTokenKind);
begin
if FCustomWordTokenKind = AValue then Exit;
FCustomWordTokenKind := AValue;
Changed;
end;
procedure TSynHighlighterLazCustomPasAttribute.DoWordsChanged(Sender: TObject);
begin
Changed;
end;
procedure TSynHighlighterLazCustomPasAttribute.AssignFrom(Src: TLazSynCustomTextAttributes);
begin
inherited AssignFrom(Src);
if Src is TSynHighlighterLazCustomPasAttribute then begin
FCustomWords.Assign(TSynHighlighterLazCustomPasAttribute(Src).FCustomWords);
FCustomWordTokenKind := TSynHighlighterLazCustomPasAttribute(Src).FCustomWordTokenKind;
end
else begin
FCustomWords.Clear;
FCustomWordTokenKind := tkIdentifier;
end;
end;
procedure TSynHighlighterLazCustomPasAttribute.DoClear;
begin
inherited DoClear;
if FCustomWords <> nil then
FCustomWords.Clear;
FCustomWordTokenKind := tkIdentifier;
end;
procedure TSynHighlighterLazCustomPasAttribute.Init;
begin
FCustomWords := TStringList.Create;
FCustomWordTokenKind := tkIdentifier;
TStringList(FCustomWords).OnChange := @DoWordsChanged;
inherited Init;
end;
destructor TSynHighlighterLazCustomPasAttribute.Destroy;
begin
inherited Destroy;
FCustomWords.Destroy;
end;
{ TIDESynPasSyn }
procedure TIDESynPasSyn.DoBuildCustomPasAttr(Sender: TObject);
var
c, i: Integer;
begin
c := 0;
for i := 0 to 9 do
if FCustomAttribs[i].IsEnabled and
(trim(FCustomAttribs[i].CustomWords.Text) <> '')
then
inc(c);
CustomTokenCount := c;
c := 0;
for i := 0 to 9 do
if FCustomAttribs[i].IsEnabled and
(trim(FCustomAttribs[i].CustomWords.Text) <> '')
then begin
CustomTokens[c].Markup.Assign(FCustomAttribs[i]);
CustomTokens[c].MatchTokenKinds := [FCustomAttribs[i].CustomWordTokenKind];
CustomTokens[c].Tokens.Assign(FCustomAttribs[i].CustomWords);
inc(c);
end;
DefHighlightChange(Sender);
end;
function TIDESynPasSyn.GetFinalizationLine: Integer;
begin
Result := TIDESynHighlighterPasRangeList(CurrentRanges).FFinalizationLine;
end;
function TIDESynPasSyn.GetImplementationLine: Integer;
begin
Result := TIDESynHighlighterPasRangeList(CurrentRanges).FImplementationLine;
end;
function TIDESynPasSyn.GetInitializationLine: Integer;
begin
Result := TIDESynHighlighterPasRangeList(CurrentRanges).FInitializationLine;
end;
function TIDESynPasSyn.GetInterfaceLine: Integer;
begin
Result := TIDESynHighlighterPasRangeList(CurrentRanges).FInterfaceLine;
end;
function TIDESynPasSyn.CreateRangeList(ALines: TSynEditStringsBase): TSynHighlighterRangeList;
begin
Result := TIDESynHighlighterPasRangeList.Create;
TIDESynHighlighterPasRangeList(Result).FInterfaceLine := -1;
TIDESynHighlighterPasRangeList(Result).FImplementationLine := -1;
TIDESynHighlighterPasRangeList(Result).FInitializationLine := -1;
TIDESynHighlighterPasRangeList(Result).FFinalizationLine := -1;
end;
function TIDESynPasSyn.StartCodeFoldBlock(ABlockType: Pointer;
IncreaseLevel: Boolean; ForceDisabled: Boolean): TSynCustomCodeFoldBlock;
begin
if (ABlockType = Pointer(PtrUInt(cfbtUnitSection))) or
(ABlockType = Pointer(PtrUInt(cfbtUnitSection)) + {%H-}PtrUInt(CountPascalCodeFoldBlockOffset))
then begin
if KeyComp('Interface') then
TIDESynHighlighterPasRangeList(CurrentRanges).FInterfaceLine := LineIndex + 1;
if KeyComp('Implementation') then
TIDESynHighlighterPasRangeList(CurrentRanges).FImplementationLine := LineIndex + 1;
if KeyComp('Initialization') then
TIDESynHighlighterPasRangeList(CurrentRanges).FInitializationLine := LineIndex + 1;
if KeyComp('Finalization') then
TIDESynHighlighterPasRangeList(CurrentRanges).FFinalizationLine := LineIndex + 1;
end;
Result := inherited;
end;
constructor TIDESynPasSyn.Create(AOwner: TComponent);
var
i: Integer;
begin
inherited Create(AOwner);
for i := 0 to 9 do begin
FCustomAttribs[i] := TSynHighlighterLazCustomPasAttribute.Create('Custom '+IntToStr(i), 'CustomToken_'+IntToStr(i));
AddAttribute(FCustomAttribs[i]);
FCustomAttribs[i].OnChange := @DoBuildCustomPasAttr;
end;
end;
procedure TIDESynPasSyn.SetLine(const NewValue: string; LineNumber: Integer);
begin
if assigned(CurrentRanges) then begin
if TIDESynHighlighterPasRangeList(CurrentRanges).FInterfaceLine = LineNumber + 1 then
TIDESynHighlighterPasRangeList(CurrentRanges).FInterfaceLine := -1;
if TIDESynHighlighterPasRangeList(CurrentRanges).FImplementationLine = LineNumber + 1 then
TIDESynHighlighterPasRangeList(CurrentRanges).FImplementationLine := -1;
if TIDESynHighlighterPasRangeList(CurrentRanges).FInitializationLine = LineNumber + 1 then
TIDESynHighlighterPasRangeList(CurrentRanges).FInitializationLine := -1;
if TIDESynHighlighterPasRangeList(CurrentRanges).FFinalizationLine = LineNumber + 1 then
TIDESynHighlighterPasRangeList(CurrentRanges).FFinalizationLine := -1;
end;
inherited SetLine(NewValue, LineNumber);
end;
{ TIDESynFreePasSyn }
constructor TIDESynFreePasSyn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
CompilerMode:=pcmObjFPC;
end;
procedure TIDESynFreePasSyn.ResetRange;
begin
inherited ResetRange;
CompilerMode:=pcmObjFPC;
end;
{ TIDESynGutterLOvProviderPascal }
procedure TIDESynGutterLOvProviderPascal.SetSingleLine(const AValue: Boolean);
begin
if FSingleLine = AValue then exit;
FSingleLine := AValue;
InvalidatePixelLines(0, Height);
end;
procedure TIDESynGutterLOvProviderPascal.SetColor2(const AValue: TColor);
begin
if FColor2 = AValue then exit;
FColor2 := AValue;
FRGBColor2 := ColorToRGB(AValue);
DoChange(Self);
end;
procedure TIDESynGutterLOvProviderPascal.BufferChanged(Sender: TObject);
begin
//LineCountChanged(nil, 0, 0);
HighlightChanged(nil,-1,-1);
end;
procedure TIDESynGutterLOvProviderPascal.HighlightChanged(Sender: TSynEditStrings; AIndex,
ACount: Integer);
var
hl: TIDESynPasSyn;
procedure Update(var TheVal: Integer; NewVal: Integer);
begin
if TheVal = NewVal then exit;
if FSingleLine then begin
InvalidatePixelLines(TheVal, TheVal);
InvalidatePixelLines(NewVal, NewVal);
end else begin
InvalidatePixelLines(Min(TheVal, NewVal), Height);
end;
TheVal := NewVal;
end;
var i1,i1e,i2,i2e,i3,i3e,i4,i4e: Integer;
begin
i1 := FPixInterfaceLine;
i1e := FPixEndInterfaceLine;
i2 := FPixImplementationLine;
i2e := FPixEndImplementationLine;
i3 := FPixInitializationLine;
i3e := FPixEndInitializationLine;
i4 := FPixFinalizationLine;
i4e := FPixEndFinalizationLine;
if not(TSynEdit(SynEdit).Highlighter is TIDESynPasSyn) then begin
FInterfaceLine := -1;
FImplementationLine := -1;
FInitializationLine := -1;
FFinalizationLine := -1;
end else begin
hl := TSynEdit(SynEdit).Highlighter as TIDESynPasSyn;
if hl.CurrentLines = nil then exit;
FInterfaceLine := hl.InterfaceLine;
FImplementationLine := hl.ImplementationLine;
FInitializationLine := hl.InitializationLine;
FFinalizationLine := hl.FinalizationLine;
end;
ReCalc;
if (i1 <> FPixInterfaceLine) or (i1e <> FPixEndInterfaceLine) then begin
InvalidatePixelLines(i1,i1e);
InvalidatePixelLines(FPixInterfaceLine, FPixEndInterfaceLine);
end;
if (i2 <> FPixImplementationLine) or (i2e <> FPixEndImplementationLine) then begin
InvalidatePixelLines(i2,i2e);
InvalidatePixelLines(FPixImplementationLine, FPixEndImplementationLine);
end;
if (i3 <> FPixInitializationLine) or (i3e <> FPixEndInitializationLine) then begin
InvalidatePixelLines(i3,i3e);
InvalidatePixelLines(FPixInitializationLine, FPixEndInitializationLine);
end;
if (i4 <> FPixFinalizationLine) or (i4e <> FPixEndFinalizationLine) then begin
InvalidatePixelLines(i4,i4e);
InvalidatePixelLines(FPixFinalizationLine, FPixEndFinalizationLine);
end;
end;
procedure TIDESynGutterLOvProviderPascal.ReCalc;
begin
FPixInterfaceLine := TextLineToPixel(FInterfaceLine);
FPixImplementationLine := TextLineToPixel(FImplementationLine);
FPixInitializationLine := TextLineToPixel(FInitializationLine);
FPixFinalizationLine := TextLineToPixel(FFinalizationLine);
if SingleLine then begin
if FPixInterfaceLine < 0 then
FPixEndInterfaceLine := -1
else
FPixEndInterfaceLine := TextLineToPixelEnd(FInterfaceLine) + 1;
if FPixImplementationLine < 0 then
FPixEndImplementationLine := -1
else
FPixEndImplementationLine := TextLineToPixelEnd(FImplementationLine) + 1;
if FPixInitializationLine < 0 then
FPixEndInitializationLine := -1
else
FPixEndInitializationLine := TextLineToPixelEnd(FInitializationLine) + 1;
if FPixFinalizationLine < 0 then
FPixEndFinalizationLine := -1
else
FPixEndFinalizationLine := TextLineToPixelEnd(FFinalizationLine) + 1;
end else begin
if FPixInterfaceLine < 0 then
FPixEndInterfaceLine := -1
else if FPixImplementationLine >= 0 then
FPixEndInterfaceLine := FPixImplementationLine - 1
else if FPixInitializationLine >= 0 then
FPixEndInterfaceLine := FPixInitializationLine - 1
else if FPixFinalizationLine >= 0 then
FPixEndInterfaceLine := FPixFinalizationLine - 1
else
FPixEndInterfaceLine := Height - 1;
if FPixImplementationLine < 0 then
FPixEndImplementationLine := -1
else if FPixInitializationLine >= 0 then
FPixEndImplementationLine := FPixInitializationLine - 1
else if FPixFinalizationLine >= 0 then
FPixEndImplementationLine := FPixFinalizationLine - 1
else
FPixEndImplementationLine := Height - 1;
if FPixInitializationLine < 0 then
FPixEndInitializationLine := -1
else if FPixFinalizationLine >= 0 then
FPixEndInitializationLine := FPixFinalizationLine - 1
else
FPixEndInitializationLine := Height - 1;
if FPixFinalizationLine < 0 then
FPixEndFinalizationLine := -1
else
FPixEndFinalizationLine := Height - 1;
end;
end;
procedure TIDESynGutterLOvProviderPascal.Paint(Canvas: TCanvas; AClip: TRect;
TopOffset: integer);
procedure DrawArea(AStartLine, AEndLine: Integer; C: TColor);
var r: TRect;
begin
if (C = clNone) and SingleLine then
c := Color;
if (C = clNone) then
exit;
if (AStartLine + TopOffset > AClip.Bottom) or
(AEndLine + TopOffset < AClip.Top)
then
exit;
r := AClip;
r.Top := Max(r.Top, AStartLine + TopOffset);
r.Bottom := Min(r.Bottom, AEndLine + 1 + TopOffset);
Canvas.Brush.Color := C;
Canvas.FillRect(r);
end;
var
C2, C3: TColor;
begin
if FPixInterfaceLine >= 0 then
DrawArea(FPixInterfaceLine, FPixEndInterfaceLine, Color);
if FPixImplementationLine >= 0 then
DrawArea(FPixImplementationLine, FPixEndImplementationLine, Color2);
C2 := Color;
C3 := Color2;
if FPixImplementationLine < 0 then begin
C2 := Color2;
if FPixInitializationLine >= 0 then
C3 := Color;
end;
if FPixInitializationLine >= 0 then
DrawArea(FPixInitializationLine, FPixEndInitializationLine, C2);
if FPixFinalizationLine >= 0 then
DrawArea(FPixFinalizationLine, FPixEndFinalizationLine, C3);
end;
constructor TIDESynGutterLOvProviderPascal.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SingleLine := False;
Color := $D4D4D4;
Color2 := $E8E8E8;
ViewedTextBuffer.AddChangeHandler(senrHighlightChanged,
@HighlightChanged);
ViewedTextBuffer.AddNotifyHandler(senrTextBufferChanged,
@BufferChanged);
end;
destructor TIDESynGutterLOvProviderPascal.Destroy;
begin
ViewedTextBuffer.RemoveHandlers(self);
inherited Destroy;
end;
{ TIDESynGutterLOvProviderIDEMarks }
procedure TIDESynGutterLOvProviderIDEMarks.SetBreakColor(const AValue: TColor);
begin
if FBreakColor = AValue then exit;
FBreakColor := AValue;
FRGBBreakColor := ColorToRGB(AValue);
DoChange(Self);
end;
procedure TIDESynGutterLOvProviderIDEMarks.SetBreakDisabledColor(AValue: TColor);
begin
if FBreakDisabledColor = AValue then Exit;
FBreakDisabledColor := AValue;
FRGBBreakDisabledColor := ColorToRGB(AValue);
DoChange(Self);
end;
procedure TIDESynGutterLOvProviderIDEMarks.SetExecLineColor(AValue: TColor);
begin
if FExecLineColor = AValue then Exit;
FExecLineColor := AValue;
FRGBExecLineColor := ColorToRGB(AValue);
DoChange(Self);
end;
procedure TIDESynGutterLOvProviderIDEMarks.AdjustColorForMark(AMark: TSynEditMark;
var AColor: TColor; var APriority: Integer);
var
i: Integer;
ETMark: TETMark;
begin
if (AMark is TETMark) then begin
ETMark:=TETMark(AMark);
AColor:=ETMark.SourceMarks.MarkStyles[ETMark.Urgency].Color;
end else begin
inc(APriority, 1);
if not AMark.IsBookmark then begin
//if (AMark.ImageList = SourceEditorMarks.ImgList) then begin
i := AMark.ImageIndex;
if (i = SourceEditorMarks.CurrentLineImg) or
(i = SourceEditorMarks.CurrentLineBreakPointImg) or
(i = SourceEditorMarks.CurrentLineDisabledBreakPointImg)
then begin
dec(APriority, 1);
AColor := TColor(FRGBExecLineColor);
end
else
if (i = SourceEditorMarks.InactiveBreakPointImg) or
(i = SourceEditorMarks.InvalidDisabledBreakPointImg) or
(i = SourceEditorMarks.UnknownDisabledBreakPointImg)
then begin
inc(APriority, 2);
AColor := TColor(FRGBBreakDisabledColor);
end
else begin
AColor := TColor(FRGBBreakColor);
inc(APriority, 1);
end;
end;
end;
inherited AdjustColorForMark(AMark, AColor, APriority);
end;
constructor TIDESynGutterLOvProviderIDEMarks.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
BreakColor := $0080C8;
BreakDisabledColor := $00D000;
ExecLineColor := $F000D0;
end;
{ TIDESynGutter }
procedure TIDESynGutter.CreateDefaultGutterParts;
begin
IncChangeLock;
try
if Side = gsLeft then begin
with TIDESynGutterMarks.Create(Parts) do
Name := 'SynGutterMarks1';
with TSynGutterLineNumber.Create(Parts) do
Name := 'SynGutterLineNumber1';
with TSynGutterChanges.Create(Parts) do
Name := 'SynGutterChanges1';
with TSynGutterSeparator.Create(Parts) do
Name := 'SynGutterSeparator1';
with TIDESynGutterCodeFolding.Create(Parts) do
Name := 'SynGutterCodeFolding1';
end
else begin
{$IFDEF WithSynDebugGutter}
with TSynGutterSeparator.Create(Parts) do
Name := 'SynGutterSeparatorR1';
DebugGutter := TIDESynGutterDebugHL.Create(Parts);
with DebugGutter do
Name := 'TIDESynGutterDebugHL';
{$ENDIF}
with TSynGutterSeparator.Create(Parts) do
Name := 'SynGutterSeparatorR2';
with TSynGutterLineOverview.Create(Parts) do begin
Name := 'SynGutterLineOverview1';
with TIDESynGutterLOvProviderIDEMarks.Create(Providers) do
Priority := 20;
with TSynGutterLOvProviderModifiedLines.Create(Providers) do
Priority := 9;
with TSynGutterLOvProviderCurrentPage.Create(Providers) do
Priority := 1;
with TIDESynGutterLOvProviderPascal.Create(Providers) do
Priority := 0;
end;
with TSynGutterSeparator.Create(Parts) do begin
Name := 'SynGutterSeparatorR3';
AutoSize := False;
Width := 1;
LineWidth := 0;
end;
end;
finally
DecChangeLock;
end;
end;
{ TIDESynGutterMarks }
procedure TIDESynGutterMarks.CheckTextBuffer;
begin
if (FMarkInfoTextBuffer <> nil) and
(FMarkInfoTextBuffer <> TIDESynEditor(SynEdit).TextBuffer)
then begin
FMarkInfoTextBuffer := nil;
if FDebugMarkInfo <> nil then FDebugMarkInfo.DecRefCount;
if (FDebugMarkInfo <> nil) and (FDebugMarkInfo.RefCount = 0) then
FreeAndNil(FDebugMarkInfo);
end;
end;
procedure TIDESynGutterMarks.PaintLine(aScreenLine: Integer; Canvas: TCanvas; AClip: TRect);
var
aGutterOffs, TxtIdx, aScreenLine2: Integer;
iRange: TLineRange;
procedure DrawDebugMark(Line: Integer);
var
itop : Longint;
LineHeight: LongInt;
img: TScaledImageListResolution;
begin
LineHeight := TSynEdit(SynEdit).LineHeight;
img := GetImgListRes(Canvas, FBookMarkOpt.BookmarkImages);
iTop := 0;
if LineHeight > img.Height then
iTop := (LineHeight - img.Height) div 2;
img.Draw
(Canvas, AClip.Left + LeftMarginAtCurrentPPI + (ColumnCount-1) * ColumnWidth,
AClip.Top + iTop, DebugMarksImageIndex, True);
end;
begin
CheckTextBuffer;
aScreenLine2 := aScreenLine + ToIdx(GutterArea.TextArea.TopLine);
TxtIdx:= ViewedTextBuffer.DisplayView.ViewToTextIndexEx(aScreenLine2, iRange);
FCurLineHasDebugMark := (aScreenLine2 = iRange.Top) and (aScreenLine2 >= 0) and
(TxtIdx >= 0) and (TxtIdx < TSynEdit(SynEdit).Lines.Count) and
(HasDebugMarks) and (TxtIdx < FDebugMarkInfo.Count) and
(FDebugMarkInfo.SrcLineToMarkLine[TxtIdx] > 0) and
Assigned(FBookMarkOpt.BookmarkImages) and
(DebugMarksImageIndex <= FBookMarkOpt.BookmarkImages.Count) and
(DebugMarksImageIndex >= 0);
aGutterOffs := 0;
PaintMarks(aScreenLine, Canvas, AClip, aGutterOffs);
if FCurLineHasDebugMark then
DrawDebugMark(aScreenLine2);
end;
function TIDESynGutterMarks.PreferedWidthAtCurrentPPI: Integer;
var
img: TScaledImageListResolution;
c: Integer;
begin
if Assigned(SourceEditorMarks) and Assigned(SourceEditorMarks.ImgList) then
begin
c := WantedColumns;
if c <= 0 then c := 2;
img := GetImgListRes(nil, SourceEditorMarks.ImgList);
// + 1 => right margin
Result := img.Width * c + LeftMarginAtCurrentPPI + Scale96ToFont(1);
end else
Result := inherited PreferedWidthAtCurrentPPI;
end;
destructor TIDESynGutterMarks.Destroy;
begin
ClearDebugMarks;
inherited;
end;
procedure TIDESynGutterMarks.BeginSetDebugMarks;
begin
CheckTextBuffer;
if FDebugMarkInfo = nil then begin
FDebugMarkInfo := TIDESynDebugMarkInfo(TIDESynEditor(SynEdit).TextBuffer.Ranges[ClassType]);
if FDebugMarkInfo = nil then begin
FDebugMarkInfo := TIDESynDebugMarkInfo.Create;
// Todo: Add a notification, when TextBuffer Changes
FMarkInfoTextBuffer := TIDESynEditor(SynEdit).TextBuffer;
TIDESynEditor(SynEdit).TextBuffer.Ranges[ClassType] := FDebugMarkInfo;
end
else
FDebugMarkInfo.IncRefCount;
end;
end;
procedure TIDESynGutterMarks.EndSetDebugMarks;
begin
TSynEdit(SynEdit).InvalidateGutter;
end;
function TIDESynGutterMarks.GetImgListRes(const ACanvas: TCanvas;
const AImages: TCustomImageList): TScaledImageListResolution;
const
AllowedHeights: array[0..7] of Integer = (5, 7, 9, 11, 16, 22, 33, 44);
var
Scale: Double;
PPI, LineHeight, I, ImageHeight: Integer;
begin
// image height must be equal to width
if AImages.Width<>AImages.Height then
raise Exception.Create('Internal error: AImages.Width<>AImages.Height');
Scale := 1;
PPI := 96;
if SynEdit is TSynEdit then
begin
LineHeight := TSynEdit(SynEdit).LineHeight;
if LineHeight - Max(0, TSynEdit(SynEdit).ExtraLineSpacing) > 11 then
LineHeight := LineHeight - Max(0, TSynEdit(SynEdit).ExtraLineSpacing);
if LineHeight > 22 then
I := LineHeight div 8
else
I := 1;
If LineHeight - I >= 11 then
LineHeight := LineHeight - I;
if LineHeight < 11 then begin
LineHeight := TSynEdit(SynEdit).LineHeight;
if LineHeight > 11 then
LineHeight := LineHeight - 1;
end;
if (LineHeight > ColumnWidth + 1) and (ColumnWidth > 0) then
LineHeight := ColumnWidth + (LineHeight - ColumnWidth) div 2;
ImageHeight := AllowedHeights[0];
for I := High(AllowedHeights) downto Low(AllowedHeights) do
if AllowedHeights[I] <= LineHeight then
begin
ImageHeight := AllowedHeights[I];
break;
end;
// don't set PPI here -> we don't want to scale the image anymore
end else
begin
ImageHeight := AImages.Height;
if ACanvas is TControlCanvas then
PPI := TControlCanvas(ACanvas).Control.Font.PixelsPerInch;
end;
if ACanvas is TControlCanvas then
Scale := TControlCanvas(ACanvas).Control.GetCanvasScaleFactor;
Result := AImages.ResolutionForPPI[ImageHeight, PPI, Scale];
end;
function TIDESynGutterMarks.MarksToDrawInfo(AMLine: TSynEditMarkLine;
var ADrawInfo: TSynEditMarkDrawInfoArray; AMaxEntries: integer; out
aFirstCustomColumnIdx: integer; out AHasNonBookmark: boolean): integer;
var
i, j: Integer;
begin
Result := inherited MarksToDrawInfo(AMLine, ADrawInfo, AMaxEntries, aFirstCustomColumnIdx,
AHasNonBookmark);
if (Result > 1) and (ADrawInfo[0].Mark = nil) and (ADrawInfo[1].Mark is TETMark) and
( (ColumnCount <= 2) or
((Result = ColumnCount) and (ADrawInfo[Result-1].Mark is TETMark)) )
then begin
dec(Result);
for i := 0 to Result - 1 do
ADrawInfo[i] := ADrawInfo[i+1];
end;
if Result <= ColumnCount then begin
i := Result - 1;
while (i >= 0) and (ADrawInfo[i].Mark <> nil) and
( (ADrawInfo[i].Mark is TExecutionMark) or
((ADrawInfo[i].Mark is TSourceMark) and (TSourceMark(ADrawInfo[i].Mark).IsBreakPoint))
)
do
dec(i);
inc(i);
if i < Result then begin
if Result < ColumnCount then begin
i := Result - i; // columns to move
if Length(ADrawInfo) < ColumnCount then
SetLength(ADrawInfo, Max(ColumnCount, AMaxEntries));
for j := 1 to i do
ADrawInfo[ColumnCount - j] := ADrawInfo[Result - j];
for j := Result - i to ColumnCount - 1 - i do begin
ADrawInfo[j].Mark := nil;
ADrawInfo[j].Images := nil;
end;
Result := ColumnCount;
end;
end
else begin
// debug line mark ?
if FCurLineHasDebugMark then begin
if Length(ADrawInfo) < ColumnCount+1 then
SetLength(ADrawInfo, Max(ColumnCount+1, AMaxEntries));
for i := Result to ColumnCount - 1 do begin
ADrawInfo[i].Mark := nil;
ADrawInfo[i].Images := nil;
end;
if Result < ColumnCount then
Result := ColumnCount
else
Result := ColumnCount + 1;
ADrawInfo[Result-1].Mark := nil;
ADrawInfo[Result-1].Images := FBookMarkOpt.BookmarkImages;
ADrawInfo[Result-1].IconIdx := DebugMarksImageIndex;
end;
end;
end;
FCurLineHasDebugMark := False; // done
end;
constructor TIDESynGutterMarks.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Options := [sgmoDeDuplicateMarksOnOverflow, sgmoDeDuplicateMarksKeepTwo];
MaxExtraMarksColums := 3;
end;
procedure TIDESynGutterMarks.SetDebugMarks(AFirstLinePos, ALastLinePos: Integer);
var
i: LongInt;
begin
CheckTextBuffer;
if ALastLinePos > FDebugMarkInfo.Count then begin
//debugln(['Request to set debug-mark out of range: max-count=',FDebugMarkInfo.Count,' Marks=',AFirstLinePos,' to=',ALastLinePos]);
ALastLinePos := FDebugMarkInfo.Count;
end;
if AFirstLinePos < 1 then begin
//debugln(['Request to set debug-mark out of range: max-count=',FDebugMarkInfo.Count,' Marks=',AFirstLinePos,' to=',ALastLinePos]);
AFirstLinePos := 1;
end;
for i := AFirstLinePos - 1 to ALastLinePos - 1 do
FDebugMarkInfo[i] := i + 1;
end;
procedure TIDESynGutterMarks.ClearDebugMarks;
begin
CheckTextBuffer;
if FDebugMarkInfo = nil then exit;
FDebugMarkInfo.DecRefCount;
if FDebugMarkInfo.RefCount = 0 then begin
TIDESynEditor(SynEdit).TextBuffer.Ranges[ClassType] := nil;
FreeAndNil(FDebugMarkInfo);
end;
FDebugMarkInfo := nil;
FMarkInfoTextBuffer := nil;
TSynEdit(SynEdit).InvalidateGutter;
end;
function TIDESynGutterMarks.HasDebugMarks: Boolean;
begin
CheckTextBuffer;
if FDebugMarkInfo = nil then begin
FDebugMarkInfo := TIDESynDebugMarkInfo(TIDESynEditor(SynEdit).TextBuffer.Ranges[ClassType]);
if FDebugMarkInfo <> nil then begin
FDebugMarkInfo.IncRefCount;
TSynEdit(SynEdit).InvalidateGutter;
end;
end;
Result := FDebugMarkInfo <> nil;
end;
function TIDESynGutterMarks.DebugLineToSourceLine(aLinePos: Integer): Integer;
var
i, c: LongInt;
MaxCnt: Integer;
begin
CheckTextBuffer;
if (aLinePos < 1) or (not HasDebugMarks) then exit(aLinePos);
Result := aLinePos - 1; // 0 based
MaxCnt := FDebugMarkInfo.Count;
Result := MinMax(Result, 0, MaxCnt - 1);
if (FDebugMarkInfo[Result] = 0) or (FDebugMarkInfo[Result] > aLinePos) then begin
i := Result;
repeat
dec(i);
while (i >= 0) and (FDebugMarkInfo[i] = 0) do dec(i);
if (i < 0) or (FDebugMarkInfo[i] < aLinePos) then break;
Result := i;
until FDebugMarkInfo[Result] = aLinePos;
if (FDebugMarkInfo[Result] > aLinePos) and // line not found
(Result > 0) and (FDebugMarkInfo[Result - 1] = 0)
then
dec(Result);
end;
if (FDebugMarkInfo[Result] = 0) or (FDebugMarkInfo[Result] < aLinePos) then begin
c := FDebugMarkInfo.Count;
i := Result;
repeat
inc(i);
while (i < c) and (FDebugMarkInfo[i] = 0) do inc(i);
if (i >= c) or (FDebugMarkInfo[i] > aLinePos) then break;
Result := i;
until FDebugMarkInfo[Result] = aLinePos;
if (FDebugMarkInfo[Result] < aLinePos) and // line not found
(FDebugMarkInfo[Result] <> 0) and
(Result < c-1) and (FDebugMarkInfo[Result + 1] = 0)
then
inc(Result);
end;
inc(Result); // 1 based
end;
function TIDESynGutterMarks.SourceLineToDebugLine(aLinePos: Integer;
AdjustOnError: Boolean): Integer;
begin
CheckTextBuffer;
if (aLinePos < 1) or (not HasDebugMarks) or (aLinePos >= FDebugMarkInfo.Count) then
exit(aLinePos);
Result := FDebugMarkInfo[aLinePos - 1];
while (Result = 0) and AdjustOnError and (aLinePos < FDebugMarkInfo.Count-1) do begin
inc(aLinePos);
Result := FDebugMarkInfo[aLinePos - 1];
end;
end;
{ TIDESynDebugMarkInfo }
function TIDESynDebugMarkInfo.GetSrcLineToMarkLine(SrcIndex: Integer): Integer;
begin
Result := Integer(ItemPointer[SrcIndex]^);
end;
procedure TIDESynDebugMarkInfo.SetSrcLineToMarkLine(SrcIndex: Integer; const AValue: Integer);
begin
Integer(ItemPointer[SrcIndex]^) := AValue;
end;
constructor TIDESynDebugMarkInfo.Create;
begin
Inherited;
ItemSize := SizeOf(Integer);
FRefCount := 1;
end;
procedure TIDESynDebugMarkInfo.IncRefCount;
begin
inc(FRefCount);
end;
procedure TIDESynDebugMarkInfo.DecRefCount;
begin
dec(FRefCount);
end;
{ TIDESynGutterCodeFolding }
procedure TIDESynGutterCodeFolding.PopClickedFoldIfdef(Sender: TObject);
begin
FoldIfdef(True);
end;
procedure TIDESynGutterCodeFolding.PopClickedFoldIfdefNoMixed(Sender: TObject);
begin
FoldIfdef(False);
end;
procedure TIDESynGutterCodeFolding.PopClickedUnfoldIfdefActive(Sender: TObject);
begin
UnFoldIfdef(False, True);
end;
procedure TIDESynGutterCodeFolding.PopClickedUnfolDIfdefAll(Sender: TObject);
begin
UnFoldIfdef(True, True);
end;
procedure TIDESynGutterCodeFolding.PopClickedUnfoldIfdefInactiv(Sender: TObject);
begin
UnFoldIfdef(True, False);
end;
procedure TIDESynGutterCodeFolding.UnFoldIfdef(AInclDisabled, AInclEnabled: Boolean);
var
i, j, k, y1, y2: Integer;
CurTopLine: TSrcSynTopLineInfo;
FldInf: TSynFoldNodeInfo;
Tree: TSynMarkupHighIfDefLinesTree;
IfLineNode: TSynMarkupHighIfDefLinesNodeInfo;
IsDisabled: Boolean;
begin
CurTopLine := TIDESynEditor(SynEdit).GetTopLineBeforeFold;
if TSynEdit(SynEdit).SelAvail then begin
y1 := TSynEdit(SynEdit).BlockBegin.Y;
y2 := TSynEdit(SynEdit).BlockEnd.Y;
if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
end
else begin
y1 := 1;
y2 := TSynEdit(SynEdit).Lines.Count - 1;
end;
Tree := TIDESynEditor(SynEdit).FMarkupIfDef.IfDefTree;
if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
for i := y1-1 to y2-1 do begin
j := FoldView.FoldProvider.FoldOpenCount(i);
while j > 0 do begin
dec(j);
if FoldView.IsFoldedAtTextIndex(i,j) then begin
FldInf := FoldView.FoldProvider.FoldOpenInfo(i, j);
if TPascalCodeFoldBlockType({%H-}PtrUInt(FldInf.FoldType)) in [cfbtIfDef]
then begin
if AInclDisabled and AInclEnabled then begin
FoldView.UnFoldAtTextIndex(i, j, 1, False, 1);
end
else begin
IfLineNode := Tree.FindNodeAtPosition(ToPos(i), afmNil);
k := IfLineNode.EntryCount - 1;
while (k >= 0) and (IfLineNode.Entry[k].StartColumn <> FldInf.LogXStart) do
dec(k);
IsDisabled := (k >= 0) and (IfLineNode.Entry[k].IsDisabled);
if (AInclDisabled and IsDisabled) or (AInclEnabled and not IsDisabled) then
FoldView.UnFoldAtTextIndex(i, j, 1, False, 1);
end;
end;
end; //FoldView.IsFoldedAtTextIndex(i,j)
end;
end;
TIDESynEditor(SynEdit).RestoreTopLineAfterFold(CurTopLine);
end;
procedure TIDESynGutterCodeFolding.FoldIfdef(AInclTemp: Boolean);
var
i, j, k, y1, y2: Integer;
CurTopLine: TSrcSynTopLineInfo;
FldInf: TSynFoldNodeInfo;
Tree: TSynMarkupHighIfDefLinesTree;
IfLineNode: TSynMarkupHighIfDefLinesNodeInfo;
begin
CurTopLine := TIDESynEditor(SynEdit).GetTopLineBeforeFold;
if TSynEdit(SynEdit).SelAvail then begin
y1 := TSynEdit(SynEdit).BlockBegin.Y;
y2 := TSynEdit(SynEdit).BlockEnd.Y;
if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
end
else begin
y1 := 1;
y2 := TSynEdit(SynEdit).Lines.Count - 1;
end;
Tree := TIDESynEditor(SynEdit).FMarkupIfDef.IfDefTree;
if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
for i := y1-1 to y2-1 do begin
j := FoldView.FoldProvider.FoldOpenCount(i);
while j > 0 do begin
dec(j);
FldInf := FoldView.FoldProvider.FoldOpenInfo(i, j);
if (TPascalCodeFoldBlockType({%H-}PtrUInt(FldInf.FoldType)) in [cfbtIfDef]) and
(sfaFoldFold in FldInf.FoldAction)
then begin
IfLineNode := Tree.FindNodeAtPosition(ToPos(i), afmNil);
k := IfLineNode.EntryCount - 1;
while (k >= 0) and (IfLineNode.Entry[k].StartColumn <> FldInf.LogXStart) do
dec(k);
if (k >= 0) and (IfLineNode.Entry[k].IsDisabled) and
( (not (IfLineNode.Entry[k].IsTemp)) or AInclTemp )
then
FoldView.FoldAtTextIndex(i, j, 1, False, 1);
end;
end;
end;
TIDESynEditor(SynEdit).RestoreTopLineAfterFold(CurTopLine);
end;
procedure TIDESynGutterCodeFolding.PopClickedUnfoldAll(Sender: TObject);
var
i, y1, y2: Integer;
CurTopLine: TSrcSynTopLineInfo;
begin
CurTopLine := TIDESynEditor(SynEdit).GetTopLineBeforeFold;
if not TSynEdit(SynEdit).SelAvail then begin
FoldView.UnfoldAll;
TIDESynEditor(SynEdit).RestoreTopLineAfterFold(CurTopLine);
exit;
end;
y1 := TSynEdit(SynEdit).BlockBegin.Y;
y2 := TSynEdit(SynEdit).BlockEnd.Y;
if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
for i := y1-1 to y2-1 do
FoldView.UnFoldAtTextIndex(i);
TIDESynEditor(SynEdit).RestoreTopLineAfterFold(CurTopLine);
end;
procedure TIDESynGutterCodeFolding.PopClickedUnfoldComment(Sender: TObject);
var
i, j, y1, y2: Integer;
CurTopLine: TSrcSynTopLineInfo;
FldInf: TSynFoldNodeInfo;
begin
CurTopLine := TIDESynEditor(SynEdit).GetTopLineBeforeFold;
if TSynEdit(SynEdit).SelAvail then begin
y1 := TSynEdit(SynEdit).BlockBegin.Y;
y2 := TSynEdit(SynEdit).BlockEnd.Y;
if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
end
else begin
y1 := 1;
y2 := TSynEdit(SynEdit).Lines.Count - 1;
end;
for i := y1-1 to y2-1 do begin
j := FoldView.FoldProvider.FoldOpenCount(i);
while j > 0 do begin
dec(j);
if FoldView.IsFoldedAtTextIndex(i,j) then begin
FldInf := FoldView.FoldProvider.FoldOpenInfo(i, j);
if TPascalCodeFoldBlockType({%H-}PtrUInt(FldInf.FoldType)) in
[cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]
then begin
FoldView.UnFoldAtTextIndex(i, j, 1, False, 0);
FoldView.UnFoldAtTextIndex(i, j, 1, False, 1);
end;
end;
end;
end;
TIDESynEditor(SynEdit).RestoreTopLineAfterFold(CurTopLine);
end;
procedure TIDESynGutterCodeFolding.PopClickedFoldComment(Sender: TObject);
var
i, j, y1, y2: Integer;
CurTopLine: TSrcSynTopLineInfo;
FldInf: TSynFoldNodeInfo;
begin
CurTopLine := TIDESynEditor(SynEdit).GetTopLineBeforeFold;
if TSynEdit(SynEdit).SelAvail then begin
y1 := TSynEdit(SynEdit).BlockBegin.Y;
y2 := TSynEdit(SynEdit).BlockEnd.Y;
if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
end
else begin
y1 := 1;
y2 := TSynEdit(SynEdit).Lines.Count - 1;
end;
for i := y1-1 to y2-1 do begin
j := FoldView.FoldProvider.FoldOpenCount(i);
while j > 0 do begin
dec(j);
FldInf := FoldView.FoldProvider.FoldOpenInfo(i, j);
if (TPascalCodeFoldBlockType({%H-}PtrUInt(FldInf.FoldType)) in
[cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]) and
(sfaFoldFold in FldInf.FoldAction)
then begin
FoldView.FoldAtTextIndex(i, j, 1, False, 1);
end;
end;
end;
TIDESynEditor(SynEdit).RestoreTopLineAfterFold(CurTopLine);
end;
procedure TIDESynGutterCodeFolding.PopClickedHideComment(Sender: TObject);
var
i, j, y1, y2: Integer;
CurTopLine: TSrcSynTopLineInfo;
FldInf: TSynFoldNodeInfo;
begin
CurTopLine := TIDESynEditor(SynEdit).GetTopLineBeforeFold;
if TSynEdit(SynEdit).SelAvail then begin
y1 := TSynEdit(SynEdit).BlockBegin.Y;
y2 := TSynEdit(SynEdit).BlockEnd.Y;
if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
end
else begin
y1 := 1;
y2 := TSynEdit(SynEdit).Lines.Count - 1;
end;
for i := y1-1 to y2-1 do begin
j := FoldView.FoldProvider.FoldOpenCount(i);
while j > 0 do begin
dec(j);
FldInf := FoldView.FoldProvider.FoldOpenInfo(i, j);
if (TPascalCodeFoldBlockType({%H-}PtrUInt(FldInf.FoldType)) in
[cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]) and
(sfaFoldHide in FldInf.FoldAction)
then begin
FoldView.FoldAtTextIndex(i, j, 1, False, 0);
end;
end;
end;
TIDESynEditor(SynEdit).RestoreTopLineAfterFold(CurTopLine);
end;
procedure TIDESynGutterCodeFolding.CreatePopUpMenuEntries(var APopUp: TPopupMenu; ALine: Integer);
var
i, j, k, y1, y2: Integer;
HasFolds, HasHideableComments, HasFoldableComments, HasCollapsedComments: Boolean;
ft: TPascalCodeFoldBlockType;
Foldable, HideAble: TPascalCodeFoldBlockTypes;
lc: TSynEditFoldLineCapabilities;
HasFoldableDisabledIfDef, HasFoldableTempDisabledIfDef,
HasCollapsedActiveIfDef, HasCollapsedDisabledIfDef: Boolean; // HasCollapsedActiveIfDef includes all NOT disabled
Tree: TSynMarkupHighIfDefLinesTree;
IfLineNode: TSynMarkupHighIfDefLinesNodeInfo;
FProv: TSynEditFoldProvider;
inf: TSynFoldNodeInfo;
HasComments, HasIfdef: Boolean;
procedure CheckFoldConf(Val: TPascalCodeFoldBlockType);
begin
if not TSynPasSyn(FoldView.HighLighter).FoldConfig[ord(Val)].Enabled then
exit;
if fmFold in TSynPasSyn(FoldView.HighLighter).FoldConfig[ord(Val)].Modes then
include(Foldable, Val);
if fmHide in TSynPasSyn(FoldView.HighLighter).FoldConfig[ord(Val)].Modes then
include(HideAble, Val);
end;
function AddPopUpItem(const ACaption: String): TMenuItem;
begin
Result := TMenuItem.Create(APopUp);
Result.Caption := ACaption;
APopUp.Items.Add(Result);
end;
begin
inherited CreatePopUpMenuEntries(APopUp, ALine);
if not (FoldView.HighLighter is TSynPasSyn) then
exit;
Foldable := [];
HideAble := [];
CheckFoldConf(cfbtAnsiComment);
CheckFoldConf(cfbtBorCommand);
CheckFoldConf(cfbtSlashComment);
if TIDESynEditor(SynEdit).IsIfdefMarkupActive then
CheckFoldConf(cfbtIfDef);
if (Foldable = []) and (HideAble = []) then
exit;
HasHideableComments := False;
HasFoldableComments := False;
HasCollapsedComments := False;
HasFoldableDisabledIfDef := False;
HasFoldableTempDisabledIfDef := False;
HasCollapsedActiveIfDef := False;
HasCollapsedDisabledIfDef := False;
HasComments := (Foldable*[cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment] <> []) or
(HideAble*[cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment] <> []);
HasIfdef := (Foldable*[cfbtIfDef] <> []);
if TSynEdit(SynEdit).SelAvail then begin
y1 := TSynEdit(SynEdit).BlockBegin.Y;
y2 := TSynEdit(SynEdit).BlockEnd.Y;
if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2);
end
else begin
y1 := 1;
y2 := TSynEdit(SynEdit).Lines.Count - 1;
end;
HasFolds := FoldView.TextToViewIndex(y2) - FoldView.TextToViewIndex(y1) <> y2 - y1;
//debugln(['*** HasFolds=', HasFolds, ' y1=',y1, ' y2=',y2, ' VP1=',FoldView.TextToViewIndex(y1), ' VP2=',FoldView.TextToViewIndex(y2)]);
FProv := FoldView.FoldProvider;
Tree := TIDESynEditor(SynEdit).FMarkupIfDef.IfDefTree;
IfLineNode.ClearInfo;
i := ToIdx(y1);
while i < y2 do begin // lines in selection
lc := FProv.LineCapabilities[i];
j := FProv.FoldOpenCount(i);
while j > 0 do begin // foldnodes on line
dec(j);
inf := FProv.FoldOpenInfo(i, j);
ft := TPascalCodeFoldBlockType({%H-}PtrUInt(inf.FoldType));
if not ((ft in Foldable) or (ft in HideAble)) then
continue;
if ft = cfbtIfDef then begin
if IfLineNode.StartLine <> ToPos(i) then
IfLineNode := Tree.FindNodeAtPosition(ToPos(i), afmNil);
k := IfLineNode.EntryCount - 1; // -1 if no node
while (k >= 0) and (IfLineNode.Entry[k].StartColumn <> inf.LogXStart) do
dec(k);
if FoldView.IsFoldedAtTextIndex(i,j) then begin
if (k >= 0) and (IfLineNode.Entry[k].IsDisabled) then
HasCollapsedDisabledIfDef := True
else
HasCollapsedActiveIfDef := True;
end
else // IFDEF is only Fold-able, not hide-able
if (k >= 0) and (IfLineNode.Entry[k].IsDisabled) then begin
if IfLineNode.Entry[k].IsTemp then
HasFoldableTempDisabledIfDef := True
else
HasFoldableDisabledIfDef := True;
end;
end
else begin
// comment
if FoldView.IsFoldedAtTextIndex(i,j) then begin
HasCollapsedComments := True;
end
else begin
if (ft in Foldable) and (cfFoldStart in lc) then
HasFoldableComments := True;
if (ft in HideAble) and (cfHideStart in lc) then
HasHideableComments := True;
end;
end;
end;
if (not HasComments) or
( (HasFoldableComments and HasHideableComments) and
((not HasFolds) or (HasCollapsedComments))
)
then begin
// found all comment info
if (not HasIfdef) or
( (HasFoldableDisabledIfDef and HasFoldableTempDisabledIfDef) and
((not HasFolds) or (HasCollapsedActiveIfDef and HasCollapsedDisabledIfDef))
)
then
break;
// only Ifdef needed
if IfLineNode.HasNode and (IfLineNode.StartLine = ToPos(i)) then
IfLineNode := IfLineNode.Successor
else
IfLineNode := Tree.FindNodeAtPosition(ToPos(i)+1, afmNext);
if not IfLineNode.HasNode then
break;
i := ToIdx(IfLineNode.StartLine);
end
else
inc(i);
end;
if (HasFolds) and (APopUp.Items.Count > 0) then
AddPopUpItem(cLineCaption);
If HasFolds then
if TSynEdit(SynEdit).SelAvail
then AddPopUpItem(synfUnfoldAllInSelection).OnClick := @PopClickedUnfoldAll
else AddPopUpItem(synfUnfoldAll).OnClick := @PopClickedUnfoldAll;
if (HasCollapsedComments or HasFoldableComments or HasHideableComments) and
(APopUp.Items.Count > 0)
then
AddPopUpItem(cLineCaption);
If HasCollapsedComments then
if TSynEdit(SynEdit).SelAvail
then AddPopUpItem(synfUnfoldCommentsInSelection).OnClick := @PopClickedUnfoldComment
else AddPopUpItem(synfUnfoldComments).OnClick := @PopClickedUnfoldComment;
If HasFoldableComments then
if TSynEdit(SynEdit).SelAvail
then AddPopUpItem(synfFoldCommentsInSelection).OnClick := @PopClickedFoldComment
else AddPopUpItem(synfFoldComments).OnClick := @PopClickedFoldComment;
If HasHideableComments then
if TSynEdit(SynEdit).SelAvail
then AddPopUpItem(synfHideCommentsInSelection).OnClick := @PopClickedHideComment
else AddPopUpItem(synfHideComments).OnClick := @PopClickedHideComment;
if (HasFoldableDisabledIfDef or HasCollapsedDisabledIfDef or
HasCollapsedDisabledIfDef or HasCollapsedActiveIfDef) and
(APopUp.Items.Count > 0)
then
AddPopUpItem(cLineCaption);
If HasCollapsedActiveIfDef and HasCollapsedDisabledIfDef then
if TSynEdit(SynEdit).SelAvail
then AddPopUpItem(synfUnfoldAllIfdefInSelection).OnClick := @PopClickedUnfolDIfdefAll
else AddPopUpItem(synfUnfoldAllIfdef).OnClick := @PopClickedUnfolDIfdefAll;
If HasCollapsedActiveIfDef then
if TSynEdit(SynEdit).SelAvail
then AddPopUpItem(synfUnfoldActiveIfdefInSelection).OnClick := @PopClickedUnfoldIfdefActive
else AddPopUpItem(synfUnfoldActiveIfdef).OnClick := @PopClickedUnfoldIfdefActive;
If HasCollapsedDisabledIfDef then
if TSynEdit(SynEdit).SelAvail
then AddPopUpItem(synfUnfoldInactiveIfdefInSelection).OnClick := @PopClickedUnfoldIfdefInactiv
else AddPopUpItem(synfUnfoldInactiveIfdef).OnClick := @PopClickedUnfoldIfdefInactiv;
If HasFoldableDisabledIfDef or HasFoldableTempDisabledIfDef then
if TSynEdit(SynEdit).SelAvail
then AddPopUpItem(synfFoldInactiveIfdefInSelection).OnClick := @PopClickedFoldIfdef
else AddPopUpItem(synfFoldInactiveIfdef).OnClick := @PopClickedFoldIfdef;
If HasFoldableDisabledIfDef and HasFoldableTempDisabledIfDef then
if TSynEdit(SynEdit).SelAvail
then AddPopUpItem(synfFoldInactiveIfdefInSelectionExcludeMixedState).OnClick := @PopClickedFoldIfdefNoMixed
else AddPopUpItem(synfFoldInactiveIfdefExcludeMixedState).OnClick := @PopClickedFoldIfdefNoMixed;
end;
end.