replaced calls to MethodName with hooks

git-svn-id: trunk@11036 -

components/codetools/codetoolmanager.pas

@@ -92,6 +92,7 @@ type
     FOnGatherExternalChanges: TOnGatherExternalChanges;
     FOnFindDefinePropertyForContext: TOnFindDefinePropertyForContext;
     FOnFindDefineProperty: TOnFindDefineProperty;
+    FOnGetMethodName: TOnGetMethodname;
     FOnSearchUsedUnit: TOnSearchUsedUnit;
     FResourceTool: TResourceCodeTool;
     FSetPropertyVariablename: string;
@@ -111,6 +112,8 @@ type
           TheUnitInFilename: string): TCodeBuffer;
     function DoOnGetSrcPathForCompiledUnit(Sender: TObject;
           const AFilename: string): string;
+    function OnInternalGetMethodName(const AMethod: TMethod;
+                                     CheckOwner: TObject): shortstring;
     function FindCodeOfMainUnitHint(Code: TCodeBuffer): TCodeBuffer;
     procedure CreateScanner(Code: TCodeBuffer);
     procedure SetAbortable(const AValue: boolean);
@@ -264,6 +267,10 @@ type
     procedure GetFPCVersionForDirectory(const Directory: string;
                                  out FPCVersion, FPCRelease, FPCPatch: integer);
 
+    // miscellaneous
+    property OnGetMethodName: TOnGetMethodname read FOnGetMethodName
+                                               write FOnGetMethodName;
+
     // data function
     procedure FreeListOfPCodeXYPosition(var List: TFPList);
     procedure FreeTreeOfPCodeXYPosition(var Tree: TAVLTree);
@@ -3668,6 +3675,19 @@ begin
     Result:=GetCompiledSrcPathForDirectory(ExtractFilePath(AFilename));
 end;
 
+function TCodeToolManager.OnInternalGetMethodName(const AMethod: TMethod;
+  CheckOwner: TObject): shortstring;
+begin
+  if Assigned(OnGetMethodName) then
+    Result:=OnGetMethodName(AMethod,CheckOwner)
+  else if (AMethod.Data=nil) or (AMethod.Code=nil) then
+    Result:=''
+  else if (CheckOwner<>nil) and (TObject(AMethod.Data)<>CheckOwner) then
+    Result:=''
+  else
+    Result:=TObject(AMethod.Data).MethodName(AMethod.Code);
+end;
+
 function TCodeToolManager.OnParserProgress(Tool: TCustomCodeTool): boolean;
 begin
   Result:=true;
@@ -3857,6 +3877,7 @@ begin
   TCodeTool(Result).OnGetDirectoryCache:=@OnGetDirectoryCache;
   TCodeTool(Result).OnFindUsedUnit:=@DoOnFindUsedUnit;
   TCodeTool(Result).OnGetSrcPathForCompiledUnit:=@DoOnGetSrcPathForCompiledUnit;
+  TCodeTool(Result).OnGetMethodName:=@OnInternalGetMethodName;
   Result.OnSetGlobalWriteLock:=@OnToolSetWriteLock;
   Result.OnGetGlobalWriteLockInfo:=@OnToolGetWriteLockInfo;
   TCodeTool(Result).OnParserProgress:=@OnParserProgress;

components/codetools/eventcodetool.pas

@@ -348,7 +348,7 @@ begin
   if SectionNode=nil then exit;
   ANode:=SectionNode.FirstChild;
   {$IFDEF CTDEBUG}
-  DebugLn('[TEventsCodeTool.FindMethodNodeInImplementation] A MethodName=',UpperClassName,'.',UpperMethodName);
+  DebugLn('[TEventsCodeTool.FindMethodNodeInImplementation] A UpperMethodName=',UpperClassName,'.',UpperMethodName);
   {$ENDIF}
   while (ANode<>nil) do begin
     if (ANode.Desc=ctnProcedure) and (ANode.FirstChild<>nil)

components/codetools/finddeclarationtool.pas

@@ -134,6 +134,10 @@ type
   TOnGetSrcPathForCompiledUnit =
     function(Sender: TObject; const Filename: string): string of object;
 
