[fpc-devel] TWriter writing fake methods

[Mattias Gaertner]

Here is a patch to extend TWriter.OnWriteMethodProperty. Formerly it
gives only the ancestor code address, not the method data.
And it misses the property path, which is needed to write sub properties
like Font.OnChange.

With this patch lazarus can get rid of the dirty hack to create
methods.


Mattias

Index: rtl/objpas/classes/writer.inc
===================================================================
--- rtl/objpas/classes/writer.inc	(revision 7172)
+++ rtl/objpas/classes/writer.inc	(working copy)
@@ -625,7 +625,7 @@
   IntToIdentFn: TIntToIdent;
   FloatValue, DefFloatValue: Extended;
   MethodValue: TMethod;
-  DefMethodCodeValue: Pointer;
+  DefMethodValue: TMethod;
   WStrValue, WDefStrValue: WideString;
   StrValue, DefStrValue: String;
   AncestorObj: TObject;
@@ -710,16 +710,18 @@
       begin
         MethodValue := GetMethodProp(Instance, PropInfo);
         if HasAncestor then
-          DefMethodCodeValue := GetMethodProp(Ancestor, PropInfo).Code
-        else
-          DefMethodCodeValue := nil;
+          DefMethodValue := GetMethodProp(Ancestor, PropInfo)
+        else begin
+          DefMethodValue.Data := nil;
+          DefMethodValue.Code := nil;
+        end;
 
         Handled:=false;
         if Assigned(OnWriteMethodProperty) then
           OnWriteMethodProperty(Self,Instance,PPropInfo(PropInfo),MethodValue,
-            DefMethodCodeValue,Handled);
+            DefMethodValue,Handled);
         if (not Handled) and
-          (MethodValue.Code <> DefMethodCodeValue) and
+          (MethodValue.Code <> DefMethodValue.Code) and
           ((not Assigned(MethodValue.Code)) or
           ((Length(FLookupRoot.MethodName(MethodValue.Code)) >= 0))) then
         begin
Index: rtl/objpas/classes/classesh.inc
===================================================================
--- rtl/objpas/classes/classesh.inc	(revision 7172)
+++ rtl/objpas/classes/classesh.inc	(working copy)
@@ -1172,8 +1172,9 @@
   TFindAncestorEvent = procedure (Writer: TWriter; Component: TComponent;
     const Name: string; var Ancestor, RootAncestor: TComponent) of object;
   TWriteMethodPropertyEvent = procedure (Writer: TWriter; Instance: TPersistent;
-    PropInfo: PPropInfo; const MethodValue: TMethod;
-    const DefMethodCodeValue: Pointer; var Handled: boolean) of object;
+    PropInfo: PPropInfo;
+    const MethodValue, DefMethodValue: TMethod;
+    var Handled: boolean) of object;
 
   TWriter = class(TFiler)
   private
@@ -1232,6 +1233,7 @@
     property OnWriteStringProperty: TReadWriteStringPropertyEvent read FOnWriteStringProperty write FOnWriteStringProperty;
 
     property Driver: TAbstractObjectWriter read FDriver;
+    property PropertyPath: string read FPropPath;
   end;
 
 

_______________________________________________
fpc-devel maillist  -  fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel