paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-05 07:58:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

Partly revert r52070 #66bc82cf72. Caused side-effects when creating new event handlers. Issue #25954.

Browse Source 
git-svn-id: trunk@52089 -
This commit is contained in:
juha 2016-03-30 17:57:15 +00:00
parent b347db1483
commit 8423094db4
2 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
components/ideintf/propedits.pp
View File

@ -1169,7 +1169,8 @@ type
// methods
TPropHookCreateMethod = function(const Name: ShortString; ATypeInfo: PTypeInfo;
APersistent: TPersistent; const APropertyPath: string): TMethod of object;
TPropHookGetMethodName = function(const Method: TMethod; CheckOwner: TObject): String of object;
TPropHookGetMethodName = function(const Method: TMethod; CheckOwner: TObject;
OrigLookupRoot: TPersistent): 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;
@ -5619,7 +5620,7 @@ var
begin
i:=GetHandlerCount(htGetMethodName);
if GetNextHandlerIndex(htGetMethodName,i) then begin
Result:=TPropHookGetMethodName(FHandlers[htGetMethodName][i])(Method,PropOwner);
Result:=TPropHookGetMethodName(FHandlers[htGetMethodName][i])(Method,PropOwner,LookupRoot);
end else begin
// search the method name with the given code pointer
if Assigned(Method.Code) then begin

20
ide/main.pp
View File

@ -506,7 +506,8 @@ type
function OIOnPropertyHint(Sender: TObject; PointedRow: TOIPropertyGridRow;
out AHint: string): boolean;
procedure OIOnUpdateRestricted(Sender: TObject);
function OnPropHookGetMethodName(const Method: TMethod; PropOwner: TObject): String;
function OnPropHookGetMethodName(const Method: TMethod; PropOwner: TObject;
OrigLookupRoot: TPersistent): String;
procedure OnPropHookGetMethods(TypeData: PTypeData; Proc:TGetStrProc);
procedure OnPropHookGetCompatibleMethods(InstProp: PInstProp;
const Proc:TGetStrProc);
@ -1831,11 +1832,13 @@ begin
(Sender as TObjectInspectorDlg).RestrictedProps := GetRestrictedProperties;
end;
function TMainIDE.OnPropHookGetMethodName(const Method: TMethod; PropOwner: TObject): String;
function TMainIDE.OnPropHookGetMethodName(const Method: TMethod; PropOwner: TObject;
OrigLookupRoot: TPersistent): String;
// OrigLookupRoot can be different from the PropOwner's LookupRoot when we refer
// to an object (eg. TAction) in another form / unit.
var
JITMethod: TJITMethod;
LookupRoot: TPersistent;
begin
if Method.Code<>nil then begin
if Method.Data<>nil then begin
@ -1848,10 +1851,15 @@ begin
else if IsJITMethod(Method) then begin
JITMethod:=TJITMethod(Method.Data);
Result:=JITMethod.TheMethodName;
if (PropOwner is TComponent)
and (GetLookupRootForComponent(TComponent(PropOwner)) is TComponent)
then
Result:=JITMethod.TheClass.ClassName+'.'+Result;
if PropOwner is TComponent then begin
LookupRoot:=GetLookupRootForComponent(TComponent(PropOwner));
if LookupRoot is TComponent then begin
//DebugLn(['TMainIDE.OnPropHookGetMethodName ',Result,' GlobalDesignHook.LookupRoot=',dbgsName(GlobalDesignHook.LookupRoot),' JITMethod.TheClass=',dbgsName(JITMethod.TheClass),' PropOwner=',DbgSName(PropOwner),' PropOwner-LookupRoot=',DbgSName(LookupRoot)]);
if (LookupRoot.ClassType<>JITMethod.TheClass)
or (LookupRoot<>OrigLookupRoot) then
Result:=JITMethod.TheClass.ClassName+'.'+Result;
end;
end;
end else
Result:='';
{$IFDEF VerboseDanglingComponentEvents}