+  //----------------------------------------------------------------------------
+  TOnGetMethodname = function(const AMethod: TMethod;
+                              CheckOwner: TObject): shortstring of object;
+
   //----------------------------------------------------------------------------
   // flags/states for searching
   TFindDeclarationFlag = (
@@ -514,6 +518,7 @@ type
     FOnFindUsedUnit: TOnFindUsedUnit;
     FOnGetCodeToolForBuffer: TOnGetCodeToolForBuffer;
     FOnGetDirectoryCache: TOnGetDirectoryCache;
+    FOnGetMethodName: TOnGetMethodname;
     FOnGetSrcPathForCompiledUnit: TOnGetSrcPathForCompiledUnit;
     FOnGetUnitSourceSearchPath: TOnGetSearchPath;
     FFirstNodeCache: TCodeTreeNodeCache;
@@ -739,6 +744,8 @@ type
                                                      write FOnGetDirectoryCache;
     property OnGetSrcPathForCompiledUnit: TOnGetSrcPathForCompiledUnit
            read FOnGetSrcPathForCompiledUnit write fOnGetSrcPathForCompiledUnit;
+    property OnGetMethodName: TOnGetMethodname read FOnGetMethodName
+                                               write FOnGetMethodName;
     property AdjustTopLineDueToComment: boolean
                read FAdjustTopLineDueToComment write FAdjustTopLineDueToComment;
     property DirectoryCache: TCTDirectoryCache read FDirectoryCache;

components/codetools/pascalparsertool.pas

@@ -980,7 +980,7 @@ begin
     if IsFunction then Include(ParseAttr,pphIsFunction);
     ReadTilProcedureHeadEnd(ParseAttr,HasForwardModifier);
   end else begin
-    // Method resolution clause (e.g. function Intf.Method = MethodName)
+    // Method resolution clause (e.g. function Intf.Method = Method_Name)
     CurNode.Parent.Desc:=ctnMethodMap;
     // read Method name of interface
     ReadNextAtom;

components/codetools/stdcodetools.pas

@@ -4245,7 +4245,7 @@ var
           // RTTI property is method
           // -> search method in source
           CurMethod:=GetMethodProp(AComponent,PropInfo);
-          CurMethodName:=RootComponent.MethodName(CurMethod.Code);
+          CurMethodName:=OnGetMethodName(CurMethod,RootComponent);
           if CurMethodName<>'' then begin
             NodeExt:=FindCodeTreeNodeExt(PublishedMethods,CurMethodName);
             if NodeExt=nil then begin

components/turbopower_ipro/ipstrms.pas

@@ -86,7 +86,7 @@ type
       { Current position in the file. }
 
     { Verification methods }
-    procedure CheckClosed(const MethodName : string);
+    procedure CheckClosed(const aMethodName : string);
     procedure CheckFileName;
 
     procedure CloseFile;
@@ -330,10 +330,10 @@ end;
 
 {-----------------------------------------------------------------------------}
 
-procedure TIpMemMapStream.CheckClosed(const MethodName : string);
+procedure TIpMemMapStream.CheckClosed(const aMethodName : string);
 begin
   if mmFileHandle <> 0 then
-    raise EIpBaseException.CreateFmt(SMemMapMustBeClosed, [MethodName]);
+    raise EIpBaseException.CreateFmt(SMemMapMustBeClosed, [aMethodName]);
 end;
 
 {-----------------------------------------------------------------------------}

ide/checklfmdlg.pas

@@ -39,7 +39,7 @@ uses
   SynHighlighterLFM, SynEdit, BasicCodeTools, CodeCache, CodeToolManager,
   LFMTrees,
   // IDE
-  ComponentReg, PackageIntf, IDEWindowIntf,
+  PropEdits, ComponentReg, PackageIntf, IDEWindowIntf,
   LazarusIDEStrConsts, OutputFilter, IDEProcs, IDEOptionDefs, EditorOptions;
 
 type
@@ -351,7 +351,7 @@ begin
       p:=PInstancePropInfo(ListOfPInstancePropInfo[i]);
       PropName:=p^.PropInfo^.Name;
       CurMethod:=GetMethodProp(p^.Instance,p^.PropInfo);
-      CurMethodName:=RootComponent.MethodName(CurMethod.Code);
+      CurMethodName:=GlobalDesignHook.GetMethodName(CurMethod,nil);
       s:=s+DbgSName(p^.Instance)+' '+PropName+'='+CurMethodName+#13;
     end;
     //debugln('RemoveDanglingEvents ',s);

ide/main.pp

@@ -378,6 +378,8 @@ type
     procedure OIOnAddToFavourites(Sender: TObject);
     procedure OIOnRemoveFromFavourites(Sender: TObject);
     procedure OIOnFindDeclarationOfProperty(Sender: TObject);
+    function OnPropHookGetMethodName(const Method: TMethod;
+                                     CheckOwner: TObject): ShortString;
     procedure OnPropHookGetMethods(TypeData: PTypeData; Proc:TGetStringProc);
     function OnPropHookMethodExists(const AMethodName: ShortString;
                                     TypeData: PTypeData;
@@ -1274,6 +1276,24 @@ begin
   end;
 end;
 
+function TMainIDE.OnPropHookGetMethodName(const Method: TMethod;
+  CheckOwner: TObject): ShortString;
+begin
+  if Assigned(Method.Code) then begin
+    if Method.Data<>nil then begin
+      if (CheckOwner<>nil) and (TObject(Method.Data)<>CheckOwner) then
+        Result:=''
+      else begin
+        Result:=TObject(Method.Data).MethodName(Method.Code);
+        if Result='' then
+          Result:='<Unpublished>';
+      end;
+    end else
+      Result:='<No LookupRoot>';
+  end else
+    Result:='';
+end;
+
 procedure TMainIDE.OnPropHookGetMethods(TypeData:PTypeData;
   Proc:TGetStringProc);
 var ActiveSrcEdit: TSourceEditor;
@@ -1503,6 +1523,7 @@ begin
 
   GlobalDesignHook:=TPropertyEditorHook.Create;
   GlobalDesignHook.GetPrivateDirectory:=AppendPathDelim(GetPrimaryConfigPath);
+  GlobalDesignHook.AddHandlerGetMethodName(@OnPropHookGetMethodName);
   GlobalDesignHook.AddHandlerGetMethods(@OnPropHookGetMethods);
   GlobalDesignHook.AddHandlerMethodExists(@OnPropHookMethodExists);
   GlobalDesignHook.AddHandlerCreateMethod(@OnPropHookCreateMethod);
@@ -10512,6 +10533,7 @@ begin
     OnAfterApplyChanges:=@OnAfterCodeToolBossApplyChanges;
     OnSearchUsedUnit:=@OnCodeToolBossSearchUsedUnit;
     OnFindDefineProperty:=@OnCodeToolBossFindDefineProperty;
+    OnGetMethodName:=@OnPropHookGetMethodName;
   end;
 
   CodeToolsOpts.AssignGlobalDefineTemplatesToTree(CodeToolBoss.DefineTree);
@@ -11844,7 +11866,9 @@ var
         PropInfo:=PropList^[i];
         if PropInfo^.PropType^.Kind<>tkMethod then continue;
         CurMethod:=GetMethodProp(AComponent,PropInfo);
-        CurMethodName:=Root.MethodName(CurMethod.Code);
+        if (CurMethod.Data=nil) and (CurMethod.Code=nil) then continue;
+        CurMethodName:=GlobalDesignHook.GetMethodName(CurMethod,Root);
+        if CurMethodName='' then continue;
         DefaultName:=TMethodPropertyEditor.GetDefaultMethodName(
                           Root,AComponent,RootClassName,OldName,PropInfo^.Name);
         if (DefaultName<>CurMethodName) then continue;

ideintf/propedits.pp

@@ -1102,14 +1102,15 @@ type
   // methods
   TPropHookCreateMethod = function(const Name:ShortString;
     ATypeInfo:PTypeInfo; const ATypeUnitName: string): TMethod of object;
-  TPropHookGetMethodName = function(const Method:TMethod): ShortString of object;
+  TPropHookGetMethodName = function(const Method: TMethod;
+                                    CheckOwner: TObject): ShortString of object;
   TPropHookGetMethods = procedure(TypeData:PTypeData; Proc:TGetStringProc) of object;
   TPropHookMethodExists = function(const Name:ShortString; TypeData: PTypeData;
     var MethodIsCompatible,MethodIsPublished,IdentIsMethod: boolean):boolean of object;
   TPropHookRenameMethod = procedure(const CurName, NewName:ShortString) of object;
   TPropHookShowMethod = procedure(const Name:ShortString) of object;
   TPropHookMethodFromAncestor = function(const Method:TMethod):boolean of object;
-  TPropHookChainCall = procedure(const MethodName, InstanceName,
+  TPropHookChainCall = procedure(const AMethodName, InstanceName,
     InstanceMethod:ShortString; TypeData:PTypeData) of object;
   // components
   TPropHookGetComponent = function(const Name:ShortString):TComponent of object;
@@ -1202,7 +1203,7 @@ type
     // methods
     function CreateMethod(const Name:ShortString; ATypeInfo:PTypeInfo;
                           const ATypeUnitName: string): TMethod;
-    function GetMethodName(const Method:TMethod): ShortString;
+    function GetMethodName(const Method: TMethod; CheckOwner: TObject): ShortString;
     procedure GetMethods(TypeData:PTypeData; Proc:TGetStringProc);
     function MethodExists(const Name:ShortString; TypeData: PTypeData;
       var MethodIsCompatible,MethodIsPublished,IdentIsMethod: boolean):boolean;
@@ -3714,14 +3715,16 @@ end;
 function TMethodPropertyEditor.AllEqual: Boolean;
 var
   I: Integer;
-  V, T: TMethod;
+  CurFirstValue, AnotherValue: TMethod;
 begin
   Result := False;
   if PropCount > 1 then begin
-    V := GetMethodValue;
+    CurFirstValue := GetMethodValue;
     for I := 1 to PropCount - 1 do begin
-      T := GetMethodValueAt(I);
+      AnotherValue := GetMethodValueAt(I);
-      if (T.Code <> V.Code) or (T.Data <> V.Data) then Exit;
+      if (AnotherValue.Code <> CurFirstValue.Code)
+      or (AnotherValue.Data <> CurFirstValue.Data) then
+        Exit;
     end;
   end;
   Result := True;
@@ -3837,7 +3840,7 @@ end;
 
 function TMethodPropertyEditor.GetValue: ansistring;
 begin
-  Result:=PropertyHook.GetMethodName(GetMethodValue);
+  Result:=PropertyHook.GetMethodName(GetMethodValue,nil);
 end;
 
 procedure TMethodPropertyEditor.GetValues(Proc: TGetStringProc);
@@ -5051,25 +5054,30 @@ begin
     while GetNextHandlerIndex(htCreateMethod,i) do begin
       Handler:=TPropHookCreateMethod(FHandlers[htCreateMethod][i]);
       Result:=Handler(Name,ATypeInfo,ATypeUnitName);
-      if Result.Code<>nil then exit;
+      if (Result.Data<>nil) or (Result.Code<>nil) then exit;
     end;
   end;
 end;
 
-function TPropertyEditorHook.GetMethodName(const Method:TMethod): ShortString;
+function TPropertyEditorHook.GetMethodName(const Method: TMethod;
+  CheckOwner: TObject): ShortString;
 var
   i: Integer;
 begin
   i:=GetHandlerCount(htGetMethodName);
   if GetNextHandlerIndex(htGetMethodName,i) then begin
-    Result:=TPropHookGetMethodName(FHandlers[htGetMethodName][i])(Method);
+    Result:=TPropHookGetMethodName(FHandlers[htGetMethodName][i])(Method,CheckOwner);
   end else begin
     // search the method name with the given code pointer
     if Assigned(Method.Code) then begin
-      if Assigned(LookupRoot) then begin
+      if Method.Data<>nil then begin
-        Result:=LookupRoot.MethodName(Method.Code);
+        if (CheckOwner<>nil) and (TObject(Method.Data)<>CheckOwner) then
+          Result:=''
+        else begin
+          Result:=TObject(Method.Data).MethodName(Method.Code);
           if Result='' then
             Result:='<Unpublished>';
+        end;
       end else
         Result:='<No LookupRoot>';
     end else
@@ -5144,7 +5152,7 @@ begin
     Handler:=TPropHookMethodFromAncestor(FHandlers[htMethodFromAncestor][i]);
     Result:=Handler(Method);
   end else begin
-    if (Method.Data<>nil) then begin
+    if (Method.Data<>nil) and (Method.Code<>nil) then begin
       AncestorClass:=TObject(Method.Data).ClassParent;
       Result:=(AncestorClass<>nil)
               and (AncestorClass.MethodName(Method.Code)<>'');