From df1fa8669a26a3e2fa99b7c4af7bea37c2ead5df Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 16 Aug 2003 15:50:47 +0000 Subject: [PATCH] + Fix from Mattias gaertner for IDE support --- fcl/inc/classesh.inc | 22 ++++++++++++++++-- fcl/inc/reader.inc | 54 ++++++++++++++++++++++++++++++++++++++------ fcl/inc/writer.inc | 13 +++++++++-- 3 files changed, 78 insertions(+), 11 deletions(-) diff --git a/fcl/inc/classesh.inc b/fcl/inc/classesh.inc index fa9ea9845b..f212071ec1 100644 --- a/fcl/inc/classesh.inc +++ b/fcl/inc/classesh.inc @@ -815,13 +815,19 @@ type TFindMethodEvent = procedure(Reader: TReader; const MethodName: string; var Address: Pointer; var Error: Boolean) of object; + TSetMethodPropertyEvent = procedure(Reader: TReader; Instance: TPersistent; + PropInfo: PPropInfo; const TheMethodName: string; + var Handled: boolean) of object; TSetNameEvent = procedure(Reader: TReader; Component: TComponent; var Name: string) of object; TReferenceNameEvent = procedure(Reader: TReader; var Name: string) of object; TAncestorNotFoundEvent = procedure(Reader: TReader; const ComponentName: string; ComponentClass: TPersistentClass; var Component: TComponent) of object; TReadComponentsProc = procedure(Component: TComponent) of object; - TReaderError = procedure(Reader: TReader; const Message: string; var Handled: Boolean) of object; + TReaderError = procedure(Reader: TReader; const Message: string; + var Handled: Boolean) of object; + TPropertyNotFoundEvent = procedure(Reader: TReader; Instance: TPersistent; + var PropName: string; IsPath: boolean; var Handled, Skip: Boolean) of object; TFindComponentClassEvent = procedure(Reader: TReader; const ClassName: string; var ComponentClass: TComponentClass) of object; TCreateComponentEvent = procedure(Reader: TReader; @@ -835,10 +841,12 @@ type FFixups: TList; FLoaded: TList; FOnFindMethod: TFindMethodEvent; + FOnSetMethodProperty: TSetMethodPropertyEvent; FOnSetName: TSetNameEvent; FOnReferenceName: TReferenceNameEvent; FOnAncestorNotFound: TAncestorNotFoundEvent; FOnError: TReaderError; + FOnPropertyNotFound: TPropertyNotFoundEvent; FOnFindComponentClass: TFindComponentClassEvent; FOnCreateComponent: TCreateComponentEvent; FPropName: string; @@ -894,7 +902,9 @@ type property Owner: TComponent read FOwner write FOwner; property Parent: TComponent read FParent write FParent; property OnError: TReaderError read FOnError write FOnError; + property OnPropertyNotFound: TPropertyNotFoundEvent read FOnPropertyNotFound write FOnPropertyNotFound; property OnFindMethod: TFindMethodEvent read FOnFindMethod write FOnFindMethod; + property OnSetMethodProperty: TSetMethodPropertyEvent read FOnSetMethodProperty write FOnSetMethodProperty; property OnSetName: TSetNameEvent read FOnSetName write FOnSetName; property OnReferenceName: TReferenceNameEvent read FOnReferenceName write FOnReferenceName; property OnAncestorNotFound: TAncestorNotFoundEvent read FOnAncestorNotFound write FOnAncestorNotFound; @@ -976,6 +986,9 @@ type 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; TWriter = class(TFiler) private @@ -987,6 +1000,7 @@ type FAncestorPos: Integer; FChildPos: Integer; FOnFindAncestor: TFindAncestorEvent; + FOnWriteMethodProperty: TWriteMethodPropertyEvent; procedure AddToAncestorList(Component: TComponent); procedure WriteComponentData(Instance: TComponent); protected @@ -1023,6 +1037,7 @@ type {!!!: procedure WriteWideString(const Value: WideString);} property RootAncestor: TComponent read FRootAncestor write FRootAncestor; property OnFindAncestor: TFindAncestorEvent read FOnFindAncestor write FOnFindAncestor; + property OnWriteMethodProperty: TWriteMethodPropertyEvent read FOnWriteMethodProperty write FOnWriteMethodProperty; property Driver: TAbstractObjectWriter read FDriver; end; @@ -1504,7 +1519,10 @@ function LineStart(Buffer, BufPos: PChar): PChar; { $Log$ - Revision 1.24 2003-06-04 15:27:24 michael + Revision 1.25 2003-08-16 15:50:47 michael + + Fix from Mattias gaertner for IDE support + + Revision 1.24 2003/06/04 15:27:24 michael + TDataModule en InitInheritedComponent erbij voor Delphi 6 compatibility Revision 1.23 2002/10/14 19:46:50 peter diff --git a/fcl/inc/reader.inc b/fcl/inc/reader.inc index 40ae86c02a..88d80786ff 100644 --- a/fcl/inc/reader.inc +++ b/fcl/inc/reader.inc @@ -911,6 +911,30 @@ var PropInfo: PPropInfo; Obj: TObject; Name: String; + Skip: Boolean; + Handled: Boolean; + OldPropName: String; + + function HandleMissingProperty(IsPath: Boolean): boolean; + begin + Result:=true; + if Assigned(OnPropertyNotFound) then begin + // user defined property error handling + OldPropName:=FPropName; + Handled:=false; + Skip:=false; + OnPropertyNotFound(Self,Instance,FPropName,IsPath,Handled,Skip); + if Handled and (not Skip) and (OldPropName<>FPropName) then + // try alias property + PropInfo := GetPropInfo(Instance.ClassInfo, FPropName); + if Skip then begin + FDriver.SkipValue; + Result:=false; + exit; + end; + end; + end; + begin try Path := FDriver.BeginProperty; @@ -931,8 +955,11 @@ begin DotPos := NextPos + 1; PropInfo := GetPropInfo(Instance.ClassInfo, FPropName); - if not Assigned(PropInfo) then - PropertyError; + if not Assigned(PropInfo) then begin + if not HandleMissingProperty(true) then exit; + if not Assigned(PropInfo) then + PropertyError; + end; if PropInfo^.PropType^.Kind = tkClass then Obj := TObject(GetOrdProp(Instance, PropInfo)) @@ -949,6 +976,8 @@ begin end; PropInfo := GetPropInfo(Instance.ClassInfo, FPropName); + if not Assigned(PropInfo) then + if not HandleMissingProperty(false) then exit; if Assigned(PropInfo) then ReadPropValue(Instance, PropInfo) else @@ -987,6 +1016,7 @@ var IdentToIntFn: TIdentToInt; Ident: String; Method: TMethod; + Handled: Boolean; begin if not Assigned(PPropInfo(PropInfo)^.SetProc) then raise EReadError.Create(SReadOnlyProperty); @@ -1030,10 +1060,17 @@ begin SetMethodProp(Instance, PropInfo, NullMethod); end else begin - Method.Code := FindMethod(Root, ReadIdent); - Method.Data := Root; - if Assigned(Method.Code) then - SetMethodProp(Instance, PropInfo, Method); + Handled:=false; + Ident:=ReadIdent; + if Assigned(OnSetMethodProperty) then + OnSetMethodProperty(Self,Instance,PPropInfo(PropInfo),Ident, + Handled); + if not Handled then begin + Method.Code := FindMethod(Root, Ident); + Method.Data := Root; + if Assigned(Method.Code) then + SetMethodProp(Instance, PropInfo, Method); + end; end; tkSString, tkLString, tkAString, tkWString: SetStrProp(Instance, PropInfo, ReadString); @@ -1268,7 +1305,10 @@ end; { $Log$ - Revision 1.7 2002-12-02 12:04:07 sg + Revision 1.8 2003-08-16 15:50:47 michael + + Fix from Mattias gaertner for IDE support + + Revision 1.7 2002/12/02 12:04:07 sg * Fixed handling of zero-length strings (classes.inc: When converting empty strings from text forms to binary forms; reader.inc: When reading an empty string from a binary serialization) diff --git a/fcl/inc/writer.inc b/fcl/inc/writer.inc index 70578905fa..6a108fd056 100644 --- a/fcl/inc/writer.inc +++ b/fcl/inc/writer.inc @@ -599,6 +599,7 @@ var SavedPropPath, Name: String; Int64Value, DefInt64Value: Int64; BoolValue, DefBoolValue: boolean; + Handled: Boolean; begin @@ -667,7 +668,12 @@ begin else DefMethodCodeValue := nil; - if (MethodValue.Code <> DefMethodCodeValue) and + Handled:=false; + if Assigned(OnWriteMethodProperty) then + OnWriteMethodProperty(Self,Instance,PPropInfo(PropInfo),MethodValue, + DefMethodCodeValue,Handled); + if (not Handled) and + (MethodValue.Code <> DefMethodCodeValue) and ((not Assigned(MethodValue.Code)) or ((Length(FLookupRoot.MethodName(MethodValue.Code)) >= 0))) then begin @@ -826,7 +832,10 @@ end;} { $Log$ - Revision 1.7 2002-09-20 09:28:11 michael + Revision 1.8 2003-08-16 15:50:47 michael + + Fix from Mattias gaertner for IDE support + + Revision 1.7 2002/09/20 09:28:11 michael Fix from mattias gaertner Revision 1.6 2002/09/07 15:15:26 peter