IDE: OI: searching compatible methods without using typedata, bug #18608

git-svn-id: trunk@29957 -

ide/main.pp

@@ -469,6 +469,12 @@ type
     function OnPropHookGetMethodName(const Method: TMethod;
                                      PropOwner: TObject): String;
     procedure OnPropHookGetMethods(TypeData: PTypeData; Proc:TGetStrProc);
+    procedure OnPropHookGetCompatibleMethods(InstProp: PInstProp;
+                                             const Proc:TGetStrProc);
+    function OnPropHookCompatibleMethodExists(const AMethodName: String;
+                                    InstProp: PInstProp;
+                                    var MethodIsCompatible, MethodIsPublished,
+                                    IdentIsMethod: boolean): boolean;
     function OnPropHookMethodExists(const AMethodName: String;
                                     TypeData: PTypeData;
                                     var MethodIsCompatible, MethodIsPublished,
@@ -1704,6 +1710,50 @@ begin
   end;
 end;
 
+procedure TMainIDE.OnPropHookGetCompatibleMethods(InstProp: PInstProp;
+  const Proc: TGetStrProc);
+var
+  ActiveSrcEdit: TSourceEditor;
+  ActiveUnitInfo: TUnitInfo;
+begin
+  if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,[ctfSwitchToFormSource])
+  then exit;
+  {$IFDEF IDE_DEBUG}
+  DebugLn('');
+  DebugLn('[TMainIDE.OnPropHookGetCompatibleMethods] ************');
+  {$ENDIF}
+  if not CodeToolBoss.GetCompatiblePublishedMethods(ActiveUnitInfo.Source,
+    ActiveUnitInfo.Component.ClassName,
+    InstProp^.Instance,InstProp^.PropInfo^.Name,Proc) then
+  begin
+    DoJumpToCodeToolBossError;
+  end;
+end;
+
+function TMainIDE.OnPropHookCompatibleMethodExists(const AMethodName: String;
+  InstProp: PInstProp; var MethodIsCompatible, MethodIsPublished,
+  IdentIsMethod: boolean): boolean;
+var
+  ActiveSrcEdit: TSourceEditor;
+  ActiveUnitInfo: TUnitInfo;
+begin
+  if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,[ctfSwitchToFormSource]) then
+    Exit;
+  {$IFDEF IDE_DEBUG}
+  WriteLn('');
+  WriteLn('[TMainIDE.OnPropHookCompatibleMethodExists] ************ ',AMethodName);
+  {$ENDIF}
+  Result := CodeToolBoss.PublishedMethodExists(ActiveUnitInfo.Source,
+                        ActiveUnitInfo.Component.ClassName, AMethodName,
+                        InstProp^.Instance, InstProp^.PropInfo^.Name,
+                        MethodIsCompatible, MethodIsPublished, IdentIsMethod);
+  if CodeToolBoss.ErrorMessage <> '' then
+  begin
+    DoJumpToCodeToolBossError;
+    raise Exception.Create(lisUnableToFindMethod+' '+lisPleaseFixTheErrorInTheMessageWindow);
+  end;
+end;
+
 {------------------------------------------------------------------------------}
 procedure TMainIDE.MainIDEFormClose(Sender: TObject;
   var CloseAction: TCloseAction);
@@ -1917,7 +1967,9 @@ begin
   GlobalDesignHook:=TPropertyEditorHook.Create;
   GlobalDesignHook.GetPrivateDirectory:=AppendPathDelim(GetPrimaryConfigPath);
   GlobalDesignHook.AddHandlerGetMethodName(@OnPropHookGetMethodName);
+  GlobalDesignHook.AddHandlerGetCompatibleMethods(@OnPropHookGetCompatibleMethods);
   GlobalDesignHook.AddHandlerGetMethods(@OnPropHookGetMethods);
+  GlobalDesignHook.AddHandlerCompatibleMethodExists(@OnPropHookCompatibleMethodExists);
   GlobalDesignHook.AddHandlerMethodExists(@OnPropHookMethodExists);
   GlobalDesignHook.AddHandlerCreateMethod(@OnPropHookCreateMethod);
   GlobalDesignHook.AddHandlerShowMethod(@OnPropHookShowMethod);
@@ -17103,7 +17155,6 @@ function TMainIDE.OnPropHookMethodExists(const AMethodName: String;
 var
   ActiveSrcEdit: TSourceEditor;
   ActiveUnitInfo: TUnitInfo;
-  //D: DWord;
 begin
   if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,[ctfSwitchToFormSource]) then
     Exit;
@@ -17111,12 +17162,9 @@ begin
   WriteLn('');
   WriteLn('[TMainIDE.OnPropHookMethodExists] ************ ',AMethodName);
   {$ENDIF}
