{ /*************************************************************************** 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 . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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 {$IFDEF WinIME} LazSynIMM, {$ENDIF} Classes, SysUtils, Controls, LCLProc, LCLType, Graphics, Menus, math, LazarusIDEStrConsts, 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; type TIDESynGutterMarks = class; {$IFDEF WithSynDebugGutter} TIDESynGutterDebugHL = class; {$ENDIF} { TSourceLazSynTopInfoView } TSourceLazSynTopInfoView = class(TLazSynDisplayViewEx) private FLineMapCount: integer; FLineMap: array of integer; function GetLineMap(Index: Integer): Integer; procedure SetLineMap(Index: Integer; AValue: Integer); procedure SetLineMapCount(AValue: integer); public procedure SetHighlighterTokensLine(ALine: TLineIdx; out ARealLine: TLineIdx); override; function GetLinesCount: Integer; override; function TextToViewIndex(AIndex: TLineIdx): TLineRange; override; function ViewToTextIndex(AIndex: TLineIdx): TLineIdx; override; public constructor Create; property LineMapCount: integer read FLineMapCount write SetLineMapCount; property LineMap[Index: Integer]: Integer read GetLineMap write SetLineMap; end; { TSourceLazSynSurfaceGutter } TSourceLazSynSurfaceGutter = class(TLazSynGutterArea) protected procedure DoPaint(ACanvas: TCanvas; AClip: TRect); override; end; { TSourceLazSynSurfaceManager } TSourceLazSynSurfaceManager = class(TLazSynSurfaceManager) private FExtraManager: TLazSynSurfaceManager; FOriginalManager: TLazSynSurfaceManager; FTopLineCount: Integer; procedure SetTopLineCount(AValue: Integer); protected function GetLeftGutterArea: TLazSynSurface; override; function GetRightGutterArea: TLazSynSurface; 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 BoundsChanged; override; public constructor Create(AOwner: TWinControl; AnOriginalManager: TLazSynSurfaceManager); destructor Destroy; override; procedure InvalidateLines(FirstTextLine, LastTextLine: TLineIdx); override; procedure InvalidateTextLines(FirstTextLine, LastTextLine: TLineIdx); override; procedure InvalidateGutterLines(FirstTextLine, LastTextLine: TLineIdx); 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; { TIDESynEditor } TIDESynEditor = class(TSynEdit) private FShowTopInfo: boolean; FSyncroEdit: TSynPluginSyncroEdit; FTemplateEdit: TSynPluginTemplateEdit; FMarkupForGutterMark: TSynEditMarkupGutterMark; {$IFDEF WithSynMarkupIfDef} FMarkupIfDef: TSynEditMarkupIfDef; {$ENDIF} FTopInfoDisplay: TSourceLazSynTopInfoView; FSrcSynCaretChangedLock: boolean; FExtraMarkupLine: TSynEditMarkupSpecialLine; FExtraMarkupMgr: TSynEditMarkupManager; FTopInfoMarkup: TSynSelectedColor; FUserWordsList: TList; function GetHighlightUserWordCount: Integer; function GetHighlightUserWords(AIndex: Integer): TSourceSynEditMarkupHighlightAllMulti; function GetIDEGutterMarks: TIDESynGutterMarks; procedure GetTopInfoMarkupForLine(Sender: TObject; {%H-}Line: integer; var Special: boolean; aMarkup: TSynSelectedColor); procedure SetHighlightUserWordCount(AValue: Integer); procedure SetShowTopInfo(AValue: boolean); procedure SetTopInfoMarkup(AValue: TSynSelectedColor); procedure SrcSynCaretChanged(Sender: TObject); protected procedure DoOnStatusChange(Changes: TSynStatusChanges); override; function CreateGutter(AOwner : TSynEditBase; ASide: TSynGutterSide; ATextDrawer: TheTextDrawer): TSynGutter; override; procedure SetHighlighter(const Value: TSynCustomHighlighter); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function TextIndexToViewPos(aTextIndex : Integer) : Integer; property IDEGutterMarks: TIDESynGutterMarks read GetIDEGutterMarks; property TopView; property TextBuffer; property ViewedTextBuffer; property TemplateEdit: TSynPluginTemplateEdit read FTemplateEdit; property SyncroEdit: TSynPluginSyncroEdit read FSyncroEdit; ////// 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; end; TIDESynHighlighterPasRangeList = class(TSynHighlighterPasRangeList) protected FInterfaceLine, FImplementationLine, FInitializationLine, FFinalizationLine: Integer; end; { TIDESynPasSyn } TIDESynPasSyn = class(TSynPasSyn) private function GetFinalizationLine: Integer; function GetImplementationLine: Integer; function GetInitializationLine: Integer; function GetInterfaceLine: Integer; protected function CreateRangeList({%H-}ALines: TSynEditStringsBase): TSynHighlighterRangeList; override; function StartCodeFoldBlock(ABlockType: Pointer; IncreaseLevel: Boolean = true): TSynCustomCodeFoldBlock; override; public 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) // Bookmarsk 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; protected procedure CheckTextBuffer; // Todo: Add a notification, when TextBuffer Changes Procedure PaintLine(aScreenLine: Integer; Canvas : TCanvas; AClip : TRect); override; public 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 PopClickedUnfoldAll(Sender: TObject); procedure PopClickedUnfoldComment(Sender: TObject); procedure PopClickedFoldComment(Sender: TObject); procedure PopClickedHideComment(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 uses SourceMarks; { 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 (LowerCase(ATerm) <> LowerCase(Entry.SearchTerm)) ) 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 (LowerCase(t.SearchTerm)= LowerCase(s)) ) ) 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 := ''; 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.DisplayNumber[i]; 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.DisplayNumber[i]; 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; SetLength(FLineMap, AValue); end; procedure TSourceLazSynTopInfoView.SetHighlighterTokensLine(ALine: TLineIdx; out ARealLine: TLineIdx); begin CurrentTokenLine := ALine; inherited SetHighlighterTokensLine(FLineMap[ALine], ARealLine); end; function TSourceLazSynTopInfoView.GetLinesCount: Integer; begin Result := LineMapCount; end; function TSourceLazSynTopInfoView.TextToViewIndex(AIndex: TLineIdx): TLineRange; var i: Integer; r: TLineRange; begin 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 LineMapCount := 0; end; { TSourceLazSynSurfaceGutter } procedure TSourceLazSynSurfaceGutter.DoPaint(ACanvas: TCanvas; AClip: TRect); begin // prevent output Gutter.Paint(ACanvas, Self, AClip, 0, -1); end; { TSourceLazSynSurfaceManager } procedure TSourceLazSynSurfaceManager.SetTopLineCount(AValue: Integer); begin if FTopLineCount = AValue then Exit; FTopLineCount := AValue; BoundsChanged; end; function TSourceLazSynSurfaceManager.GetLeftGutterArea: TLazSynSurface; begin Result := FOriginalManager.LeftGutterArea; end; function TSourceLazSynSurfaceManager.GetRightGutterArea: TLazSynSurface; 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.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); begin FOriginalManager.InvalidateLines(FirstTextLine, LastTextLine); FExtraManager.InvalidateLines(FirstTextLine, LastTextLine); end; procedure TSourceLazSynSurfaceManager.InvalidateTextLines(FirstTextLine, LastTextLine: TLineIdx); begin FOriginalManager.InvalidateTextLines(FirstTextLine, LastTextLine); FExtraManager.InvalidateTextLines(FirstTextLine, LastTextLine); end; procedure TSourceLazSynSurfaceManager.InvalidateGutterLines(FirstTextLine, LastTextLine: TLineIdx); begin FOriginalManager.InvalidateGutterLines(FirstTextLine, LastTextLine); FExtraManager.InvalidateGutterLines(FirstTextLine, LastTextLine); end; { TIDESynEditor } procedure TIDESynEditor.SrcSynCaretChanged(Sender: TObject); var InfCnt, i, t, ListCnt: Integer; InfList: array [0..1] of record LineIndex: Integer; FoldType: TPascalCodeFoldBlockType; end; NodeFoldType: TPascalCodeFoldBlockType; List: TLazSynEditNestedFoldsList; begin if (not FShowTopInfo) or (not HandleAllocated) then exit; if FSrcSynCaretChangedLock or not(TextView.HighLighter is TSynPasSyn) then exit; FSrcSynCaretChangedLock := True; try ListCnt := 0; if CaretY >= TopLine then begin List := TextView.FoldProvider.NestedFoldsList; List.ResetFilter; List.Clear; List.Line := CaretY-1; List.FoldGroup := FOLDGROUP_PASCAL; List.FoldFlags := [sfbIncludeDisabled]; List.IncludeOpeningOnLine := False; InfCnt := List.Count; for i := InfCnt-1 downto 0 do begin NodeFoldType := TPascalCodeFoldBlockType({%H-}PtrUInt(List.NodeFoldType[i])); if not(NodeFoldType in [cfbtClass, cfbtClassSection, cfbtProcedure]) then continue; if (NodeFoldType in [cfbtClassSection]) and (ListCnt = 0) then begin InfList[ListCnt].LineIndex := List.NodeLine[i]; InfList[ListCnt].FoldType := NodeFoldType; inc(ListCnt); end; if (NodeFoldType in [cfbtClass]) and (ListCnt < 2) then begin InfList[ListCnt].LineIndex := List.NodeLine[i]; InfList[ListCnt].FoldType := NodeFoldType; inc(ListCnt); end; if (NodeFoldType in [cfbtProcedure]) and (ListCnt < 2) then begin InfList[ListCnt].LineIndex := List.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 := List.NodeLine[i]; InfList[ListCnt-1].FoldType := NodeFoldType; end; end; end; 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 TopLine := t; TSourceLazSynSurfaceManager(FPaintArea).TopLineCount := ListCnt; SizeOrFontChanged(FALSE); Invalidate; // TODO: move to PaintArea end; 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; finally FSrcSynCaretChangedLock := False; end; end; procedure TIDESynEditor.DoOnStatusChange(Changes: TSynStatusChanges); begin inherited DoOnStatusChange(Changes); if Changes * [scTopLine, scLinesInWindow] <> []then SrcSynCaretChanged(nil); end; procedure TIDESynEditor.GetTopInfoMarkupForLine(Sender: TObject; Line: integer; var Special: boolean; aMarkup: TSynSelectedColor); begin Special := True; aMarkup.Assign(FTopInfoMarkup); 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; m.FoldView := TSynEditFoldedView(FoldedTextBuffer); if Highlighter <> nil then m.WordBreakChars := Highlighter.WordBreakChars + TSynWhiteChars; FUserWordsList.Add(m); TSynEditMarkupManager(MarkupMgr).AddMarkUp(m); end; 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.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; inherited SetHighlighter(Value); {$IFDEF WithSynMarkupIfDef} if Highlighter is TSynPasSyn then FMarkupIfDef.Highlighter := TSynPasSyn(Highlighter) else FMarkupIfDef.Highlighter := nil; {$ENDIF} 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; end; constructor TIDESynEditor.Create(AOwner: TComponent); begin inherited Create(AOwner); FUserWordsList := TList.Create; FTemplateEdit:=TSynPluginTemplateEdit.Create(Self); FSyncroEdit := TSynPluginSyncroEdit.Create(Self); FMarkupForGutterMark := TSynEditMarkupGutterMark.Create(Self, FWordBreaker); TSynEditMarkupManager(MarkupMgr).AddMarkUp(FMarkupForGutterMark); {$IFDEF WithSynMarkupIfDef} FMarkupIfDef := TSynEditMarkupIfDef.Create(Self); FMarkupIfDef.FoldView := TSynEditFoldedView(FoldedTextBuffer); TSynEditMarkupManager(MarkupMgr).AddMarkUp(FMarkupIfDef); {$ENDIF} FPaintArea := TSourceLazSynSurfaceManager.Create(Self, FPaintArea); GetCaretObj.AddChangeHandler({$IFDEF FPC}@{$ENDIF}SrcSynCaretChanged); FTopInfoDisplay := TSourceLazSynTopInfoView.Create; FTopInfoDisplay.NextView := ViewedTextBuffer.DisplayView; TSourceLazSynSurfaceManager(FPaintArea).TopLineCount := 0; // TSourceLazSynSurfaceManager(FPaintArea).ExtraManager.TextArea.BackgroundColor := clSilver; TSourceLazSynSurfaceManager(FPaintArea).ExtraManager.DisplayView := FTopInfoDisplay; FTopInfoMarkup := TSynSelectedColor.Create; FTopInfoMarkup.Clear; // 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 HighlightUserWordCount := 0; FreeAndNil(FUserWordsList); FExtraMarkupMgr.RemoveMarkUp(TSynEditMarkup(MarkupMgr)); FreeAndNil(FTopInfoDisplay); FreeAndNil(FExtraMarkupMgr); FreeAndNil(FTopInfoMarkup); inherited Destroy; end; function TIDESynEditor.TextIndexToViewPos(aTextIndex: Integer): Integer; begin Result := TextView.TextIndexToViewPos(aTextIndex - 1); 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} { TIDESynPasSyn } 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): 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; 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 TSynEditStringList(Sender).RemoveHanlders(self); TSynEditStringList(TextBuffer).AddGenericHandler(senrHighlightChanged, TMethod({$IFDEF FPC}@{$ENDIF}HighlightChanged)); TSynEditStringList(TextBuffer).AddGenericHandler(senrTextBufferChanged, TMethod({$IFDEF FPC}@{$ENDIF}BufferChanged)); //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; FInterfaceLine := -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; TSynEditStringList(TextBuffer).AddGenericHandler(senrHighlightChanged, TMethod({$IFDEF FPC}@{$ENDIF}HighlightChanged)); TSynEditStringList(TextBuffer).AddGenericHandler(senrTextBufferChanged, TMethod({$IFDEF FPC}@{$ENDIF}BufferChanged)); end; destructor TIDESynGutterLOvProviderPascal.Destroy; begin TSynEditStringList(TextBuffer).RemoveHanlders(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; 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; // else begin // AColor := TColor(FRGBBreakColor); // inc(APriority); // 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 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 begin Priority := 1; FoldedTextBuffer := TSynEditFoldedView(TIDESynEditor(Self.SynEdit).FoldedTextBuffer); end; with TIDESynGutterLOvProviderPascal.Create(Providers) do Priority := 0; end; with TSynGutterSeparator.Create(Parts) do begin Name := 'SynGutterSeparatorR3'; AutoSize := False; Width := 1; LineWidth := 0; end; 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: Integer; HasAnyMark: Boolean; procedure DrawDebugMark(Line: Integer); var itop : Longint; LineHeight: LongInt; begin if Line < 0 then Exit; if Assigned(FBookMarkOpt.BookmarkImages) and (DebugMarksImageIndex <= FBookMarkOpt.BookmarkImages.Count) and (DebugMarksImageIndex >= 0) then begin LineHeight := TSynEdit(SynEdit).LineHeight; iTop := 0; if LineHeight > FBookMarkOpt.BookmarkImages.Height then iTop := (LineHeight - FBookMarkOpt.BookmarkImages.Height) div 2; FBookMarkOpt.BookmarkImages.Draw (Canvas, AClip.Left + FBookMarkOpt.LeftMargin + aGutterOffs * ColumnWidth, AClip.Top + iTop, DebugMarksImageIndex, True); end end; begin CheckTextBuffer; aGutterOffs := 0; HasAnyMark := PaintMarks(aScreenLine, Canvas, AClip, aGutterOffs); TxtIdx := FoldView.TextIndex[aScreenLine]; if (TxtIdx < 0) or (TxtIdx >= TSynEdit(SynEdit).Lines.Count) then exit; if (not HasAnyMark) and (HasDebugMarks) and (TxtIdx < FDebugMarkInfo.Count) and (FDebugMarkInfo.SrcLineToMarkLine[TxtIdx] > 0) then DrawDebugMark(aScreenLine); 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; 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; begin CheckTextBuffer; if (aLinePos < 1) or (not HasDebugMarks) then exit(aLinePos); Result := aLinePos - 1; // 0 based 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 (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.PopClickedUnfoldAll(Sender: TObject); var i, y1, y2: Integer; begin if not TSynEdit(SynEdit).SelAvail then exit; 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); end; procedure TIDESynGutterCodeFolding.PopClickedUnfoldComment(Sender: TObject); var i, j, y1, y2: Integer; FldInf: TSynFoldNodeInfo; begin if not TSynEdit(SynEdit).SelAvail then exit; 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 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; end; procedure TIDESynGutterCodeFolding.PopClickedFoldComment(Sender: TObject); var i, j, y1, y2: Integer; FldInf: TSynFoldNodeInfo; begin if not TSynEdit(SynEdit).SelAvail then exit; 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 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; end; procedure TIDESynGutterCodeFolding.PopClickedHideComment(Sender: TObject); var i, j, y1, y2: Integer; FldInf: TSynFoldNodeInfo; begin if not TSynEdit(SynEdit).SelAvail then exit; 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 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; end; procedure TIDESynGutterCodeFolding.CreatePopUpMenuEntries(var APopUp: TPopupMenu; ALine: Integer); var i, j, y1, y2: Integer; HasFolds, HasHideableComments, HasFoldableComments, HasCollapsedComments: Boolean; ft: TPascalCodeFoldBlockType; Foldable, HideAble: TPascalCodeFoldBlockTypes; lc: TSynEditFoldLineCapabilities; 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 TSynEdit(SynEdit).SelAvail then exit; y1 := TSynEdit(SynEdit).BlockBegin.Y; y2 := TSynEdit(SynEdit).BlockEnd.Y; if TSynEdit(SynEdit).BlockEnd.X = 1 then dec(y2); HasFolds := FoldView.TextIndexToViewPos(y2) - FoldView.TextIndexToViewPos(y1) <> y2 - y1; //debugln(['*** HasFolds=', HasFolds, ' y1=',y1, ' y2=',y2, ' VP1=',FoldView.TextIndexToViewPos(y1), ' VP2=',FoldView.TextIndexToViewPos(y2)]); HasHideableComments := False; HasFoldableComments := False; HasCollapsedComments := False; if FoldView.HighLighter is TSynPasSyn then begin Foldable := []; HideAble := []; CheckFoldConf(cfbtAnsiComment); CheckFoldConf(cfbtBorCommand); CheckFoldConf(cfbtSlashComment); if (Foldable <> []) or (HideAble <> []) then begin i := y1-1; while i < y2 do begin lc := FoldView.FoldProvider.LineCapabilities[i]; j := FoldView.FoldProvider.FoldOpenCount(i); while j > 0 do begin dec(j); ft := TPascalCodeFoldBlockType({%H-}PtrUInt(FoldView.FoldProvider.FoldOpenInfo(i, j).FoldType)); if ((ft in Foldable) or (ft in HideAble)) and FoldView.IsFoldedAtTextIndex(i,j) then HasCollapsedComments := True 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; if HasFoldableComments and HasHideableComments and (HasCollapsedComments or not HasFolds) then break; inc(i); end; end; end; if (HasFolds or HasCollapsedComments or HasFoldableComments or HasHideableComments) and (APopUp.Items.Count > 0) then AddPopUpItem(cLineCaption); If HasFolds then AddPopUpItem(synfUnfoldAllInSelection).OnClick := {$IFDEF FPC}@{$ENDIF}PopClickedUnfoldAll; If HasCollapsedComments then AddPopUpItem(synfUnfoldCommentsInSelection).OnClick := {$IFDEF FPC}@{$ENDIF}PopClickedUnfoldComment; If HasFoldableComments then AddPopUpItem(synfFoldCommentsInSelection).OnClick := {$IFDEF FPC}@{$ENDIF}PopClickedFoldComment; If HasHideableComments then AddPopUpItem(synfHideCommentsInSelection).OnClick := {$IFDEF FPC}@{$ENDIF}PopClickedHideComment; end; end.