paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-05 20:46:03 +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 // methods
TPropHookCreateMethod = function(const Name: ShortString; ATypeInfo: PTypeInfo; TPropHookCreateMethod = function(const Name: ShortString; ATypeInfo: PTypeInfo;
APersistent: TPersistent; const APropertyPath: string): TMethod of object; 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; TPropHookGetCompatibleMethods = procedure(InstProp: PInstProp; const Proc: TGetStrProc) of object;
TPropHookGetMethods = procedure(TypeData: PTypeData; Proc: TGetStrProc) of object; TPropHookGetMethods = procedure(TypeData: PTypeData; Proc: TGetStrProc) of object;
TPropHookCompatibleMethodExists = function(const Name: String; InstProp: PInstProp; TPropHookCompatibleMethodExists = function(const Name: String; InstProp: PInstProp;
@ -5619,7 +5620,7 @@ var
begin begin
i:=GetHandlerCount(htGetMethodName); i:=GetHandlerCount(htGetMethodName);
if GetNextHandlerIndex(htGetMethodName,i) then begin if GetNextHandlerIndex(htGetMethodName,i) then begin
Result:=TPropHookGetMethodName(FHandlers[htGetMethodName][i])(Method,PropOwner); Result:=TPropHookGetMethodName(FHandlers[htGetMethodName][i])(Method,PropOwner,LookupRoot);
end else begin end else begin
// search the method name with the given code pointer // search the method name with the given code pointer
if Assigned(Method.Code) then begin if Assigned(Method.Code) then begin

20
ide/main.pp
View File

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