lcl: add RegisterRemovedProperty procedure which allows to skip removed properties by TReader and by IDE

ide: use information about removed properties to skip them while loading components

git-svn-id: trunk@17739 -

ide/customformeditor.pp

@@ -2263,10 +2263,19 @@ end;
 procedure TCustomFormEditor.JITListPropertyNotFound(Sender: TObject;
   Reader: TReader; Instance: TPersistent; var PropName: string;
   IsPath: boolean; var Handled, Skip: Boolean);
+var
+  Index: Integer;
 begin
-  DebugLn(['TCustomFormEditor.JITListPropertyNotFound ',Sender.ClassName,
-    ' Instance=',Instance.ClassName,' PropName="',PropName,
-    '" IsPath=',IsPath]);
+  Index := RemovedProperties.IndexOf(TPersistentClass(Instance.ClassType), PropName);
+  if Index >= 0 then
+  begin
+    Skip := True;
+    Handled := True;
+  end
+  else
+    DebugLn(['TCustomFormEditor.JITListPropertyNotFound ',Sender.ClassName,
+      ' Instance=',Instance.ClassName,' PropName="',PropName,
+      '" IsPath=',IsPath]);
 end;
 
 procedure TCustomFormEditor.JITListFindAncestors(Sender: TObject;

lcl/lresources.pp

@@ -349,6 +349,31 @@ type
     property OnFindComponentClass;
   end;
 
+  TRemovedProperty = record
+    PersistentClass: TPersistentClass;
+    PropertyName: String;
+    Note: String;
+    HelpKeyword: String;
+  end;
+  PRemovedProperty = ^TRemovedProperty;
+
+  { TRemovedPropertyList }
+
+  TRemovedPropertyList = class(TList)
+  private
+    function GetItem(AIndex: Integer): PRemovedProperty;
+    procedure SetItem(AIndex: Integer; const AValue: PRemovedProperty);
+  protected
+    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
+    procedure DoPropertyNotFound(Reader: TReader; Instance: TPersistent;
+      var PropName: string; IsPath: boolean; var Handled, Skip: Boolean);
+  public
+    function IndexOf(AClass: TPersistentClass; APropertyName: String): Integer;
+    function Add(APersistentClass: TPersistentClass; APropertyName, ANote,
+      AHelpKeyWord: string): Integer; reintroduce;
+    property Items[AIndex: Integer]: PRemovedProperty read GetItem write SetItem;
+  end;
+
 const
   ObjStreamMaskInherited = 1;
   ObjStreamMaskChildPos  = 2;
@@ -356,6 +381,7 @@ const
 
 var
   LazarusResources: TLResourceList;
+  RemovedProperties: TRemovedPropertyList = nil;
 
   LRSObjectReaderClass: TLRSObjectReaderClass=TLRSObjectReader;
   LRSObjectWriterClass: TLRSObjectWriterClass=TLRSObjectWriter;
@@ -483,12 +509,13 @@ function FloatToLFMStr(const Value: extended; Precision, Digits: Integer
 function CompareLRPositionLinkWithLFMPosition(Item1, Item2: Pointer): integer;
 function CompareLRPositionLinkWithLRSPosition(Item1, Item2: Pointer): integer;
 
+procedure RegisterRemovedProperty(PersistentClass: TPersistentClass;
+  PropertyName, Note, HelpKeyWord: string);
 
 procedure Register;
 
 implementation
 
-
 const
   LineEnd: ShortString = LineEnding;
 
@@ -518,6 +545,67 @@ type
                         var Name: string);
   end;
 
+{ TRemovedPropertyList }
+
+function TRemovedPropertyList.GetItem(AIndex: Integer): PRemovedProperty;
+begin
+  Result := inherited Get(AIndex);
+end;
+
+procedure TRemovedPropertyList.SetItem(AIndex: Integer;
+  const AValue: PRemovedProperty);
+begin
+  inherited Put(AIndex, AValue);
+end;
+
+procedure TRemovedPropertyList.Notify(Ptr: Pointer; Action: TListNotification);
+begin
+  if Action = lnDeleted then
+    Dispose(PRemovedProperty(Ptr))
+  else
+    inherited Notify(Ptr, Action);
+end;
+
+procedure TRemovedPropertyList.DoPropertyNotFound(Reader: TReader; Instance: TPersistent;
+  var PropName: string; IsPath: boolean; var Handled, Skip: Boolean);
+begin
+  Skip := IndexOf(TPersistentClass(Instance.ClassType), PropName) >= 0;
+  Handled := Skip;
+end;
+
+function TRemovedPropertyList.IndexOf(AClass: TPersistentClass;
+  APropertyName: String): Integer;
+var
+  i: integer;
+begin
+  Result := -1;
+  APropertyName := LowerCase(APropertyName);
+  for i := 0 to Count - 1 do
+    if AClass.InheritsFrom(Items[i]^.PersistentClass) and
+       (APropertyName = Items[i]^.PropertyName) then
+    begin
+      Result := i;
+      Exit;
+    end;
+end;
+
+function TRemovedPropertyList.Add(APersistentClass: TPersistentClass;
+  APropertyName, ANote, AHelpKeyWord: string): Integer;
+var
+  Item: PRemovedProperty;
+begin
+  Result := IndexOf(APersistentClass, APropertyName);
+  if Result = -1 then
+  begin
+    New(Item);
+    Item^.PersistentClass := APersistentClass;
+    Item^.PropertyName := LowerCase(APropertyName);
+    Item^.Note := ANote;
+    Item^.HelpKeyword := AHelpKeyWord;
+    Result := inherited Add(Item);
+  end;
+end;
+
 { TReaderUniqueNamer }
 
 procedure TReaderUniqueNamer.OnSetName(Reader: TReader; Component: TComponent;
@@ -2902,6 +2990,8 @@ begin
   if Assigned(LRSTranslator) then
     Result.OnReadStringProperty:=@(LRSTranslator.TranslateStringProperty);
 
+  Result.OnPropertyNotFound := @(RemovedProperties.DoPropertyNotFound);
+
   DestroyDriver:=false;
   if Result.Driver.ClassType=LRSObjectReaderClass then exit;
   // hack to set a write protected variable.
@@ -3358,6 +3448,12 @@ begin
     Result:=0;
 end;
 
+procedure RegisterRemovedProperty(PersistentClass: TPersistentClass;
+  PropertyName, Note, HelpKeyWord: string);
+begin
+  RemovedProperties.Add(PersistentClass, PropertyName, Note, HelpKeyWord);
+end;
+
 procedure Register;
 begin
   RegisterComponents('System',[TLazComponentQueue]);
@@ -5202,14 +5298,15 @@ procedure InternalInit;
 begin
   LazarusResources := TLResourceList.Create;
   RegisterInitComponentHandler(TComponent, @InitResourceComponent);
+  RemovedProperties := TRemovedPropertyList.Create;
 end;
 
 initialization
   InternalInit;
 
 finalization
-  LazarusResources.Free;
-  LazarusResources := nil;
+  FreeAndNil(LazarusResources);
+  FreeAndNil(RemovedProperties);
 
 end.