paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-21 22:59:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: Show methods when clicked in OI also when they are in another unit/form. Issue #25954.

Browse Source 
git-svn-id: trunk@52020 -
This commit is contained in:
juha 2016-03-22 21:57:01 +00:00
parent 3855ea4ebd
commit 75791c984b
2 changed files with 35 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
components/ideintf/propedits.pp
View File

@ -1165,8 +1165,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;
@ -4283,6 +4283,22 @@ begin
Result := True;
end;
function IsValidPropName(const PropName: string): boolean;
var
i, len: integer;
begin
result := false;
len := length(PropName);
if len <> 0 then begin
result := PropName[1] in ['A'..'Z', 'a'..'z', '_'];
i := 1;
while (result) and (i < len) do begin
i := i + 1;
result := result and (PropName[i] in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.']);
end ;
end ;
end ;
procedure TMethodPropertyEditor.Edit;
{ If the method does not exist in current lookuproot: create it
Then jump to the source.
@ -4291,11 +4307,11 @@ procedure TMethodPropertyEditor.Edit;
the ancestor value is added. Then the IDE jumps to the new method body.
}
var
NewMethodName: shortstring;
NewMethodName: String;
begin
NewMethodName := GetValue;
//DebugLn('### TMethodPropertyEditor.Edit A OldValue=',NewMethodName);
if not IsValidIdent(NewMethodName) or PropertyHook.MethodFromAncestor(GetMethodValue) then
if not IsValidPropName(NewMethodName) or PropertyHook.MethodFromAncestor(GetMethodValue) then
begin
// the current method is from the ancestor
// -> add an override with the default name
@ -5592,7 +5608,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

24
ide/main.pp
View File

@ -506,8 +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);
@ -1832,8 +1832,10 @@ 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;
@ -1845,16 +1847,17 @@ begin
Result:='<Unpublished>';
end else
Result:='<No LookupRoot>';
end else if IsJITMethod(Method) then begin
end
else if IsJITMethod(Method) then begin
JITMethod:=TJITMethod(Method.Data);
Result:=JITMethod.TheMethodName;
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) then begin
if (LookupRoot.ClassType<>JITMethod.TheClass)
or (LookupRoot<>OrigLookupRoot) then
Result:=JITMethod.TheClass.ClassName+'.'+Result;
end;
end;
end;
end else
@ -9305,13 +9308,14 @@ begin
Result:=TObject(Method.Data).MethodName(Method.Code)
else
Result:='';
end else if IsJITMethod(Method) then begin
end
else if IsJITMethod(Method) then begin
JITMethod:=TJITMethod(Method.Data);
Result:=JITMethod.TheMethodName;
if PropOwner is TComponent then begin
LookupRoot:=GetLookupRootForComponent(TComponent(PropOwner));
if LookupRoot is TComponent then begin
//DebugLn(['TMainIDE.OnPropHookGetMethodName ',Result,' ',dbgsName(GlobalDesignHook.LookupRoot),' ',dbgsName(JITMethod.TheClass)]);
//DebugLn(['TMainIDE.OnCodeToolBossGetMethodName ',Result,' GlobalDesignHook.LookupRoot=',dbgsName(GlobalDesignHook.LookupRoot),' JITMethod.TheClass=',dbgsName(JITMethod.TheClass),' PropOwner=',DbgSName(PropOwner),' PropOwner-LookupRoot=',DbgSName(LookupRoot)]);
if (LookupRoot.ClassType<>JITMethod.TheClass) then begin
Result:=JITMethod.TheClass.ClassName+'.'+Result;
end;
@ -9321,7 +9325,7 @@ begin
Result:='';
{$IFDEF VerboseDanglingComponentEvents}
if IsJITMethod(Method) then
DebugLn(['TMainIDE.OnPropHookGetMethodName ',Result,' ',IsJITMethod(Method)]);
DebugLn(['TMainIDE.OnCodeToolBossGetMethodName ',Result,' ',IsJITMethod(Method)]);
{$ENDIF}
end;