-  //D := GetTickCount;
   Result := CodeToolBoss.PublishedMethodExists(ActiveUnitInfo.Source,
                         ActiveUnitInfo.Component.ClassName, AMethodName, TypeData,
                         MethodIsCompatible, MethodIsPublished, IdentIsMethod);
-  //D := GetTickCount - D;
-  //WriteLn('CodeToolBoss.PublishedMethodExists takes ', D, ' ms');
   if CodeToolBoss.ErrorMessage <> '' then
   begin
     DoJumpToCodeToolBossError;

ideintf/propedits.pp

@@ -264,6 +264,7 @@ type
     Instance:TPersistent;
     PropInfo:PPropInfo;
   end;
+  PInstProp = ^TInstProp;
 
   TInstPropList = array[0..999999] of TInstProp;
   PInstPropList = ^TInstPropList;
@@ -313,6 +314,7 @@ type
     procedure GetProperties(Proc: TGetPropEditProc); virtual;
     function GetPropType: PTypeInfo;
     function GetPropInfo: PPropInfo;
+    function GetInstProp: PInstProp;
     function GetFloatValue: Extended;
     function GetFloatValueAt(Index: Integer): Extended;
     function GetInt64Value: Int64;
@@ -1098,7 +1100,11 @@ type
       APersistent: TPersistent; const APropertyPath: string): TMethod of object;
   TPropHookGetMethodName = function(const Method: TMethod;
                                     CheckOwner: TObject): String of object;
+  TPropHookGetCompatibleMethods = procedure(InstProp: PInstProp; const Proc: TGetStrProc) of object;
   TPropHookGetMethods = procedure(TypeData: PTypeData; Proc: TGetStrProc) of object;
+  TPropHookCompatibleMethodExists = function(const Name: String; InstProp: PInstProp;
+                 var MethodIsCompatible,MethodIsPublished,IdentIsMethod: boolean
+                 ):boolean of object;
   TPropHookMethodExists = function(const Name: String; TypeData: PTypeData;
                  var MethodIsCompatible,MethodIsPublished,IdentIsMethod: boolean
                  ):boolean of object;
@@ -1145,7 +1151,9 @@ type
     // methods
     htCreateMethod,
     htGetMethodName,
+    htGetCompatibleMethods,
     htGetMethods,
+    htCompatibleMethodExists,
     htMethodExists,
     htRenameMethod,
     htShowMethod,
@@ -1203,9 +1211,12 @@ type
                           APersistent: TPersistent;
                           const APropertyPath: string): TMethod;
     function GetMethodName(const Method: TMethod; PropOwner: TObject): String;
-    procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc);
+    procedure GetMethods(TypeData: PTypeData; const Proc: TGetStrProc);
+    procedure GetCompatibleMethods(InstProp: PInstProp; const Proc: TGetStrProc);
     function MethodExists(const Name: String; TypeData: PTypeData;
       var MethodIsCompatible,MethodIsPublished,IdentIsMethod: boolean):boolean;
+    function CompatibleMethodExists(const Name: String; InstProp: PInstProp;
+      var MethodIsCompatible,MethodIsPublished,IdentIsMethod: boolean):boolean;
     procedure RenameMethod(const CurName, NewName: String);
     procedure ShowMethod(const Name: String);
     function MethodFromAncestor(const Method: TMethod):boolean;
@@ -1257,8 +1268,16 @@ type
                                  const OnGetMethodName: TPropHookGetMethodName);
     procedure RemoveHandlerGetMethodName(
                                  const OnGetMethodName: TPropHookGetMethodName);
+    procedure AddHandlerGetCompatibleMethods(
+                             const OnGetMethods: TPropHookGetCompatibleMethods);
+    procedure RemoveHandlerGetCompatibleMethods(
+                             const OnGetMethods: TPropHookGetCompatibleMethods);
     procedure AddHandlerGetMethods(const OnGetMethods: TPropHookGetMethods);
     procedure RemoveHandlerGetMethods(const OnGetMethods: TPropHookGetMethods);
