paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 08:39:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: messages: moved filters to options

Browse Source 
git-svn-id: trunk@45332 -
This commit is contained in:
mattias 2014-06-04 08:38:02 +00:00
parent 2e83e4997e
commit 340073d065
4 changed files with 597 additions and 578 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
ide/environmentopts.pp
View File

@ -354,6 +354,7 @@ type
fMsgViewColors: array[TMsgWndColor] of TColor;
FShowCompileDialog: Boolean; // show dialog during compile
FAutoCloseCompileDialog: Boolean; // auto close dialog after succesed compile
FMsgViewFilters: TLMsgViewFilters;
// compiler + debugger + lazarus files
FParseValues: array[TEnvOptParseType] of TParseString;
@ -736,6 +737,7 @@ type
property MsgViewFilenameStyle: TMsgWndFileNameStyle read FMsgViewFilenameStyle
write FMsgViewFilenameStyle;
property MsgViewColors[c: TMsgWndColor]: TColor read GetMsgViewColors write SetMsgViewColors;
property MsgViewFilters: TLMsgViewFilters read FMsgViewFilters write FMsgViewFilters;
// glyphs
property ShowButtonGlyphs: TApplicationShowGlyphs read FShowButtonGlyphs write FShowButtonGlyphs;
@ -981,6 +983,7 @@ begin
FMsgViewFilenameStyle:=mwfsShort;
for c:=low(TMsgWndColor) to high(TMsgWndColor) do
fMsgViewColors[c]:=MsgWndDefaultColors[c];
FMsgViewFilters:=TLMsgViewFilters.Create(nil);
// glyphs
FShowButtonGlyphs := sbgSystem;
@ -1055,6 +1058,7 @@ var
i: Integer;
begin
FreeAndNil(FBuildMatrixOptions);
FreeAndNil(FMsgViewFilters);
{$IFDEF EnableNewExtTools}
FreeAndNil(fExternalUserTools);
{$ELSE}
@ -1437,6 +1441,7 @@ begin
for mwc:=low(TMsgWndColor) to high(TMsgWndColor) do
fMsgViewColors[mwc]:=XMLConfig.GetValue(
Path+'MsgView/Colors/'+MsgWndColorNames[mwc],MsgWndDefaultColors[mwc]);
MsgViewFilters.LoadFromXMLConfig(XMLConfig,'MsgView/Filters/');
// glyphs
FShowButtonGlyphs := TApplicationShowGlyphs(XMLConfig.GetValue(Path+'ShowButtonGlyphs/Value',
@ -1816,6 +1821,7 @@ begin
for mwc:=low(TMsgWndColor) to high(TMsgWndColor) do
XMLConfig.SetDeleteValue(Path+'MsgView/Colors/'+MsgWndColorNames[mwc],
fMsgViewColors[mwc],MsgWndDefaultColors[mwc]);
MsgViewFilters.SaveToXMLConfig(XMLConfig,'MsgView/Filters/');
// glyphs
XMLConfig.SetDeleteValue(Path+'ShowButtonGlyphs/Value',

577
ide/etmessageframe.pas
View File

@ -39,75 +39,11 @@ uses
SynEditMarks, LResources, Forms, Buttons, ExtCtrls, Controls, LMessages,
LCLType, Graphics, LCLIntf, Themes, ImgList, GraphType, Menus, Clipbrd,
Dialogs, StdCtrls, IDEExternToolIntf, IDEImagesIntf, MenuIntf, PackageIntf,
IDECommands, SrcEditorIntf, LazarusIDEStrConsts, EnvironmentOpts,
HelpFPCMessages, etSrcEditMarks, etQuickFixes, ExtTools;
IDECommands, SrcEditorIntf, IDEDialogs, LazarusIDEStrConsts, EnvironmentOpts,
HelpFPCMessages, etSrcEditMarks, etQuickFixes, ExtTools, IDEOptionDefs;
const
CustomViewCaption = '------------------------------';
type
TLMsgViewFilter = class;
{ TLMVFilterMsgType - read/write by main, read by worker thread }
TLMVFilterMsgType = class
private
FFilter: TLMsgViewFilter;
FIndex: integer;
FMsgID: integer;
FSubTool: string;
procedure SetMsgID(AValue: integer);
procedure SetSubTool(AValue: string);
procedure Changed;
procedure InternalAssign(Src: TLMVFilterMsgType);
public
constructor Create(aFilter: TLMsgViewFilter);
function IsEqual(Src: TLMVFilterMsgType): boolean;
procedure Assign(Src: TLMVFilterMsgType);
property Filter: TLMsgViewFilter read FFilter;
property SubTool: string read FSubTool write SetSubTool;
property MsgID: integer read FMsgID write SetMsgID;
property Index: integer read FIndex;
end;
{ TLMsgViewFilter
Note: The View.Filter is protected by View.Enter/LeaveCriticalSection,
read/write by main thread, read by worker thread.
}
TLMsgViewFilter = class
private
FCaption: string;
FFilterNotesWithoutPos: boolean;
FMinUrgency: TMessageLineUrgency;
FOnChanged: TNotifyEvent;
fFilterMsgTypes: array of TLMVFilterMsgType; // sorted for SubTool, MsgID
function GetFilterMsgTypes(Index: integer): TLMVFilterMsgType; inline;
procedure SetCaption(AValue: string);
procedure SetFilterNotesWithoutPos(AValue: boolean);
procedure SetMinUrgency(AValue: TMessageLineUrgency);
procedure Changed;
procedure UpdateFilterMsgTypeIndex(Item: TLMVFilterMsgType);
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure SetToFitsAll;
function IsEqual(Src: TLMsgViewFilter): boolean; // does not check Caption
procedure Assign(Src: TLMsgViewFilter); // does not copy Caption
function LineFits(Line: TMessageLine): boolean; virtual;
property Caption: string read FCaption write SetCaption;
property MinUrgency: TMessageLineUrgency read FMinUrgency write SetMinUrgency;
property FilterNotesWithoutPos: boolean read FFilterNotesWithoutPos write SetFilterNotesWithoutPos;
function FilterMsgTypeCount: integer; inline;
property FilterMsgTypes[Index: integer]: TLMVFilterMsgType read GetFilterMsgTypes;
function AddFilterMsgType(SubTool: string; MsgID: integer): TLMVFilterMsgType;
procedure DeleteFilterMsgType(Index: integer);
procedure ClearFilterMsgTypes;
function IndexOfFilterMsgType(Line: TMessageLine): integer;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
procedure ConsistencyCheck;
end;
type
TMessagesCtrl = class;
@ -199,7 +135,6 @@ type
FAutoScrollToNewMessage: boolean;
FBackgroundColor: TColor;
FFilenameStyle: TMsgWndFileNameStyle;
FFilters: TFPList; // list of TLMsgViewFilter
FHeaderBackground: array[TLMVToolState] of TColor;
FIdleConnected: boolean;
FImageChangeLink: TChangeLink;
@ -222,7 +157,7 @@ type
FAutoHeaderBackground: TColor;
procedure CreateSourceMark(MsgLine: TMessageLine; aSynEdit: TSynEdit);
procedure CreateSourceMarks(View: TLMsgWndView; StartLineNumber: Integer);
function GetFilters(Index: integer): TLMsgViewFilter;
function GetActiveFilter: TLMsgViewFilter; inline;
function GetHeaderBackground(aToolState: TLMVToolState): TColor;
function GetSelectedLine: integer;
function GetUrgencyStyles(Urgency: TMessageLineUrgency
@ -230,9 +165,9 @@ type
function GetViews(Index: integer): TLMsgWndView;
procedure OnViewChanged(Sender: TObject); // (main thread)
procedure MsgUpdateTimerTimer(Sender: TObject);
procedure SetActiveFilter(AValue: TLMsgViewFilter); inline;
procedure SetBackgroundColor(AValue: TColor);
procedure SetFilenameStyle(AValue: TMsgWndFileNameStyle);
procedure SetActiveFilter(AValue: TLMsgViewFilter);
procedure SetHeaderBackground(aToolState: TLMVToolState; AValue: TColor);
procedure SetIdleConnected(AValue: boolean);
procedure SetImages(AValue: TCustomImageList);
@ -274,7 +209,6 @@ type
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer
); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
function GetDefaultFilterCaption: string;
procedure DoOnShowHint(HintInfo: PHintInfo); override;
procedure DoAllViewsStopped;
public
@ -284,8 +218,6 @@ type
procedure EndUpdate;
procedure EraseBackground({%H-}DC: HDC); override;
procedure ApplyEnvironmentOptions;
procedure LoadFromConfig(Cfg: TConfigStorage; FileVersion: integer);
procedure SaveToConfig(Cfg: TConfigStorage);
// views
function ViewCount: integer; inline;
@ -301,12 +233,8 @@ type
function GetLastViewWithContent: TLMsgWndView;
// filter
property ActiveFilter: TLMsgViewFilter read FActiveFilter write SetActiveFilter;
function FilterCount: integer; inline;
property Filters[Index: integer]: TLMsgViewFilter read GetFilters;
function GetFilter(aCaption: string; CreateIfNotExist: boolean): TLMsgViewFilter;
procedure DeleteFilter(Index: integer);
procedure ClearFilters;
property ActiveFilter: TLMsgViewFilter read GetActiveFilter write SetActiveFilter;
function Filters: TLMsgViewFilters; inline;
// select, search
function HasSelection: boolean;
@ -424,8 +352,6 @@ type
destructor Destroy; override;
procedure ApplyIDEOptions;
procedure LoadFromConfig(Cfg: TConfigStorage; FileVersion: integer);
procedure SaveToConfig(Cfg: TConfigStorage);
// Views
function ViewCount: integer;
@ -501,9 +427,6 @@ var
procedure RegisterStandardMessagesViewMenuItems;
function CompareFilterMsgType(FilterMsgType1, FilterMsgType2: Pointer): integer;
function CompareLineAndFilterMsgType(MessageLine1, FilterMsgType1: Pointer): integer;
implementation
procedure RegisterStandardMessagesViewMenuItems;
@ -573,340 +496,8 @@ begin
MsgShowIDMenuItem:=RegisterIDEMenuCommand(Root, 'ShowID', 'Show Message Type ID');
end;
function CompareFilterMsgType(FilterMsgType1, FilterMsgType2: Pointer): integer;
var
Item1: TLMVFilterMsgType absolute FilterMsgType1;
Item2: TLMVFilterMsgType absolute FilterMsgType2;
begin
Result:=SysUtils.CompareText(Item1.SubTool,Item2.SubTool);
if Result<>0 then exit;
if Item1.MsgID<Item2.MsgID then
exit(-1)
else if Item1.MsgID>Item2.MsgID then
exit(1);
Result:=0;
end;
function CompareLineAndFilterMsgType(MessageLine1, FilterMsgType1: Pointer
): integer;
var
Line: TMessageLine absolute MessageLine1;
Item: TLMVFilterMsgType absolute FilterMsgType1;
begin
Result:=SysUtils.CompareText(Line.SubTool,Item.SubTool);
if Result<>0 then exit;
if Line.MsgID<Item.MsgID then
exit(-1)
else if Line.MsgID>Item.MsgID then
exit(1);
Result:=0;
end;
{$R *.lfm}
{ TLMVFilterMsgType }
procedure TLMVFilterMsgType.SetMsgID(AValue: integer);
begin
if FMsgID=AValue then Exit;
FMsgID:=AValue;
Changed;
end;
procedure TLMVFilterMsgType.SetSubTool(AValue: string);
begin
if FSubTool=AValue then Exit;
FSubTool:=AValue;
Changed;
end;
procedure TLMVFilterMsgType.Changed;
begin
Filter.UpdateFilterMsgTypeIndex(Self);
Filter.Changed;
end;
procedure TLMVFilterMsgType.InternalAssign(Src: TLMVFilterMsgType);
begin
fSubTool:=Src.SubTool;
fMsgID:=Src.MsgID;
end;
constructor TLMVFilterMsgType.Create(aFilter: TLMsgViewFilter);
begin
FFilter:=aFilter;
end;
function TLMVFilterMsgType.IsEqual(Src: TLMVFilterMsgType): boolean;
begin
if Self=Src then exit(true);
Result:=(SubTool=Src.SubTool)
and (MsgID=Src.MsgID);
end;
procedure TLMVFilterMsgType.Assign(Src: TLMVFilterMsgType);
begin
if IsEqual(Src) then exit;
InternalAssign(Src);
Changed;
end;
{ TLMsgViewFilter }
// inline
function TLMsgViewFilter.FilterMsgTypeCount: integer;
begin
Result:=length(fFilterMsgTypes);
end;
// inline
function TLMsgViewFilter.GetFilterMsgTypes(Index: integer): TLMVFilterMsgType;
begin
Result:=fFilterMsgTypes[Index];
end;
procedure TLMsgViewFilter.SetCaption(AValue: string);
begin
AValue:=UTF8Trim(AValue,[]);
if FCaption=AValue then Exit;
FCaption:=AValue;
end;
procedure TLMsgViewFilter.SetMinUrgency(AValue: TMessageLineUrgency);
begin
if FMinUrgency=AValue then Exit;
FMinUrgency:=AValue;
Changed;
end;
procedure TLMsgViewFilter.SetFilterNotesWithoutPos(AValue: boolean);
begin
if FFilterNotesWithoutPos=AValue then Exit;
FFilterNotesWithoutPos:=AValue;
Changed;
end;
procedure TLMsgViewFilter.Changed;
begin
if Assigned(OnChanged) then
OnChanged(Self);
end;
procedure TLMsgViewFilter.UpdateFilterMsgTypeIndex(Item: TLMVFilterMsgType);
var
OldIndex: Integer;
l: Integer;
r: Integer;
m: Integer;
cmp: Integer;
StartIndex: Integer;
EndIndex: Integer;
NewIndex: Integer;
begin
if FilterMsgTypeCount=1 then exit;
OldIndex:=Item.FIndex;
if (OldIndex>0) and (CompareFilterMsgType(Item,fFilterMsgTypes[OldIndex-1])<0)
then begin
StartIndex:=0;
EndIndex:=OldIndex-1;
end else if (OldIndex<FilterMsgTypeCount-1)
and (CompareFilterMsgType(Item,fFilterMsgTypes[OldIndex+1])>0) then begin
StartIndex:=OldIndex+1;
EndIndex:=FilterMsgTypeCount-1;
end else
exit;
l:=StartIndex;
r:=EndIndex;
m:=0;
cmp:=0;
while l<=r do begin
m:=(l+r) div 2;
cmp:=CompareFilterMsgType(Item,fFilterMsgTypes[m]);
if cmp<0 then
r:=m-1
else if cmp>0 then
l:=m+1
else
break;
end;
if cmp<=0 then
NewIndex:=m
else
NewIndex:=m+1;
if OldIndex<NewIndex then begin
system.Move(fFilterMsgTypes[OldIndex+1],fFilterMsgTypes[OldIndex],
SizeOf(TLMVFilterMsgType)*(NewIndex-OldIndex));
end else if OldIndex>NewIndex then begin
system.Move(fFilterMsgTypes[NewIndex],fFilterMsgTypes[NewIndex+1],
SizeOf(TLMVFilterMsgType)*(OldIndex-NewIndex));
end else
exit;
fFilterMsgTypes[NewIndex]:=Item;
{$IFDEF CheckExtTools}
ConsistencyCheck;
{$ENDIF}
end;
constructor TLMsgViewFilter.Create;
begin
FMinUrgency:=mluHint;
FFilterNotesWithoutPos:=true;
end;
destructor TLMsgViewFilter.Destroy;
begin
ClearFilterMsgTypes;
inherited Destroy;
end;
procedure TLMsgViewFilter.Clear;
begin
MinUrgency:=mluHint;
FilterNotesWithoutPos:=true;
ClearFilterMsgTypes;
end;
procedure TLMsgViewFilter.SetToFitsAll;
begin
MinUrgency:=mluNone;
FilterNotesWithoutPos:=false;
ClearFilterMsgTypes;
end;
function TLMsgViewFilter.IsEqual(Src: TLMsgViewFilter): boolean;
var
i: Integer;
begin
Result:=false;
if Self=Src then exit(true);
if (MinUrgency<>Src.MinUrgency)
or (FilterNotesWithoutPos<>Src.FilterNotesWithoutPos)
or (FilterMsgTypeCount<>Src.FilterMsgTypeCount)
then exit;
for i:=0 to FilterMsgTypeCount-1 do
if not FilterMsgTypes[i].IsEqual(Src.FilterMsgTypes[i]) then exit;
Result:=true;
end;
procedure TLMsgViewFilter.Assign(Src: TLMsgViewFilter);
var
NewCnt: Integer;
OldCnt: Integer;
i: Integer;
begin
if IsEqual(Src) then exit;
fMinUrgency:=Src.MinUrgency;
FFilterNotesWithoutPos:=Src.FilterNotesWithoutPos;
// filter msg type
NewCnt:=Src.FilterMsgTypeCount;
OldCnt:=FilterMsgTypeCount;
for i:=NewCnt to OldCnt-1 do
FreeAndNil(fFilterMsgTypes[i]);
SetLength(fFilterMsgTypes,NewCnt);
for i:=0 to NewCnt-1 do begin
if fFilterMsgTypes[i]=nil then
fFilterMsgTypes[i]:=TLMVFilterMsgType.Create(Self);
fFilterMsgTypes[i].InternalAssign(Src.FilterMsgTypes[i]);
end;
Changed;
end;
function TLMsgViewFilter.LineFits(Line: TMessageLine): boolean;
begin
Result:=false;
if ord(Line.Urgency)<ord(MinUrgency) then exit;
if [mlfHiddenByIDEDirective,mlfFixed]*Line.Flags<>[] then exit;
if FilterNotesWithoutPos and (Line.Urgency<=mluNote)
and ((Line.Filename='') or (Line.Line<1)) then exit;
if IndexOfFilterMsgType(Line)>=0 then exit;
Result:=true;
end;
function TLMsgViewFilter.AddFilterMsgType(SubTool: string;
MsgID: integer): TLMVFilterMsgType;
var
i: Integer;
begin
i:=length(fFilterMsgTypes);
SetLength(fFilterMsgTypes,i+1);
Result:=TLMVFilterMsgType.Create(Self);
fFilterMsgTypes[i]:=Result;
Result.FSubTool:=SubTool;
Result.FMsgID:=MsgID;
UpdateFilterMsgTypeIndex(Result);
Changed;
end;
procedure TLMsgViewFilter.DeleteFilterMsgType(Index: integer);
begin
if (Index<0) or (Index>=FilterMsgTypeCount) then
raise Exception.Create('');
fFilterMsgTypes[Index].Free;
if Index<FilterMsgTypeCount-1 then
system.Move(fFilterMsgTypes[Index+1],fFilterMsgTypes[Index],
SizeOf(TLMVFilterMsgType)*(FilterMsgTypeCount-Index-1));
SetLength(fFilterMsgTypes,length(fFilterMsgTypes)-1);
Changed;
end;
procedure TLMsgViewFilter.ClearFilterMsgTypes;
var
i: Integer;
begin
if FilterMsgTypeCount=0 then exit;
for i:=0 to FilterMsgTypeCount-1 do
fFilterMsgTypes[i].Free;
SetLength(fFilterMsgTypes,0);
Changed;
end;
function TLMsgViewFilter.IndexOfFilterMsgType(Line: TMessageLine): integer;
var
l: Integer;
r: Integer;
m: Integer;
cmp: Integer;
begin
l:=0;
r:=FilterMsgTypeCount-1;
while l<=r do begin
m:=(l+r) div 2;
cmp:=CompareLineAndFilterMsgType(Line,fFilterMsgTypes[m]);
if cmp<0 then
r:=m-1
else if cmp>0 then
l:=m+1
else
exit(m);
end;
Result:=-1;
end;
procedure TLMsgViewFilter.ConsistencyCheck;
procedure E(Msg: string);
begin
raise Exception.Create(Msg);
end;
var
i: Integer;
begin
for i:=0 to FilterMsgTypeCount-2 do begin
if CompareFilterMsgType(fFilterMsgTypes[i],fFilterMsgTypes[i+1])>0 then
E(IntToStr(i));
end;
end;
{ TLMsgWndView }
procedure TLMsgWndView.OnMarksFixed(ListOfTMessageLine: TFPList);
@ -1338,9 +929,21 @@ begin
end;
// inline
function TMessagesCtrl.FilterCount: integer;
function TMessagesCtrl.Filters: TLMsgViewFilters;
begin
Result:=FFilters.Count;
Result:=EnvironmentOptions.MsgViewFilters;
end;
// inline
function TMessagesCtrl.GetActiveFilter: TLMsgViewFilter;
begin
Result:=Filters.ActiveFilter;
end;
// inline
procedure TMessagesCtrl.SetActiveFilter(AValue: TLMsgViewFilter);
begin
Filters.ActiveFilter:=AValue;
end;
function TMessagesCtrl.GetViews(Index: integer): TLMsgWndView;
@ -1444,20 +1047,6 @@ begin
Invalidate;
end;
procedure TMessagesCtrl.SetActiveFilter(AValue: TLMsgViewFilter);
var
i: Integer;
begin
if (AValue=nil) or (ActiveFilter=AValue) then exit;
i:=FFilters.IndexOf(AValue);
if i<0 then begin
if FActiveFilter.IsEqual(AValue) then exit;
FActiveFilter.Assign(AValue);
end else
FActiveFilter:=AValue;
IdleConnected:=true;
end;
procedure TMessagesCtrl.SetHeaderBackground(aToolState: TLMVToolState;
AValue: TColor);
begin
@ -1724,19 +1313,6 @@ begin
CreateSourceMark(View.Lines[i],nil);
end;
function TMessagesCtrl.GetFilters(Index: integer): TLMsgViewFilter;
procedure RaiseOutOfBounds;
begin
raise Exception.Create('TMessagesCtrl.GetFilters '+IntToStr(Index)+' out of bounds '+IntToStr(FilterCount));
end;
begin
if (Index<0) or (Index>=FilterCount) then
RaiseOutOfBounds;
Result:=TLMsgViewFilter(fFilters[Index]);
end;
function TMessagesCtrl.GetHeaderBackground(aToolState: TLMVToolState): TColor;
begin
Result:=FHeaderBackground[aToolState];
@ -2056,11 +1632,6 @@ begin
end;
end;
function TMessagesCtrl.GetDefaultFilterCaption: string;
begin
Result:='Default';
end;
procedure TMessagesCtrl.DoOnShowHint(HintInfo: PHintInfo);
var
View: TLMsgWndView;
@ -2609,53 +2180,6 @@ begin
Result:=nil;
end;
function TMessagesCtrl.GetFilter(aCaption: string; CreateIfNotExist: boolean
): TLMsgViewFilter;
var
i: Integer;
begin
for i:=0 to FilterCount-1 do begin
Result:=Filters[i];
if SysUtils.CompareText(Result.Caption,aCaption)=0 then exit;
end;
if not CreateIfNotExist then
exit(nil);
Result:=TLMsgViewFilter.Create;
Result.Caption:=aCaption;
Result.OnChanged:=@OnFilterChanged;
FFilters.Add(Result);
end;
procedure TMessagesCtrl.DeleteFilter(Index: integer);
var
CurFilter: TLMsgViewFilter;
begin
CurFilter:=Filters[Index];
if (CurFilter=ActiveFilter) then begin
if FilterCount=1 then begin
CurFilter.Clear;
exit;
end;
if Index>0 then
ActiveFilter:=Filters[0]
else
ActiveFilter:=Filters[1];
end;
FFilters.Delete(Index);
CurFilter.Free;
end;
procedure TMessagesCtrl.ClearFilters;
var
i: Integer;
begin
for i:=FilterCount-1 downto 0 do begin
if Filters[i]=ActiveFilter then continue;
DeleteFilter(i);
end;
ActiveFilter.Clear;
end;
procedure TMessagesCtrl.Select(View: TLMsgWndView; LineNumber: integer;
DoScroll, FullyVisible: boolean);
begin
@ -2721,11 +2245,8 @@ begin
inherited Create(AOwner);
ControlStyle:=ControlStyle-[csCaptureMouse]+[csReflector];
FOptions:=MCDefaultOptions;
FFilters:=TFPList.Create;
FActiveFilter:=TLMsgViewFilter.Create;
FActiveFilter.Caption:=GetDefaultFilterCaption;
FActiveFilter.OnChanged:=@OnFilterChanged;
FFilters.Add(FActiveFilter);
Filters.OnChanged:=@OnFilterChanged;
FActiveFilter:=Filters[0];
FViews:=TFPList.Create;
FUpdateTimer:=TTimer.Create(Self);
FUpdateTimer.Name:='MsgUpdateTimer';
@ -2752,17 +2273,11 @@ end;
destructor TMessagesCtrl.Destroy;
var
u: TMessageLineUrgency;
i: Integer;
begin
IdleConnected:=false;
Images:=nil;
ClearViews(false);
FActiveFilter:=nil;
for i:=0 to FFilters.Count-1 do
TObject(FFilters[i]).Free;
FreeAndNil(FFilters);
FreeAndNil(FViews);
FreeAndNil(FUpdateTimer);
FreeAndNil(FImageChangeLink);
@ -2810,17 +2325,6 @@ begin
FilenameStyle:=EnvironmentOptions.MsgViewFilenameStyle;
end;
procedure TMessagesCtrl.LoadFromConfig(Cfg: TConfigStorage; FileVersion: integer
);
begin
end;
procedure TMessagesCtrl.SaveToConfig(Cfg: TConfigStorage);
begin
end;
function TMessagesCtrl.IndexOfView(View: TLMsgWndView): integer;
begin
Result:=FViews.IndexOf(View);
@ -3013,7 +2517,7 @@ procedure TMessagesFrame.MsgCtrlPopupMenuPopup(Sender: TObject);
Item: TIDEMenuCommand;
Cnt: Integer;
begin
Cnt:=MessagesCtrl.FilterCount;
Cnt:=MessagesCtrl.Filters.Count;
for i:=0 to Cnt-1 do begin
Filter:=MessagesCtrl.Filters[i];
if i>=MsgSelectFilterMenuSection.Count then begin
@ -3185,7 +2689,7 @@ var
Item: TIDEMenuCommand;
begin
Item:=Sender as TIDEMenuCommand;
Filter:=MessagesCtrl.GetFilter(Item.Caption,false);
Filter:=MessagesCtrl.Filters.GetFilter(Item.Caption,false);
if Filter=nil then exit;
MessagesCtrl.ActiveFilter:=Filter;
end;
@ -3481,19 +2985,20 @@ var
aCaption: String;
i: Integer;
NewFilter: TLMsgViewFilter;
Filters: TLMsgViewFilters;
begin
aCaption:='Filter';
i:=1;
while MessagesCtrl.GetFilter(aCaption+IntToStr(i),false)<>nil do
Filters:=MessagesCtrl.Filters;
while Filters.GetFilter(aCaption+IntToStr(i),false)<>nil do
inc(i);
aCaption:=UTF8Trim(InputBox('Create Filter','Name:',aCaption),[]);
if aCaption='' then exit;
if MessagesCtrl.GetFilter(aCaption,false)<>nil then begin
// ToDo: use IDEMessageDlg
MessageDlg('Filter already exists','A filter with the name "'+aCaption+'" already exists.',mtError,[mbCancel],'');
if Filters.GetFilter(aCaption,false)<>nil then begin
IDEMessageDialog('Filter already exists','A filter with the name "'+aCaption+'" already exists.',mtError,[mbCancel],'');
exit;
end;
NewFilter:=MessagesCtrl.GetFilter(aCaption,true);
NewFilter:=Filters.GetFilter(aCaption,true);
NewFilter.Assign(MessagesCtrl.ActiveFilter);
MessagesCtrl.ActiveFilter:=NewFilter;
end;
@ -3522,10 +3027,10 @@ var
begin
Dlg:=TSaveDialog.Create(nil);
try
// ToDo: initfiledialog
Dlg.Title:='Save messages';
Dlg.FileName:='messages.txt';
Dlg.Options:=Dlg.Options+[ofPathMustExist,ofCreatePrompt];
InitIDEFileDialog(Dlg);
if not Dlg.Execute then exit;
Filename:=TrimAndExpandFilename(Dlg.FileName);
if DirPathExistsCached(Filename) then exit;
@ -3542,12 +3047,12 @@ begin
end;
except
on E: Exception do begin
// ToDo: idemessagedlg
MessageDlg('Write Error','Unable to write file "'+Filename+'".',mtError,[mbCancel],0);
IDEMessageDialog('Write Error','Unable to write file "'+Filename+'".',mtError,[mbCancel]);
end;
end;
finally
StoreIDEFileDialog(Dlg);
Dlg.Free;
end;
end;
@ -3565,9 +3070,8 @@ begin
Msg:=IntToStr(length(s) div 1000)+' KB'
else
Msg:=IntToStr(length(s) div 1000)+' MB';
// ToDo: replace with IDEMessageDlg
if MessageDlg('Warning','This will put a lot of text ('+Msg+') on the clipboard.'#13'Proceed?',
mtConfirmation,[mbYes,mbNo],0)<>mrYes then exit;
if IDEMessageDialog('Warning','This will put a lot of text ('+Msg+') on the clipboard.'#13'Proceed?',
mtConfirmation,[mbYes,mbNo])<>mrYes then exit;
end;
Clipboard.AsText:=s;
end;
@ -3694,17 +3198,6 @@ begin
MessagesCtrl.ApplyEnvironmentOptions;
end;
procedure TMessagesFrame.LoadFromConfig(Cfg: TConfigStorage;
FileVersion: integer);
begin
MessagesCtrl.LoadFromConfig(Cfg,FileVersion);
end;
procedure TMessagesFrame.SaveToConfig(Cfg: TConfigStorage);
begin
MessagesCtrl.SaveToConfig(Cfg);
end;
function TMessagesFrame.ViewCount: integer;
begin
Result:=MessagesCtrl.ViewCount;

34
ide/etmessageswnd.pas
View File

@ -37,9 +37,6 @@ uses
Forms, Controls, Graphics, Dialogs, LCLProc, etMessageFrame, etSrcEditMarks,
etQuickFixes;
const
MsgWndOptionsFileVersion = 1;
MsgWndOptionsFilename = 'messagesoptions.xml';
type
{ TMessagesView }
@ -83,8 +80,6 @@ type
procedure SourceEditorPopup(MarkLine: TSynEditMarkLine);
// options
procedure LoadOptions;
procedure SaveOptions;
procedure ApplyIDEOptions;
property DblClickJumps: boolean read GetDblClickJumps write SetDblClickJumps;
property HideMessagesIcons: boolean read GetHideMessagesIcons write SetHideMessagesIcons;
@ -107,8 +102,6 @@ begin
MessagesFrame1.MessagesCtrl.OnOpenMessage:=@OnOpenMessage;
ActiveControl:=MessagesFrame1.MessagesCtrl;
LoadOptions;
end;
procedure TMessagesView.FormDestroy(Sender: TObject);
@ -169,33 +162,6 @@ begin
MessagesFrame1.SourceEditorPopup(MarkLine);
end;
procedure TMessagesView.LoadOptions;
var
Cfg: TConfigStorage;
FileVersion: Integer;
begin
Cfg:=GetIDEConfigStorage(MsgWndOptionsFilename,true);
try
FileVersion:=Cfg.GetValue('Version',0);
MessagesFrame1.LoadFromConfig(Cfg,FileVersion);
finally
Cfg.Free;
end;
end;
procedure TMessagesView.SaveOptions;
var
Cfg: TConfigStorage;
begin
Cfg:=GetIDEConfigStorage(MsgWndOptionsFilename,false);
try
MessagesFrame1.SaveToConfig(Cfg);
Cfg.SetValue('Version',MsgWndOptionsFileVersion);
finally
Cfg.Free;
end;
end;
procedure TMessagesView.Clear;
begin
MessagesFrame1.ClearViews(true);

558
ide/ideoptiondefs.pas
View File

@ -33,8 +33,8 @@ interface
uses
Classes, SysUtils, types, LCLProc, FileUtil, Laz2_XMLCfg,
Forms, Controls, Buttons, BaseIDEIntf, LazConfigStorage,
IDEWindowIntf, LazConf;
Forms, Controls, Buttons, BaseIDEIntf, LazConfigStorage, LazUTF8,
IDEWindowIntf, IDEExternToolIntf, LazConf;
type
{ TXMLOptionsStorage }
@ -127,6 +127,95 @@ const
'JumpHistory',
'ComponentList'
);
type
TLMsgViewFilter = class;
{ TLMVFilterMsgType - read/write by main, read by worker thread }
TLMVFilterMsgType = class
private
FFilter: TLMsgViewFilter;
FIndex: integer;
FMsgID: integer;
FSubTool: string;
procedure SetMsgID(AValue: integer);
procedure SetSubTool(AValue: string);
procedure Changed;
procedure InternalAssign(Src: TLMVFilterMsgType);
public
constructor Create(aFilter: TLMsgViewFilter);
function IsEqual(Src: TLMVFilterMsgType): boolean;
procedure Assign(Src: TLMVFilterMsgType);
property Filter: TLMsgViewFilter read FFilter;
property SubTool: string read FSubTool write SetSubTool;
property MsgID: integer read FMsgID write SetMsgID;
property Index: integer read FIndex;
end;
{ TLMsgViewFilter
Note: The View.Filter is protected by View.Enter/LeaveCriticalSection,
read/write by main thread, read by worker thread.
}
TLMsgViewFilter = class
private
FCaption: string;
FFilterNotesWithoutPos: boolean;
FMinUrgency: TMessageLineUrgency;
FOnChanged: TNotifyEvent;
fFilterMsgTypes: array of TLMVFilterMsgType; // sorted for SubTool, MsgID
function GetFilterMsgTypes(Index: integer): TLMVFilterMsgType; inline;
procedure SetCaption(AValue: string);
procedure SetFilterNotesWithoutPos(AValue: boolean);
procedure SetMinUrgency(AValue: TMessageLineUrgency);
procedure Changed;
procedure UpdateFilterMsgTypeIndex(Item: TLMVFilterMsgType);
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure SetToFitsAll;
function IsEqual(Src: TLMsgViewFilter): boolean; // does not check Caption
procedure Assign(Src: TLMsgViewFilter); // does not copy Caption
function LineFits(Line: TMessageLine): boolean; virtual;
property Caption: string read FCaption write SetCaption;
property MinUrgency: TMessageLineUrgency read FMinUrgency write SetMinUrgency;
property FilterNotesWithoutPos: boolean read FFilterNotesWithoutPos write SetFilterNotesWithoutPos;
function FilterMsgTypeCount: integer; inline;
property FilterMsgTypes[Index: integer]: TLMVFilterMsgType read GetFilterMsgTypes;
function AddFilterMsgType(SubTool: string; MsgID: integer): TLMVFilterMsgType;
procedure DeleteFilterMsgType(Index: integer);
procedure ClearFilterMsgTypes;
function IndexOfFilterMsgType(Line: TMessageLine): integer;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
procedure ConsistencyCheck;
end;
{ TLMsgViewFilters }
TLMsgViewFilters = class(TComponent)
private
FActiveFilter: TLMsgViewFilter;
fFilters: TFPList; // list of TLMsgViewFilter
FOnChanged: TNotifyEvent;
function GetFilters(Index: integer): TLMsgViewFilter;
procedure OnFilterChanged(Sender: TObject);
procedure SetActiveFilter(AValue: TLMsgViewFilter);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Clear;
function Count: integer; inline;
property Filters[Index: integer]: TLMsgViewFilter read GetFilters; default;
function GetFilter(aCaption: string; CreateIfNotExist: boolean): TLMsgViewFilter;
procedure Delete(Index: integer);
function IndexOf(Filter: TLMsgViewFilter): integer; inline;
function Add(Filter: TLMsgViewFilter): integer;
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
property ActiveFilter: TLMsgViewFilter read FActiveFilter write SetActiveFilter;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
end;
function CreateNiceWindowPosition(Width, Height: integer): TRect;
function NonModalIDEFormIDToEnum(const FormID: string): TNonModalIDEWindow;
@ -134,6 +223,10 @@ function NonModalIDEFormIDToEnum(const FormID: string): TNonModalIDEWindow;
function GetLazIDEConfigStorage(const Filename: string; LoadFromDisk: Boolean
): TConfigStorage; // load errors: raises exceptions
function CompareFilterMsgType(FilterMsgType1, FilterMsgType2: Pointer): integer;
function CompareLineAndFilterMsgType(MessageLine1, FilterMsgType1: Pointer): integer;
implementation
@ -226,6 +319,164 @@ begin
Result:=TXMLOptionsStorage.Create(ConfigFilename,LoadFromDisk);
end;
function CompareFilterMsgType(FilterMsgType1, FilterMsgType2: Pointer): integer;
var
Item1: TLMVFilterMsgType absolute FilterMsgType1;
Item2: TLMVFilterMsgType absolute FilterMsgType2;
begin
Result:=SysUtils.CompareText(Item1.SubTool,Item2.SubTool);
if Result<>0 then exit;
if Item1.MsgID<Item2.MsgID then
exit(-1)
else if Item1.MsgID>Item2.MsgID then
exit(1);
Result:=0;
end;
function CompareLineAndFilterMsgType(MessageLine1, FilterMsgType1: Pointer
): integer;
var
Line: TMessageLine absolute MessageLine1;
Item: TLMVFilterMsgType absolute FilterMsgType1;
begin
Result:=SysUtils.CompareText(Line.SubTool,Item.SubTool);
if Result<>0 then exit;
if Line.MsgID<Item.MsgID then
exit(-1)
else if Line.MsgID>Item.MsgID then
exit(1);
Result:=0;
end;
{ TLMsgViewFilters }
// inline
function TLMsgViewFilters.Count: integer;
begin
Result:=FFilters.Count;
end;
// inline
function TLMsgViewFilters.IndexOf(Filter: TLMsgViewFilter): integer;
begin
Result:=fFilters.IndexOf(Filter);
end;
function TLMsgViewFilters.GetFilters(Index: integer): TLMsgViewFilter;
procedure RaiseOutOfBounds;
begin
raise Exception.Create('TLMsgViewFilters.GetFilters '+IntToStr(Index)+' out of bounds '+IntToStr(Count));
end;
begin
if (Index<0) or (Index>=Count) then
RaiseOutOfBounds;
Result:=TLMsgViewFilter(fFilters[Index]);
end;
procedure TLMsgViewFilters.OnFilterChanged(Sender: TObject);
begin
if csDestroying in ComponentState then exit;
if Assigned(OnChanged) then
OnChanged(Self);
end;
procedure TLMsgViewFilters.SetActiveFilter(AValue: TLMsgViewFilter);
var
i: Integer;
begin
if FActiveFilter=AValue then Exit;
i:=IndexOf(AValue);
if i<0 then begin
if FActiveFilter.IsEqual(AValue) then exit;
FActiveFilter.Assign(AValue);
end else
FActiveFilter:=AValue;
OnFilterChanged(AValue);
end;
constructor TLMsgViewFilters.Create(AOwner: TComponent);
begin
inherited;
fFilters:=TFPList.Create;
FActiveFilter:=TLMsgViewFilter.Create;
FActiveFilter.Caption:='Default';
FActiveFilter.OnChanged:=@OnFilterChanged;
fFilters.Add(FActiveFilter);
end;
destructor TLMsgViewFilters.Destroy;
begin
Clear;
ActiveFilter.Free;
FreeAndNil(fFilters);
inherited Destroy;
end;
procedure TLMsgViewFilters.Clear;
var
i: Integer;
begin
ActiveFilter:=Filters[0];
for i:=Count-1 downto 1 do
Delete(i);
Filters[0].Clear;
end;
function TLMsgViewFilters.GetFilter(aCaption: string; CreateIfNotExist: boolean
): TLMsgViewFilter;
var
i: Integer;
begin
for i:=0 to Count-1 do begin
Result:=Filters[i];
if SysUtils.CompareText(Result.Caption,aCaption)=0 then exit;
end;
if not CreateIfNotExist then
exit(nil);
Result:=TLMsgViewFilter.Create;
Result.Caption:=aCaption;
Result.OnChanged:=@OnFilterChanged;
Add(Result);
end;
procedure TLMsgViewFilters.Delete(Index: integer);
var
Filter: TLMsgViewFilter;
begin
if (Index=0) and (Count=1) then begin
ActiveFilter.Clear;
end else begin
Filter:=Filters[Index];
Filter.OnChanged:=nil;
fFilters.Delete(Index);
if ActiveFilter=Filter then
FActiveFilter:=Filters[0];
Filter.Free;
OnFilterChanged(Self);
end;
end;
function TLMsgViewFilters.Add(Filter: TLMsgViewFilter): integer;
begin
Filter.OnChanged:=@OnFilterChanged;
Result:=fFilters.Add(Filter);
OnFilterChanged(Self);
end;
procedure TLMsgViewFilters.LoadFromXMLConfig(XMLConfig: TXMLConfig;
const Path: string);
begin
end;
procedure TLMsgViewFilters.SaveToXMLConfig(XMLConfig: TXMLConfig;
const Path: string);
begin
end;
{ TXMLOptionsStorage }
function TXMLOptionsStorage.GetFullPathValue(const APath, ADefault: String): String;
@ -335,6 +586,309 @@ begin
Result:=FXMLConfig.Filename;
end;
{ TLMVFilterMsgType }
procedure TLMVFilterMsgType.SetMsgID(AValue: integer);
begin
if FMsgID=AValue then Exit;
FMsgID:=AValue;
Changed;
end;
procedure TLMVFilterMsgType.SetSubTool(AValue: string);
begin
if FSubTool=AValue then Exit;
FSubTool:=AValue;
Changed;
end;
procedure TLMVFilterMsgType.Changed;
begin
Filter.UpdateFilterMsgTypeIndex(Self);
Filter.Changed;
end;
procedure TLMVFilterMsgType.InternalAssign(Src: TLMVFilterMsgType);
begin
fSubTool:=Src.SubTool;
fMsgID:=Src.MsgID;
end;
constructor TLMVFilterMsgType.Create(aFilter: TLMsgViewFilter);
begin
FFilter:=aFilter;
end;
function TLMVFilterMsgType.IsEqual(Src: TLMVFilterMsgType): boolean;
begin
if Self=Src then exit(true);
Result:=(SubTool=Src.SubTool)
and (MsgID=Src.MsgID);
end;
procedure TLMVFilterMsgType.Assign(Src: TLMVFilterMsgType);
begin
if IsEqual(Src) then exit;
InternalAssign(Src);
Changed;
end;
{ TLMsgViewFilter }
// inline
function TLMsgViewFilter.FilterMsgTypeCount: integer;
begin
Result:=length(fFilterMsgTypes);
end;
// inline
function TLMsgViewFilter.GetFilterMsgTypes(Index: integer): TLMVFilterMsgType;
begin
Result:=fFilterMsgTypes[Index];
end;
procedure TLMsgViewFilter.SetCaption(AValue: string);
begin
AValue:=UTF8Trim(AValue,[]);
if FCaption=AValue then Exit;
FCaption:=AValue;
end;
procedure TLMsgViewFilter.SetMinUrgency(AValue: TMessageLineUrgency);
begin
if FMinUrgency=AValue then Exit;
FMinUrgency:=AValue;
Changed;
end;
procedure TLMsgViewFilter.SetFilterNotesWithoutPos(AValue: boolean);
begin
if FFilterNotesWithoutPos=AValue then Exit;
FFilterNotesWithoutPos:=AValue;
Changed;
end;
procedure TLMsgViewFilter.Changed;
begin
if Assigned(OnChanged) then
OnChanged(Self);
end;
procedure TLMsgViewFilter.UpdateFilterMsgTypeIndex(Item: TLMVFilterMsgType);
var
OldIndex: Integer;
l: Integer;
r: Integer;
m: Integer;
cmp: Integer;
StartIndex: Integer;
EndIndex: Integer;
NewIndex: Integer;
begin
if FilterMsgTypeCount=1 then exit;
OldIndex:=Item.FIndex;
if (OldIndex>0) and (CompareFilterMsgType(Item,fFilterMsgTypes[OldIndex-1])<0)
then begin
StartIndex:=0;
EndIndex:=OldIndex-1;
end else if (OldIndex<FilterMsgTypeCount-1)
and (CompareFilterMsgType(Item,fFilterMsgTypes[OldIndex+1])>0) then begin
StartIndex:=OldIndex+1;
EndIndex:=FilterMsgTypeCount-1;
end else
exit;
l:=StartIndex;
r:=EndIndex;
m:=0;
cmp:=0;
while l<=r do begin
m:=(l+r) div 2;
cmp:=CompareFilterMsgType(Item,fFilterMsgTypes[m]);
if cmp<0 then
r:=m-1
else if cmp>0 then
l:=m+1
else
break;
end;
if cmp<=0 then
NewIndex:=m
else
NewIndex:=m+1;
if OldIndex<NewIndex then begin
system.Move(fFilterMsgTypes[OldIndex+1],fFilterMsgTypes[OldIndex],
SizeOf(TLMVFilterMsgType)*(NewIndex-OldIndex));
end else if OldIndex>NewIndex then begin
system.Move(fFilterMsgTypes[NewIndex],fFilterMsgTypes[NewIndex+1],
SizeOf(TLMVFilterMsgType)*(OldIndex-NewIndex));
end else
exit;
fFilterMsgTypes[NewIndex]:=Item;
{$IFDEF CheckExtTools}
ConsistencyCheck;
{$ENDIF}
end;
constructor TLMsgViewFilter.Create;
begin
FMinUrgency:=mluHint;
FFilterNotesWithoutPos:=true;
end;
destructor TLMsgViewFilter.Destroy;
begin
ClearFilterMsgTypes;
inherited Destroy;
end;
procedure TLMsgViewFilter.Clear;
begin
MinUrgency:=mluHint;
FilterNotesWithoutPos:=true;
ClearFilterMsgTypes;
end;
procedure TLMsgViewFilter.SetToFitsAll;
begin
MinUrgency:=mluNone;
FilterNotesWithoutPos:=false;
ClearFilterMsgTypes;
end;
function TLMsgViewFilter.IsEqual(Src: TLMsgViewFilter): boolean;
var
i: Integer;
begin
Result:=false;
if Self=Src then exit(true);
if (MinUrgency<>Src.MinUrgency)
or (FilterNotesWithoutPos<>Src.FilterNotesWithoutPos)
or (FilterMsgTypeCount<>Src.FilterMsgTypeCount)
then exit;
for i:=0 to FilterMsgTypeCount-1 do
if not FilterMsgTypes[i].IsEqual(Src.FilterMsgTypes[i]) then exit;
Result:=true;
end;
procedure TLMsgViewFilter.Assign(Src: TLMsgViewFilter);
var
NewCnt: Integer;
OldCnt: Integer;
i: Integer;
begin
if IsEqual(Src) then exit;
fMinUrgency:=Src.MinUrgency;
FFilterNotesWithoutPos:=Src.FilterNotesWithoutPos;
// filter msg type
NewCnt:=Src.FilterMsgTypeCount;
OldCnt:=FilterMsgTypeCount;
for i:=NewCnt to OldCnt-1 do
FreeAndNil(fFilterMsgTypes[i]);
SetLength(fFilterMsgTypes,NewCnt);
for i:=0 to NewCnt-1 do begin
if fFilterMsgTypes[i]=nil then
fFilterMsgTypes[i]:=TLMVFilterMsgType.Create(Self);
fFilterMsgTypes[i].InternalAssign(Src.FilterMsgTypes[i]);
end;
Changed;
end;
function TLMsgViewFilter.LineFits(Line: TMessageLine): boolean;
begin
Result:=false;
if ord(Line.Urgency)<ord(MinUrgency) then exit;
if [mlfHiddenByIDEDirective,mlfFixed]*Line.Flags<>[] then exit;
if FilterNotesWithoutPos and (Line.Urgency<=mluNote)
and ((Line.Filename='') or (Line.Line<1)) then exit;
if IndexOfFilterMsgType(Line)>=0 then exit;
Result:=true;
end;
function TLMsgViewFilter.AddFilterMsgType(SubTool: string;
MsgID: integer): TLMVFilterMsgType;
var
i: Integer;
begin
i:=length(fFilterMsgTypes);
SetLength(fFilterMsgTypes,i+1);
Result:=TLMVFilterMsgType.Create(Self);
fFilterMsgTypes[i]:=Result;
Result.FSubTool:=SubTool;
Result.FMsgID:=MsgID;
UpdateFilterMsgTypeIndex(Result);
Changed;
end;
procedure TLMsgViewFilter.DeleteFilterMsgType(Index: integer);
begin
if (Index<0) or (Index>=FilterMsgTypeCount) then
raise Exception.Create('');
fFilterMsgTypes[Index].Free;
if Index<FilterMsgTypeCount-1 then
system.Move(fFilterMsgTypes[Index+1],fFilterMsgTypes[Index],
SizeOf(TLMVFilterMsgType)*(FilterMsgTypeCount-Index-1));
SetLength(fFilterMsgTypes,length(fFilterMsgTypes)-1);
Changed;
end;
procedure TLMsgViewFilter.ClearFilterMsgTypes;
var
i: Integer;
begin
if FilterMsgTypeCount=0 then exit;
for i:=0 to FilterMsgTypeCount-1 do
fFilterMsgTypes[i].Free;
SetLength(fFilterMsgTypes,0);
Changed;
end;
function TLMsgViewFilter.IndexOfFilterMsgType(Line: TMessageLine): integer;
var
l: Integer;
r: Integer;
m: Integer;
cmp: Integer;
begin
l:=0;
r:=FilterMsgTypeCount-1;
while l<=r do begin
m:=(l+r) div 2;
cmp:=CompareLineAndFilterMsgType(Line,fFilterMsgTypes[m]);
if cmp<0 then
r:=m-1
else if cmp>0 then
l:=m+1
else
exit(m);
end;
Result:=-1;
end;
procedure TLMsgViewFilter.ConsistencyCheck;
procedure E(Msg: string);
begin
raise Exception.Create(Msg);
end;
var
i: Integer;
begin
for i:=0 to FilterMsgTypeCount-2 do begin
if CompareFilterMsgType(fFilterMsgTypes[i],fFilterMsgTypes[i+1])>0 then
E(IntToStr(i));
end;
end;
initialization
DefaultConfigClass:=TXMLOptionsStorage;
GetIDEConfigStorage:=@GetLazIDEConfigStorage;