Restriction browser: Use TreeFilterEdit for better filtering

git-svn-id: trunk@34895 -
2025-11-01 23:19:39 +01:00 · 2012-01-24 14:07:50 +00:00 · 2012-01-24 14:07:50 +00:00 · 36861c1f8e
commit 36861c1f8e
parent 6ae55bb20e
4 changed files with 96 additions and 157 deletions
--- a/ide/compatibilityrestrictions.pas
+++ b/ide/compatibilityrestrictions.pas
@ -147,13 +147,15 @@ end;

 function GetRestrictedProperties: TOIRestrictedProperties;
 begin
-  if RestrictedManager = nil then RestrictedManager := TRestrictedManager.Create;
+  if RestrictedManager = nil then
+    RestrictedManager := TRestrictedManager.Create;
  Result := RestrictedManager.GetRestrictedProperties;
 end;

 function GetRestrictedList: TRestrictedList;
 begin
-  if RestrictedManager = nil then RestrictedManager := TRestrictedManager.Create;
+  if RestrictedManager = nil then
+    RestrictedManager := TRestrictedManager.Create;
  Result := RestrictedManager.GetRestrictedList;
 end;

--- a/ide/lazarusidestrconsts.pas
+++ b/ide/lazarusidestrconsts.pas
@ -2231,6 +2231,7 @@ resourcestring
  lisShowUnits = 'Show units';
  lisShowIdentifiers = 'Show identifiers';
  lisFilter = 'Filter';
+  lisIssues = 'Issues';
  lisUseMessageFile = 'Use message file:';
  lisRegularExpression = 'Regular expression';
  lisInvalidFilter = 'Invalid filter';
--- a/ide/restrictionbrowser.lfm
+++ b/ide/restrictionbrowser.lfm
@ -1,67 +1,91 @@
 object RestrictionBrowserView: TRestrictionBrowserView
  Left = 272
-  Height = 340
+  Height = 405
  Top = 259
-  Width = 660
-  ActiveControl = NameFilterEdit
+  Width = 674
  Caption = 'RestrictionBrowserView'
-  ClientHeight = 340
-  ClientWidth = 660
+  ClientHeight = 405
+  ClientWidth = 674
  OnCreate = FormCreate
-  LCLVersion = '0.9.27'
+  LCLVersion = '0.9.31'
  object IssueMemo: TMemo
-    Left = 264
-    Height = 306
-    Top = 18
-    Width = 390
-    Anchors = [akTop, akLeft, akRight, akBottom]
+    Left = 311
+    Height = 405
+    Top = 0
+    Width = 363
+    Align = alClient
    ReadOnly = True
    ScrollBars = ssAutoVertical
    TabOrder = 0
  end
-  object IssueFilterGroupBox: TGroupBox
-    Left = 6
-    Height = 96
-    Top = 12
-    Width = 250
-    Caption = 'IssueFilterGroupBox'
-    ClientHeight = 77
-    ClientWidth = 246
+  object Panel1: TPanel
+    Left = 0
+    Height = 405
+    Top = 0
+    Width = 306
+    Align = alLeft
+    ClientHeight = 405
+    ClientWidth = 306
    TabOrder = 1
-    object NameLabel: TLabel
-      Left = 10
-      Height = 14
-      Top = 44
-      Width = 53
-      Caption = 'NameLabel'
-      ParentColor = False
-    end
-    object NameFilterEdit: TEdit
-      Left = 70
-      Height = 23
-      Top = 38
-      Width = 164
-      OnChange = NameFilterEditChange
+    object IssueFilterGroupBox: TGroupBox
+      Left = 1
+      Height = 96
+      Top = 1
+      Width = 304
+      Align = alTop
+      Caption = 'IssueFilterGroupBox'
+      ClientHeight = 77
+      ClientWidth = 298
      TabOrder = 0
+      object NameLabel: TLabel
+        Left = 10
+        Height = 15
+        Top = 44
+        Width = 64
+        Caption = 'NameLabel'
+        ParentColor = False
+      end
+      object FilterEdit: TTreeFilterEdit
+        AnchorSideLeft.Control = NameLabel
+        AnchorSideLeft.Side = asrBottom
+        Left = 80
+        Height = 22
+        Top = 41
+        Width = 156
+        ButtonWidth = 23
+        NumGlyphs = 0
+        BorderSpacing.Left = 6
+        MaxLength = 0
+        TabOrder = 0
+        ExpandAllInitially = False
+        FilteredTreeview = IssueTreeView
+      end
+    end
+    object IssueTreeView: TTreeView
+      Left = 1
+      Height = 307
+      Top = 97
+      Width = 304
+      Align = alClient
+      Anchors = [akTop, akLeft, akBottom]
+      DefaultItemHeight = 16
+      HideSelection = False
+      Indent = 2
+      ReadOnly = True
+      RightClickSelect = True
+      RowSelect = True
+      ScrollBars = ssAutoBoth
+      ShowButtons = False
+      ShowLines = False
+      TabOrder = 1
+      OnSelectionChanged = IssueTreeViewSelectionChanged
+      Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoRightClickSelect, tvoRowSelect, tvoShowRoot, tvoToolTips, tvoThemedDraw]
    end
  end
