ideintf: apply patches of Alexander S. Klenin (issue #0013326)

- ClassPropEdit: Make subproperties type filter configurable
  - ClassPropEdit: Refactor TClassPropertyEditor and TPersistentPropertyEditor
  - Object Inspector: Do not show objects without properties of appropriate kind
  - Object inspector: Do not show events on Properties page, even for nested objects

git-svn-id: trunk@19016 -

ideintf/objectinspector.pp

@@ -392,6 +392,7 @@ type
     procedure SetSubPropertiesColor(const AValue: TColor);
     procedure UpdateScrollBar;
     procedure FillComboboxItems;
+    function PropInfoFilter(const APropInfo: PPropInfo): Boolean;
   protected
     procedure CreateParams(var Params: TCreateParams); override;
     procedure CreateWnd; override;
@@ -1181,6 +1182,12 @@ begin
   end;
 end;
 
+function TOICustomPropertyGrid.PropInfoFilter(
+  const APropInfo: PPropInfo): Boolean;
+begin
+  Result := HasSubpropertiesInFilter(APropInfo, FFilter);
+end;
+
 function TOICustomPropertyGrid.GetRowByPath(
   const PropPath: string): TOIPropertyGridRow;
 // searches PropPath. Expands automatically parent rows
@@ -1569,8 +1576,9 @@ begin
   for a:=0 to FRows.Count-1 do Rows[a].Free;
   FRows.Clear;
   // get properties
-  GetPersistentProperties(FSelection, FFilter, FPropertyEditorHook,
+  GetPersistentProperties(
-    @AddPropertyEditor,nil);
+    FSelection, FFilter, FPropertyEditorHook, @AddPropertyEditor,
+    @PropInfoFilter, nil);
   // sort
   FRows.Sort(@SortGridRows);
   for a:=0 to FRows.Count-1 do begin
@@ -1627,7 +1635,9 @@ begin
         exit;
       end;
   end;
-  NewRow:=TOIPropertyGridRow.Create(Self,PropEditor,nil, WidgetSets);
+  if PropEditor is TClassPropertyEditor then
+    (PropEditor as TClassPropertyEditor).SubPropsTypeFilter := FFilter;
+  NewRow := TOIPropertyGridRow.Create(Self, PropEditor, nil, WidgetSets);
   FRows.Add(NewRow);
   if FRows.Count>1 then begin
     NewRow.FPriorBrother:=Rows[FRows.Count-2];
@@ -1749,6 +1759,8 @@ procedure TOICustomPropertyGrid.AddSubEditor(PropEditor:TPropertyEditor);
 var NewRow:TOIPropertyGridRow;
   NewIndex:integer;
 begin
+  if PropEditor is TClassPropertyEditor then
+    (PropEditor as TClassPropertyEditor).SubPropsTypeFilter := FFilter;
   NewRow:=TOIPropertyGridRow.Create(Self,PropEditor,FExpandingRow, []);
   NewIndex:=FExpandingRow.Index+1+FExpandingRow.ChildCount;
   NewRow.Index:=NewIndex;
@@ -4635,7 +4647,8 @@ begin
   end;
 
   PropertyGrid := CreateGrid(PROPS, oipgpProperties, 0);
-  EventGrid := CreateGrid([tkMethod], oipgpEvents, 1);
+  // Nested or referenced objects may have events too.
+  EventGrid := CreateGrid([tkClass, tkMethod], oipgpEvents, 1);
   FavouriteGrid := CreateGrid(PROPS + [tkMethod], oipgpFavourite, 2);
   FavouriteGrid.Favourites := FFavourites;
   RestrictedGrid := CreateGrid(PROPS + [tkMethod], oipgpRestricted, 3);

ideintf/propedits.pp

@@ -549,10 +549,22 @@ type
   editing of the object's properties as sub-properties of the property. }
 
   TClassPropertyEditor = class(TPropertyEditor)
+  private
+    FSubPropsTypeFilter: TTypeKinds;
+    procedure SetSubPropsTypeFilter(const AValue: TTypeKinds);
+    function PropInfoFilter(const APropInfo: PPropInfo): Boolean;
+  protected
+    function GetSelections: TPersistentSelectionList; virtual;
   public
+    constructor Create(
+      Hook: TPropertyEditorHook; APropCount: Integer); override;
+
     function GetAttributes: TPropertyAttributes; override;
     procedure GetProperties(Proc: TGetPropEditProc); override;
     function GetValue: ansistring; override;
+
+    property SubPropsTypeFilter: TTypeKinds
+      read FSubPropsTypeFilter write SetSubPropsTypeFilter default tkAny;
   end;
 
 { TMethodPropertyEditor
@@ -580,17 +592,16 @@ type
   in the same form that is type compatible with the property being edited
   (e.g. the ActiveControl property). }
 
-  TPersistentPropertyEditor = class(TPropertyEditor)
+  TPersistentPropertyEditor = class(TClassPropertyEditor)
   protected
     function FilterFunc(const ATestEditor: TPropertyEditor): Boolean;
     function GetPersistentReference: TPersistent; virtual;
-    function GetSelections: TPersistentSelectionList; virtual;
+    function GetSelections: TPersistentSelectionList; override;
     function CheckNewValue(APersistent: TPersistent): boolean; virtual;
   public
     function AllEqual: Boolean; override;
     procedure Edit; override;
     function GetAttributes: TPropertyAttributes; override;
-    procedure GetProperties(Proc:TGetPropEditProc); override;
     function GetEditLimit: Integer; override;
     function GetValue: AnsiString; override;
     procedure GetValues(Proc: TGetStringProc); override;
@@ -1595,6 +1606,11 @@ type
 procedure WritePublishedProperties(Instance: TPersistent);
 procedure EditCollection(AComponent: TComponent; ACollection: TCollection; APropertyName: String);
 
+// Returns true if given property should be displayed on the property list
+// filtered by AFilter.
+function HasSubpropertiesInFilter(
+  const APropInfo: PPropInfo; const AFilter: TTypeKinds): Boolean;
+
 const
   NoDefaultValue = Longint($80000000);
 
@@ -4003,6 +4019,13 @@ end;
 
 { TClassPropertyEditor }
 
+constructor TClassPropertyEditor.Create(Hook: TPropertyEditorHook;
+  APropCount: Integer);
+begin
+  inherited Create(Hook, APropCount);
+  FSubPropsTypeFilter := tkAny;
+end;
+
 function TClassPropertyEditor.GetAttributes: TPropertyAttributes;
 begin
   Result := [paMultiSelect, paSubProperties, paReadOnly];
@@ -4010,26 +4033,48 @@ end;
 
 procedure TClassPropertyEditor.GetProperties(Proc: TGetPropEditProc);
 var
-  I: Integer;
+  selection: TPersistentSelectionList;
-  SubItem: TPersistent;
-  Selection: TPersistentSelectionList;
 begin
-  Selection := TPersistentSelectionList.Create;
+  selection := GetSelections;
+  if selection = nil then exit;
+  GetPersistentProperties(
+    selection, SubPropsTypeFilter, PropertyHook, Proc, @PropInfoFilter, nil);
+  selection.Free;
+end;
+
+function TClassPropertyEditor.GetSelections: TPersistentSelectionList;
+var
+  i: Integer;
+  subItem: TPersistent;
+begin
+  Result := TPersistentSelectionList.Create;
   try
-    for I := 0 to PropCount - 1 do begin
+    for i := 0 to PropCount - 1 do begin
-      SubItem := TPersistent(GetObjectValueAt(I));
+      subItem := TPersistent(GetObjectValueAt(i));
-      if SubItem<>nil then
+      if subItem <> nil then
-        Selection.Add(SubItem);
+        Result.Add(subItem);
     end;
-    GetPersistentProperties(Selection,tkProperties,PropertyHook,Proc,nil);
+  except
-  finally
+    Result.Free;
-    Selection.Free;
+    raise;
   end;
 end;
 
 function TClassPropertyEditor.GetValue: ansistring;
 begin
-  Result:='('+GetPropType^.Name+')';
+  Result:='(' + GetPropType^.Name + ')';
+end;
+
+function TClassPropertyEditor.PropInfoFilter(
+  const APropInfo: PPropInfo): Boolean;
+begin
+  Result := HasSubpropertiesInFilter(APropInfo, SubPropsTypeFilter);
+end;
+
+procedure TClassPropertyEditor.SetSubPropsTypeFilter(const AValue: TTypeKinds);
+begin
+  if FSubPropsTypeFilter = AValue then exit;
+  FSubPropsTypeFilter := AValue;
 end;
 
 { TMethodPropertyEditor }
@@ -4072,7 +4117,7 @@ begin
     NewMethodName := GetFormMethodName;
     DebugLn('### TMethodPropertyEditor.Edit B FormMethodName=',NewMethodName);
     if not IsValidIdent(NewMethodName) then
-      raise EPropertyError.Create('Method name '+NewMethodName+' must be an identifier');
+      raise EPropertyError.Create('Method name "'+NewMethodName+'" must be an identifier');
     SetValue(NewMethodName); // this will jump to the method
     PropertyHook.RefreshPropertyValues;
   end else
@@ -4293,18 +4338,12 @@ begin
   Result := TPersistent(GetObjectValue);
 end;
 
-function TPersistentPropertyEditor.GetSelections:
+function TPersistentPropertyEditor.GetSelections: TPersistentSelectionList;
-  TPersistentSelectionList;
-var
-  I: Integer;
 begin
-  Result := nil;
   if (GetPersistentReference <> nil) and AllEqual then
-  begin
+    Result := inherited GetSelections
-    Result := TPersistentSelectionList.Create;
+  else
-    for I := 0 to PropCount - 1 do
+    Result := nil;
-      Result.Add(TPersistent(GetObjectValueAt(I)));
-  end;
 end;
 
 function TPersistentPropertyEditor.CheckNewValue(APersistent: TPersistent): boolean;
@@ -4356,18 +4395,6 @@ begin
     Result := Result + [paSubProperties, paVolatileSubProperties];
 end;
 
-procedure TPersistentPropertyEditor.GetProperties(Proc: TGetPropEditProc);
-var
-  LPersistents: TPersistentSelectionList;
-begin
-  LPersistents := GetSelections;
-  if LPersistents <> nil then
-  begin
-    GetPersistentProperties(LPersistents, tkAny, PropertyHook, Proc, nil);
-    LPersistents.Free;
-  end;
-end;
-
 function TPersistentPropertyEditor.GetEditLimit: Integer;
 begin
   Result := MaxIdentLength;
@@ -4378,19 +4405,18 @@ var
   Component: TComponent;
   APersistent: TPersistent;
 begin
-  Result:='';
+  Result := '';
-  APersistent:=GetPersistentReference;
+  APersistent := GetPersistentReference;
   if APersistent is TComponent then begin
-    Component:=TComponent(APersistent);
+    Component := TComponent(APersistent);
-    if Assigned(PropertyHook) then begin
+    if Assigned(PropertyHook) then
-      Result:=PropertyHook.GetComponentName(Component);
+      Result := PropertyHook.GetComponentName(Component)
-    end else begin
+    else begin
       if Assigned(Component) then
-        Result:=Component.Name;
+        Result := Component.Name;
-    end;
-  end else if APersistent<>nil then begin
-    Result:='('+APersistent.ClassName+')';
     end;
+  end else if APersistent <> nil then
+    Result := inherited GetValue;
 end;
 
 procedure TPersistentPropertyEditor.GetValues(Proc: TGetStringProc);
@@ -6742,6 +6768,49 @@ begin
   TCollectionPropertyEditor.ShowCollectionEditor(ACollection, AComponent, APropertyName);
 end;
 
+function HasSubpropertiesInFilter(
+  const APropInfo: PPropInfo; const AFilter: TTypeKinds): Boolean;
+var
+  visited: TFPList;
+
+  procedure Rec(A: PPropInfo);
+  var
+    propList: PPropList;
+    i: Integer;
+    ti: PTypeInfo;
+  begin
+    ti := A^.PropType;
+    //DebugLn('HasSubpropertiesInFilter: ', ti^.Name);
+    Result :=
+      (ti^.Kind <> tkClass) or
+      // Since components are selectable in the designer,
+      // there is always a possibility that some descendant class may have
+      // properties of the required kind.
+      (GetTypeData(ti)^.ClassType.InheritsFrom(TComponent));
+    // Class properties may directly or indirectly refer to the same class,
+    // so we must avoid infinite recursion.
+    if Result or (visited.IndexOf(ti) >= 0) then exit;
+    visited.Add(ti);
+    for i := 0 to GetPropList(ti, propList) - 1 do begin
+      if propList^[i]^.PropType^.Kind in AFilter then
+        Rec(propList^[i]);
+      if Result then break;
+    end;
+    FreeMem(propList);
+    visited.Delete(visited.Count - 1);
+  end;
+
+begin
+  visited := TFPList.Create;
+  try
+    //DebugLn('HasSubpropertiesInFilter -> ', APropInfo^.Name, ': ', APropInfo^.PropType^.Name);
+    Rec(APropInfo);
+    //DebugLn('HasSubpropertiesInFilter <- ', BoolToStr(Result, true));
+  finally
+    visited.Free;
+  end;
+end;
+
 { TNoteBookActiveControlPropertyEditor }
 
 function TNoteBookActiveControlPropertyEditor.CheckNewValue(