Improve ListFilterEdit and apply it to compiler message dialog.

git-svn-id: trunk@33774 -

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;

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

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

ide/lazarus.lpi

@@ -651,7 +651,7 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <Target>
       <Filename Value="../lazarus"/>
     </Target>
@@ -665,12 +665,6 @@
         <CStyleOperator Value="False"/>
       </SyntaxOptions>
     </Parsing>
-    <Linking>
-      <Debugging>
-        <GenerateDebugInfo Value="True"/>
-        <DebugInfoType Value="dsAuto"/>
-      </Debugging>
-    </Linking>
     <Other>
       <CompilerMessages>
         <UseMsgFile Value="True"/>

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;