-  object IssueTreeView: TTreeView
-    Left = 6
-    Height = 210
-    Top = 114
-    Width = 250
-    Anchors = [akTop, akLeft, akBottom]
-    DefaultItemHeight = 19
-    HideSelection = False
-    Indent = 2
-    ReadOnly = True
-    RightClickSelect = True
-    RowSelect = True
-    ScrollBars = ssAutoBoth
-    ShowButtons = False
-    ShowLines = False
-    TabOrder = 2
-    OnSelectionChanged = IssueTreeViewSelectionChanged
-    Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoRightClickSelect, tvoRowSelect, tvoShowRoot, tvoToolTips, tvoThemedDraw]
+  object Splitter1: TSplitter
+    Left = 306
+    Height = 405
+    Top = 0
+    Width = 5
  end
 end
--- a/ide/restrictionbrowser.pas
+++ b/ide/restrictionbrowser.pas
@ -31,7 +31,7 @@ interface

 uses
  Classes, SysUtils, InterfaceBase, LCLProc, Contnrs, Forms, Controls, Graphics,
-  Dialogs, StdCtrls, ComCtrls, Masks, ExtCtrls, Buttons,
+  Dialogs, StdCtrls, ComCtrls, TreeFilterEdit, ExtCtrls, Buttons,
  IDEImagesIntf, ObjectInspector,
  CompatibilityRestrictions, IDEOptionDefs, LazarusIDEStrConsts,
  EnvironmentOpts, ComponentReg, LazConf;
@ -40,11 +40,13 @@ type
  { TRestrictionBrowserView }

  TRestrictionBrowserView = class(TForm)
-    NameFilterEdit: TEdit;
+    FilterEdit: TTreeFilterEdit;
    IssueFilterGroupBox: TGroupBox;
    IssueMemo: TMemo;
-    NameLabel: TLabel;
    IssueTreeView: TTreeView;
+    NameLabel: TLabel;
+    Panel1: TPanel;
+    Splitter1: TSplitter;
    procedure FormCreate(Sender: TObject);
    procedure IssueTreeViewSelectionChanged(Sender: TObject);
    procedure NameFilterEditChange(Sender: TObject);
@ -53,8 +55,8 @@ type
    FClasses: TClassList;
    FCanUpdate: Boolean;
    procedure GetComponentClass(const AClass: TComponentClass);
-  public
    procedure UpdateIssueList;
+  public
    procedure SetIssueName(const AIssueName: String);
  end;
  
@ -73,14 +75,11 @@ var
  X: Integer;
 begin
  FIssueList := GetRestrictedList;
-  
  Name := NonModalIDEWindowNames[nmiwIssueBrowser];
  Caption := lisMenuViewRestrictionBrowser;
-
-  IssueFilterGroupBox.Caption := lisFilter;
+  IssueFilterGroupBox.Caption := lisIssues;
  NameLabel.Caption := lisCodeToolsDefsName;
  IssueTreeView.Images := IDEImages.Images_16;
-  
  X := 10;
  // create widget set filter buttons
  for P := Low(TLCLPlatform) to High(TLCLPlatform) do
@ -95,26 +94,23 @@ begin
      GroupIndex := Integer(P) + 1;
      Down := True;
      AllowAllUp := True;
-      
      try
        IDEImages.Images_16.GetBitmap(
               IDEImages.LoadImage(16, 'issue_'+LCLPlatformDirNames[P]), Glyph);
      except
        DebugLn('Restriction Browser: Unable to load image for ' + LCLPlatformDirNames[P] + '!');
      end;
-      
      ShowHint := True;
      Hint := LCLPlatformDisplayNames[P];
      OnClick := @NameFilterEditChange;
-      
      Parent := IssueFilterGroupBox;
      Inc(X, Width);
    end;
  end;
-  
  FCanUpdate := True;
  UpdateIssueList;
 end;
+
 procedure TRestrictionBrowserView.IssueTreeViewSelectionChanged(Sender: TObject);
 var
  Issue: TRestriction;
@ -124,7 +120,6 @@ begin
    IssueMemo.Clear;
    Exit;
  end;
-
  Issue := PRestriction(IssueTreeView.Selected.Data)^;
  IssueMemo.Text := Issue.Short + LineEnding + LineEnding + Issue.Description;
 end;
@ -141,130 +136,48 @@ end;

 procedure TRestrictionBrowserView.UpdateIssueList;
 var
-  IssueClass: String;
-  IssueProperty: String;
-  IssueMask: TMaskList;
-  S, M: String;
  I, ID: PtrInt;
  Issues: TStringList;
