diff --git a/components/lazcontrols/listfilteredit.pas b/components/lazcontrols/listfilteredit.pas index 804c2a5d55..95aa21b2c5 100644 --- a/components/lazcontrols/listfilteredit.pas +++ b/components/lazcontrols/listfilteredit.pas @@ -17,15 +17,15 @@ type TListFilterEdit = class(TCustomControlFilterEdit) private - fFilteredListbox: TListbox; // A control showing the (filtered) data. - fSelectionList: TStringList; // Store/restore the old selections here. + fFilteredListbox: TCustomListbox; // A control showing the (filtered) data. + fSelectionList: TStringList; // Store/restore the old selections here. // Data supplied by caller through Data property. fOriginalData: TStringList; // Data sorted for viewing. fSortedData: TStringList; function CompareFNs(AFilename1,AFilename2: string): integer; function GetFirstSelected: Integer; - procedure SetFilteredListbox(const AValue: TListBox); + procedure SetFilteredListbox(const AValue: TCustomListBox); procedure UnselectAll; protected procedure MoveNext; override; @@ -42,7 +42,7 @@ type property SelectionList: TStringList read fSelectionList; property Data: TStringList read fOriginalData; published - property FilteredListbox: TListBox read fFilteredListbox write SetFilteredListbox; + property FilteredListbox: TCustomListBox read fFilteredListbox write SetFilteredListbox; end; var @@ -52,6 +52,8 @@ procedure Register; implementation +uses CheckLst; + procedure Register; begin {$I listfilteredit_icon.lrs} @@ -81,7 +83,7 @@ begin Result := ListFilterGlyph; end; -procedure TListFilterEdit.SetFilteredListbox(const AValue: TListBox); +procedure TListFilterEdit.SetFilteredListbox(const AValue: TCustomListBox); begin if fFilteredListbox = AValue then Exit; fFilteredListbox:=AValue; @@ -91,18 +93,33 @@ end; procedure TListFilterEdit.ApplyFilterCore; var - i: Integer; - FileN: string; + i, j: Integer; + s: string; + clb: TCustomCheckListBox; + TempOnItemClick: TCheckListClicked; begin + clb:=Nil; + TempOnItemClick:=Nil; + if fFilteredListbox is TCustomCheckListBox then begin + clb:=TCustomCheckListBox(fFilteredListbox); + if Assigned(clb.OnItemClick) then begin + TempOnItemClick:=clb.OnItemClick; + clb.OnItemClick:=Nil; // Disable OnItemClick temporarily. + end; + end; fFilteredListbox.Clear; fFilteredListbox.Items.BeginUpdate; for i:=0 to fSortedData.Count-1 do begin - FileN:=fSortedData[i]; - fFilteredListbox.Items.AddObject(FileN, fSortedData.Objects[i]); + s:=fSortedData[i]; + j:=fFilteredListbox.Items.AddObject(s, fSortedData.Objects[i]); if Assigned(fSelectedPart) then fFilteredListbox.Selected[i]:=fSelectedPart=fSortedData.Objects[i]; + if Assigned(clb) and Assigned(OnCheckItem) then + clb.Checked[j]:=OnCheckItem(fSortedData.Objects[i]); end; fFilteredListbox.Items.EndUpdate; + if Assigned(TempOnItemClick) then + clb.OnItemClick:=TempOnItemClick; // Restore OnItemClick. end; function TListFilterEdit.CompareFNs(AFilename1,AFilename2: string): integer; @@ -117,18 +134,27 @@ procedure TListFilterEdit.SortAndFilter; // Copy data from fOriginalData to fSortedData in sorted order var Origi, i: Integer; - FileN: string; + s: string; + Pass, Done, Checked: Boolean; begin + Done:=False; fSortedData.Clear; for Origi:=0 to fOriginalData.Count-1 do begin - FileN:=fOriginalData[Origi]; - if (Filter='') or (Pos(Filter,lowercase(FileN))>0) then begin + s:=fOriginalData[Origi]; + // Filter with event handler if there is one. + Pass:=False; + if Assigned(OnFilterItem) then + Pass:=OnFilterItem(fOriginalData.Objects[Origi], Done); + // Filter by item's title text if needed. + if not (Pass or Done) then + Pass:=(Filter='') or (Pos(Filter,lowercase(s))>0); + if Pass then begin i:=fSortedData.Count-1; while i>=0 do begin - if CompareFNs(FileN,fSortedData[i])>=0 then break; + if CompareFNs(s,fSortedData[i])>=0 then break; dec(i); end; - fSortedData.InsertObject(i+1,FileN, fOriginalData.Objects[Origi]); + fSortedData.InsertObject(i+1, s, fOriginalData.Objects[Origi]); end; end; end; @@ -138,20 +164,18 @@ var i: Integer; begin fSelectionList.Clear; - for i := 0 to fFilteredListbox.Count-1 do begin + for i := 0 to fFilteredListbox.Count-1 do if fFilteredListbox.Selected[i] then fSelectionList.Add(fFilteredListbox.Items[i]); - end; end; procedure TListFilterEdit.RestoreSelection; var i: Integer; begin - for i := 0 to fFilteredListbox.Count-1 do begin + for i := 0 to fFilteredListbox.Count-1 do if fSelectionList.IndexOf(fFilteredListbox.Items[i])>0 then fFilteredListbox.Selected[i]:=True; - end; end; function TListFilterEdit.GetFirstSelected: Integer; diff --git a/ide/frames/compiler_messages_options.lfm b/ide/frames/compiler_messages_options.lfm index 7647904bfc..98a65707d4 100644 --- a/ide/frames/compiler_messages_options.lfm +++ b/ide/frames/compiler_messages_options.lfm @@ -1,63 +1,67 @@ inherited CompilerMessagesOptionsFrame: TCompilerMessagesOptionsFrame Height = 455 - Width = 626 + Width = 631 ClientHeight = 455 - ClientWidth = 626 - TabOrder = 0 - DesignLeft = 287 - DesignTop = 181 + ClientWidth = 631 + DesignLeft = 239 + DesignTop = 167 object grpCompilerMessages: TGroupBox[0] Left = 0 Height = 455 Top = 0 - Width = 626 + Width = 631 Align = alClient Caption = 'grpCompilerMessages' - ClientHeight = 436 - ClientWidth = 622 + ClientHeight = 437 + ClientWidth = 627 TabOrder = 0 - object editMsgFilter: TEdit - AnchorSideLeft.Control = lblFilter - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = grpCompilerMessages - Left = 56 - Height = 21 - Top = 6 - Width = 558 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 6 - BorderSpacing.Top = 6 - BorderSpacing.Right = 6 - OnChange = editMsgFilterChange - TabOrder = 0 - Text = 'editMsgFilter' - end object chklistCompMsg: TCheckListBox AnchorSideLeft.Control = grpCompilerMessages - AnchorSideTop.Control = editMsgFilter AnchorSideTop.Side = asrBottom AnchorSideRight.Control = grpCompilerMessages AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = grpCompilerMessages AnchorSideBottom.Side = asrBottom Left = 6 - Height = 397 - Top = 33 - Width = 610 + Height = 399 + Top = 32 + Width = 615 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Around = 6 ItemHeight = 0 OnItemClick = chklistCompMsgItemClick Sorted = True - TabOrder = 1 + TabOrder = 0 end object lblFilter: TLabel + AnchorSideTop.Control = editMsgFilter + AnchorSideTop.Side = asrCenter Left = 6 - Height = 16 - Top = 8 - Width = 44 + Height = 15 + Top = 9 + Width = 41 Caption = 'lblFilter' ParentColor = False end + object editMsgFilter: TListFilterEdit + AnchorSideLeft.Control = lblFilter + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = grpCompilerMessages + Left = 53 + Height = 20 + Top = 6 + Width = 534 + OnCheckItem = CheckItem + ButtonWidth = 23 + NumGlyphs = 0 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 6 + BorderSpacing.Top = 6 + BorderSpacing.Right = 6 + MaxLength = 0 + ParentFont = False + TabOrder = 1 + FilteredListbox = chklistCompMsg + end end end diff --git a/ide/frames/compiler_messages_options.pas b/ide/frames/compiler_messages_options.pas index 9c32102d79..f20b78d89d 100644 --- a/ide/frames/compiler_messages_options.pas +++ b/ide/frames/compiler_messages_options.pas @@ -5,11 +5,9 @@ unit compiler_messages_options; interface uses - Classes, SysUtils, FileUtil, Forms, StdCtrls, CheckLst, LCLProc, - Dialogs, - IDEOptionsIntf, Project, - LazarusIDEStrConsts, - EnvironmentOpts, CompilerOptions, IDEMsgIntf; + Classes, SysUtils, FileUtil, ListFilterEdit, Forms, StdCtrls, CheckLst, + LCLProc, Dialogs, IDEOptionsIntf, Project, LazarusIDEStrConsts, + EnvironmentOpts, CompilerOptions, IDEMsgIntf, EditBtn; type @@ -17,22 +15,16 @@ type TCompilerMessagesOptionsFrame = class(TAbstractIDEOptionsEditor) chklistCompMsg: TCheckListBox; - editMsgFilter: TEdit; + editMsgFilter: TListFilterEdit; grpCompilerMessages: TGroupBox; lblFilter: TLabel; - procedure btnBrowseMsgClick(Sender: TObject); procedure chklistCompMsgItemClick(Sender: TObject; Index: integer); - procedure chkUseMsgFileChange(Sender: TObject); - procedure editMsgFilterChange(Sender: TObject); + function CheckItem(Item: TObject): Boolean; private fLoaded: Boolean; FSaved: Boolean; - { private declarations } TempMessages: TCompilerMessagesList; - procedure UpdateMessages; - procedure UpdateFilter; public - { public declarations } constructor Create(TheOwner: TComponent); override; destructor Destroy; override; @@ -49,16 +41,6 @@ implementation { TCompilerMessagesOptionsFrame } -procedure TCompilerMessagesOptionsFrame.chkUseMsgFileChange(Sender: TObject); -begin - UpdateMessages; -end; - -procedure TCompilerMessagesOptionsFrame.editMsgFilterChange(Sender: TObject); -begin - UpdateFilter; -end; - procedure TCompilerMessagesOptionsFrame.chklistCompMsgItemClick(Sender: TObject; Index: integer); const BoolToMessageState: array[Boolean] of TCompilerMessageState = (msOff, msOn); @@ -74,87 +56,15 @@ begin end; end; -procedure TCompilerMessagesOptionsFrame.btnBrowseMsgClick(Sender: TObject); +function TCompilerMessagesOptionsFrame.CheckItem(Item: TObject): Boolean; var - dlg : TOpenDialog; + m: TCompilerMessageConfig; begin - dlg := TOpenDialog.Create(Self); - try - dlg.Filter := dlgBrowseMsgFilter; - if not dlg.Execute then Exit; - editMsgFilter.Caption := dlg.FileName; - UpdateMessages; - finally - dlg.Free - end; -end; - -procedure TCompilerMessagesOptionsFrame.UpdateMessages; -const - MaxIndexLen = 5; -var - topidx : Integer; -begin - topidx := chklistCompMsg.TopIndex; - chklistCompMsg.Items.BeginUpdate; - try - //debugln(['TCompilerMessagesOptionsFrame.UpdateMessages ',EnvironmentOptions.CompilerMessagesFilename]); - if FileExistsUTF8(EnvironmentOptions.CompilerMessagesFilename) then begin - try - // FPC messages file is expected to be UTF8 encoded, no matter for the current code page is - TempMessages.LoadMsgFile(EnvironmentOptions.CompilerMessagesFilename); - except - TempMessages.SetDefault; - end; - end else - TempMessages.SetDefault; - - chklistCompMsg.Clear; - chklistCompMsg.Items.Clear; - - UpdateFilter; - - finally - chklistCompMsg.Items.EndUpdate; - chkListCompMsg.TopIndex := topidx; - end; -end; - -procedure TCompilerMessagesOptionsFrame.UpdateFilter; -var - i : Integer; - j : Integer; - m : TCompilerMessageConfig; - add : Boolean; - srch : AnsiString; -const - //todo: should be translated - MsgTypeStr : array [TFPCErrorType] of String = ('-','H','N','W','E','F','P'); -begin - chklistCompMsg.Items.BeginUpdate; - try - chklistCompMsg.Clear; - srch:=UTF8UpperCase(editMsgFilter.Text); - for i := 0 to TempMessages.Count - 1 do - begin - m := TempMessages.Msg[i]; - add:=m.MsgType in [etNote, etHint, etWarning]; - - if add and (srch<>'') then - add:=System.Pos(srch, UTF8UpperCase(m.GetUserText))>0; - - if add then - begin - j := chklistCompMsg.Items.AddObject( Format('(%s) %s', [MsgTypeStr[m.MsgType], m.GetUserText([])]), m); - if m.State = msDefault then - chklistCompMsg.Checked[j] := not m.DefIgnored - else - chklistCompMsg.Checked[j] := m.State = msOn; - end; - end; - finally - chklistCompMsg.Items.EndUpdate; - end; + m := Item as TCompilerMessageConfig; + if m.State = msDefault then + Result := not m.DefIgnored + else + Result := m.State = msOn; end; constructor TCompilerMessagesOptionsFrame.Create(TheOwner: TComponent); @@ -165,6 +75,9 @@ end; destructor TCompilerMessagesOptionsFrame.Destroy; begin + editMsgFilter.Data.Clear; + chklistCompMsg.Clear; + chklistCompMsg.Items.Clear; TempMessages.Free; inherited Destroy; end; @@ -176,20 +89,45 @@ end; procedure TCompilerMessagesOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog); begin - editMsgFilter.Caption := ''; grpCompilerMessages.Caption:=dlgCompilerMessage; lblFilter.Caption:=lisFilter; end; procedure TCompilerMessagesOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions); +const // todo: should be translated + MsgTypeStr: array [TFPCErrorType] of String = ('-','H','N','W','E','F','P'); +var + topidx, i: Integer; + m: TCompilerMessageConfig; + s: String; begin if fLoaded then exit; fLoaded:=true; - with AOptions as TBaseCompilerOptions do + TempMessages.Assign((AOptions as TBaseCompilerOptions).CompilerMessages); + topidx := chklistCompMsg.TopIndex; + if FileExistsUTF8(EnvironmentOptions.CompilerMessagesFilename) then begin + try + // FPC messages file is expected to be UTF8 encoded, no matter for the current code page is + TempMessages.LoadMsgFile(EnvironmentOptions.CompilerMessagesFilename); + except + TempMessages.SetDefault; + end; + end else + TempMessages.SetDefault; + + // Copy data to filter component + editMsgFilter.Data.Clear; + for i := 0 to TempMessages.Count - 1 do begin - TempMessages.Assign(CompilerMessages); - UpdateMessages; + m := TempMessages.Msg[i]; + if m.MsgType in [etNote, etHint, etWarning] then + begin + s := Format('(%s) %s', [MsgTypeStr[m.MsgType], m.GetUserText([])]); + editMsgFilter.Data.AddObject(s, m); + end; end; + editMsgFilter.InvalidateFilter; + chkListCompMsg.TopIndex := topidx; end; procedure TCompilerMessagesOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions); @@ -206,7 +144,7 @@ end; class function TCompilerMessagesOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass; begin - Result := TBaseCompilerOptions; + Result:=TBaseCompilerOptions; end; initialization diff --git a/ide/lazarus.lpi b/ide/lazarus.lpi index 17c2941497..26e71c366a 100644 --- a/ide/lazarus.lpi +++ b/ide/lazarus.lpi @@ -651,7 +651,7 @@ - + @@ -665,12 +665,6 @@ - - - - - - diff --git a/lcl/editbtn.pas b/lcl/editbtn.pas index d6ce52bafa..13266e0382 100644 --- a/lcl/editbtn.pas +++ b/lcl/editbtn.pas @@ -151,6 +151,14 @@ type property Visible; end; + // Called when an item is filtered. Returns true if the item passes the filter. + // Done=False means the data should also be filtered by its title string. + // Done=True means no other filtering is needed. + TFilterItemEvent = function (Item: TObject; out Done: Boolean): Boolean of object; + + // Can be used only for items that have a checkbox. Returns true if checked. + TCheckItemEvent = function (Item: TObject): Boolean of object; + { TCustomControlFilterEdit } // An abstract base class for edit controls which filter data in @@ -167,6 +175,8 @@ type fNeedUpdate: Boolean; fIsFirstUpdate: Boolean; fSelectedPart: TObject; // Select this node on next update + fOnFilterItem: TFilterItemEvent; + fOnCheckItem: TCheckItemEvent; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure Change; override; procedure DoEnter; override; @@ -190,6 +200,8 @@ type property SortData: Boolean read fSortData write fSortData; property SelectedPart: TObject read fSelectedPart write fSelectedPart; published + property OnFilterItem: TFilterItemEvent read fOnFilterItem write fOnFilterItem; + property OnCheckItem: TCheckItemEvent read fOnCheckItem write fOnCheckItem; // TEditButton properties. property ButtonWidth; property DirectInput;