+    procedure AddHandlerCompatibleMethodExists(
+                         const OnMethodExists: TPropHookCompatibleMethodExists);
+    procedure RemoveHandlerCompatibleMethodExists(
+                         const OnMethodExists: TPropHookCompatibleMethodExists);
     procedure AddHandlerMethodExists(
                                    const OnMethodExists: TPropHookMethodExists);
     procedure RemoveHandlerMethodExists(
@@ -2464,6 +2483,11 @@ begin
   Result:=FPropList^[0].PropInfo;
 end;
 
+function TPropertyEditor.GetInstProp: PInstProp;
+begin
+  Result:=@FPropList^[0];
+end;
+
 function TPropertyEditor.GetPropType:PTypeInfo;
 begin
   Result:=FPropList^[0].PropInfo^.PropType;
@@ -3942,7 +3966,7 @@ procedure TMethodPropertyEditor.GetValues(Proc: TGetStrProc);
 begin
   //DebugLn('### TMethodPropertyEditor.GetValues');
   Proc(oisNone);
-  PropertyHook.GetMethods(GetTypeData(GetPropType), Proc);
+  PropertyHook.GetCompatibleMethods(GetInstProp, Proc);
 end;
 
 procedure TMethodPropertyEditor.SetValue(const NewValue: ansistring);
@@ -3968,7 +3992,7 @@ begin
   end;
   
   NewMethodExists:=(not IsNil)
-       and PropertyHook.MethodExists(NewValue,GetTypeData(GetPropType),
+      and PropertyHook.CompatibleMethodExists(NewValue,GetInstProp,
                    NewMethodIsCompatible,NewMethodIsPublished,NewIdentIsMethod);
   //DebugLn('### TMethodPropertyEditor.SetValue B NewMethodExists=',NewMethodExists,' NewMethodIsCompatible=',NewMethodIsCompatible,' ',NewMethodIsPublished,' ',NewIdentIsMethod);
   if NewMethodExists then begin
@@ -5099,7 +5123,8 @@ begin
   end;
 end;
 
-procedure TPropertyEditorHook.GetMethods(TypeData: PTypeData; Proc: TGetStrProc);
+procedure TPropertyEditorHook.GetMethods(TypeData: PTypeData;
+  const Proc: TGetStrProc);
 var
   i: Integer;
 begin
@@ -5108,6 +5133,16 @@ begin
     TPropHookGetMethods(FHandlers[htGetMethods][i])(TypeData,Proc);
 end;
 
+procedure TPropertyEditorHook.GetCompatibleMethods(InstProp: PInstProp;
+  const Proc: TGetStrProc);
+var
+  i: Integer;
+begin
+  i:=GetHandlerCount(htGetCompatibleMethods);
+  while GetNextHandlerIndex(htGetCompatibleMethods,i) do
+    TPropHookGetCompatibleMethods(FHandlers[htGetCompatibleMethods][i])(InstProp,Proc);
+end;
+
 function TPropertyEditorHook.MethodExists(const Name: String;
   TypeData: PTypeData;
   var MethodIsCompatible, MethodIsPublished, IdentIsMethod: boolean):boolean;
@@ -5133,6 +5168,31 @@ begin
   end;
 end;
 
+function TPropertyEditorHook.CompatibleMethodExists(const Name: String;
+  InstProp: PInstProp; var MethodIsCompatible, MethodIsPublished,
+  IdentIsMethod: boolean): boolean;
+var
+  i: Integer;
+  Handler: TPropHookCompatibleMethodExists;
+begin
+  // check if a published method with given name exists in LookupRoot
+  Result:=IsValidIdent(Name) and Assigned(FLookupRoot);
+  if not Result then exit;
+  i:=GetHandlerCount(htCompatibleMethodExists);
+  if i>=0 then begin
+    while GetNextHandlerIndex(htCompatibleMethodExists,i) do begin
+      Handler:=TPropHookCompatibleMethodExists(FHandlers[htCompatibleMethodExists][i]);
+      Result:=Handler(Name,InstProp,
+                            MethodIsCompatible,MethodIsPublished,IdentIsMethod);
+    end;
+  end else begin
+    Result:=(LookupRoot.MethodAddress(Name)<>nil);
+    MethodIsCompatible:=Result;
+    MethodIsPublished:=Result;
+    IdentIsMethod:=Result;
+  end;
+end;
+
 procedure TPropertyEditorHook.RenameMethod(const CurName, NewName: String);
 // rename published method in LookupRoot object and source
 var
@@ -5588,6 +5648,30 @@ begin
   RemoveHandler(htGetMethods,TMethod(OnGetMethods));
 end;
 
+procedure TPropertyEditorHook.AddHandlerCompatibleMethodExists(
+  const OnMethodExists: TPropHookCompatibleMethodExists);
+begin
+  AddHandler(htCompatibleMethodExists,TMethod(OnMethodExists));
+end;
+
+procedure TPropertyEditorHook.RemoveHandlerCompatibleMethodExists(
+  const OnMethodExists: TPropHookCompatibleMethodExists);
+begin
+  RemoveHandler(htCompatibleMethodExists,TMethod(OnMethodExists));
+end;
+
+procedure TPropertyEditorHook.AddHandlerGetCompatibleMethods(
+  const OnGetMethods: TPropHookGetCompatibleMethods);
+begin
+  AddHandler(htGetCompatibleMethods,TMethod(OnGetMethods));
+end;
+
+procedure TPropertyEditorHook.RemoveHandlerGetCompatibleMethods(
+  const OnGetMethods: TPropHookGetCompatibleMethods);
+begin
+  RemoveHandler(htGetCompatibleMethods,TMethod(OnGetMethods));
+end;
+
 procedure TPropertyEditorHook.AddHandlerMethodExists(
   const OnMethodExists: TPropHookMethodExists);
 begin