From a6d2e137914b99771d0958c1259d6f8d8bab0b5c Mon Sep 17 00:00:00 2001 From: mattias Date: Sun, 29 Apr 2007 22:18:42 +0000 Subject: [PATCH] replaced calls to MethodName with hooks git-svn-id: trunk@11036 - --- components/codetools/codetoolmanager.pas | 21 ++++++++++ components/codetools/eventcodetool.pas | 2 +- components/codetools/finddeclarationtool.pas | 7 ++++ components/codetools/pascalparsertool.pas | 2 +- components/codetools/stdcodetools.pas | 2 +- components/turbopower_ipro/ipstrms.pas | 6 +-- ide/checklfmdlg.pas | 4 +- ide/main.pp | 26 ++++++++++++- ideintf/propedits.pp | 40 ++++++++++++-------- 9 files changed, 85 insertions(+), 25 deletions(-) diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 34414fdcc6..2438e0ad4d 100644 --- a/components/codetools/codetoolmanager.pas +++ b/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; diff --git a/components/codetools/eventcodetool.pas b/components/codetools/eventcodetool.pas index 0dafa7ba40..6468a7d5d8 100644 --- a/components/codetools/eventcodetool.pas +++ b/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) diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 349515fb6c..4cc3747d18 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/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; diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index 698d0081ae..4a0a394936 100644 --- a/components/codetools/pascalparsertool.pas +++ b/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; diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index 5dcea830a5..088254547f 100644 --- a/components/codetools/stdcodetools.pas +++ b/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 diff --git a/components/turbopower_ipro/ipstrms.pas b/components/turbopower_ipro/ipstrms.pas index c01d9c1ca1..2d4bf69f12 100644 --- a/components/turbopower_ipro/ipstrms.pas +++ b/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; {-----------------------------------------------------------------------------} diff --git a/ide/checklfmdlg.pas b/ide/checklfmdlg.pas index 4aaf34e194..78e6ac1c41 100644 --- a/ide/checklfmdlg.pas +++ b/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); diff --git a/ide/main.pp b/ide/main.pp index 65eb2e3883..fbd2b6c60e 100644 --- a/ide/main.pp +++ b/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:=''; + end; + end else + Result:=''; + 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; diff --git a/ideintf/propedits.pp b/ideintf/propedits.pp index 552e1d3514..c63989b115 100644 --- a/ideintf/propedits.pp +++ b/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); - if (T.Code <> V.Code) or (T.Data <> V.Data) then Exit; + AnotherValue := GetMethodValueAt(I); + 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 - Result:=LookupRoot.MethodName(Method.Code); - if Result='' then - Result:=''; + 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:=''; + end; end else Result:=''; 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)<>'');