-  Issue: TRestriction;
-  C: TClass;
-  AddParentClass: Boolean;
  P: TLCLPlatform;
  WidgetSetFilter: TLCLPlatforms;
  Component: TComponent;
 begin
  if not FCanUpdate then Exit;
-  S := Trim(NameFilterEdit.Text);
-  IssueClass := '';
-  IssueProperty := '';
-  
  WidgetSetFilter := [];
  for P := Low(TLCLPlatform) to High(TLCLPlatform) do
  begin
    Component := FindComponent('SpeedButton' + LCLPlatformDirNames[P]);
-    if Component is TSpeedButton then
-      if (Component as TSpeedButton).Down then Include(WidgetSetFilter, P);
+    Assert(Component is TSpeedButton, 'Component '+Component.Name+' is not TSpeedButton');
+    if (Component as TSpeedButton).Down then
+      Include(WidgetSetFilter, P);
  end;
-  
-  I := Pos('.', S);
-  if I = 0 then IssueClass := S
-  else
-  begin
-    IssueClass := Copy(S, 0, I - 1);
-    IssueProperty := Copy(S, I + 1, MaxInt);
-  end;
-  
-  if (IssueProperty = '') and (IssueClass = '') then
-    M := '*'
-  else
-  begin
-    if IssueClass = '' then
-      M := '*.' + IssueProperty + '*'
-    else
-    begin
-      // find parent classes
-      M := '';
-      FClasses := TClassList.Create;
-      try
-        IDEComponentPalette.IterateRegisteredClasses(@GetComponentClass);
-        
-        FClasses.Add(TCustomForm);
-        FClasses.Add(TForm);
-        FClasses.Add(TDataModule);
-        FClasses.Add(TFrame);
-        
-        for I := 0 to FClasses.Count - 1 do
-        begin
-          C := FClasses[I];
-          AddParentClass := False;
-          while C <> nil do
-          begin
-            if AddParentClass or (Copy(C.ClassName, 0, Length(IssueClass)) = IssueClass) then
-            begin
-              if M <> '' then M := M + ';';
-              M := M + C.ClassName + ';' + C.ClassName + '.' + IssueProperty + '*';
-              AddParentClass := True;
-            end;
-            
-            C := C.ClassParent;
-          end;
-        end;
-        
-        if FClasses.Count = 0 then
-          M := IssueClass + '*;' + IssueClass + '*.' + IssueProperty + '*';
-          
-        if (Copy('TWidgetSet', 0, Length(IssueClass)) = IssueClass) then
-          M := M + ';TWidgetSet';
-      finally
-        FClasses.Free;
-      end;
-    end;
-  end;
-  
-  IssueMask := TMaskList.Create(M);
  Issues := TStringList.Create;
  try
    for I := 0 to High(FIssueList) do
-    begin
-      Issue := FIssueList[I];
-      if Issue.WidgetSet in WidgetSetFilter then
-        if IssueMask.Matches(Issue.Name)  then
-          Issues.AddObject(Issue.Name, TObject(I));
-    end;
-    
+      if FIssueList[I].WidgetSet in WidgetSetFilter then
+        Issues.AddObject(FIssueList[I].Name, TObject(I));
    Issues.Sort;
-
    IssueTreeView.BeginUpdate;
    try
      IssueTreeView.Items.Clear;
-      
      for I := 0 to Issues.Count - 1 do
      begin
        with IssueTreeView.Items.AddChild(nil, Issues[I]) do
        begin
          ID := PtrInt(Issues.Objects[I]);
-          
          ImageIndex := IDEImages.LoadImage(16,
              'issue_'+LCLPlatformDirNames[FIssueList[ID].WidgetSet]);
          StateIndex := ImageIndex;
          SelectedIndex := ImageIndex;
-          
          Data := @FIssueList[ID];
        end;
-        if NameFilterEdit.Text = Issues[I] then
-        begin
-          IssueTreeView.Selected := IssueTreeView.Items[I];
-        end;
      end;
    finally
      IssueTreeView.EndUpdate;
    end;
  finally
    Issues.Free;
-    IssueMask.Free;
  end;
-  
  if IssueTreeView.Items.Count > 0 then
  begin
    if IssueTreeView.Selected = nil then
@ -281,15 +194,14 @@ var
 begin
  FCanUpdate := False;
  try
-    NameFilterEdit.Text := AIssueName;
-
+    FilterEdit.Text := AIssueName;
    if AIssueName <> '' then
    begin
      for P := Low(TLCLPlatform) to High(TLCLPlatform) do
      begin
        Component := FindComponent('SpeedButton' + LCLPlatformDirNames[P]);
-        if Component is TSpeedButton then
-          (Component as TSpeedButton).Down := True;
+        Assert(Component is TSpeedButton, 'Component '+Component.Name+' is not TSpeedButton');
+        (Component as TSpeedButton).Down := True;
      end;
    end;
  finally