paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-19 22:29:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

replaced calls to MethodName with hooks

Browse Source 
git-svn-id: trunk@11036 -
This commit is contained in:
mattias 2007-04-29 22:18:42 +00:00
parent c593d02c01
commit a6d2e13791
9 changed files with 85 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
components/codetools/codetoolmanager.pas
View File

@ -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;

2
components/codetools/eventcodetool.pas
View File

@ -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)

7
components/codetools/finddeclarationtool.pas
View File

@ -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;

2
components/codetools/pascalparsertool.pas
View File

@ -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;

2
components/codetools/stdcodetools.pas
View File

@ -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

6
components/turbopower_ipro/ipstrms.pas
View File

@ -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;
{-----------------------------------------------------------------------------}

4
ide/checklfmdlg.pas
View File

@ -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);

26
ide/main.pp
View File

@ -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;

40
ideintf/propedits.pp
View File

@ -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:='<Unpublished>';
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
@ -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)<>'');