paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 18:19:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: TEventsCodeTool.FindClassOfInstance: search unit in unitpath, the uses section is not enough

Browse Source 
git-svn-id: branches/fixes_1_8@55205 -
This commit is contained in:
mattias 2017-06-04 07:30:37 +00:00
parent c70e25128b
commit bc01ed015e
2 changed files with 65 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
components/codetools/eventcodetool.pas
View File

@ -1039,8 +1039,7 @@ var
var var
Node: TCodeTreeNode; Node: TCodeTreeNode;
AUnitName: String; AUnitName: String;
UsesNode: TCodeTreeNode; Tool: TFindDeclarationTool;
Params: TFindDeclarationParams;
begin begin
Result:=false; Result:=false;
//debugln(['TEventsCodeTool.FindClassOfInstance START']); //debugln(['TEventsCodeTool.FindClassOfInstance START']);
@ -1048,7 +1047,9 @@ begin
AClassName:=Instance.ClassName; AClassName:=Instance.ClassName;
if AClassName='' then exit; if AClassName='' then exit;
AUnitName:=Instance.UnitName; AUnitName:=Instance.UnitName;
//debugln(['TEventsCodeTool.FindClassOfInstance Unit=',ExtractFileNameOnly(MainFilename),' Class=',AClassName,' Instance.Unit=',AUnitName]); {$IFDEF VerboseMethodPropEdit}
debugln(['TEventsCodeTool.FindClassOfInstance Unit=',ExtractFileNameOnly(MainFilename),' Class=',AClassName,' Instance.Unit=',AUnitName]);
{$ENDIF}
if (AUnitName='') if (AUnitName='')
or (CompareIdentifiers(PChar(ExtractFileNameOnly(MainFilename)), or (CompareIdentifiers(PChar(ExtractFileNameOnly(MainFilename)),
PChar(AUnitName))=0) PChar(AUnitName))=0)
@ -1065,40 +1066,27 @@ begin
FindContext.Tool:=Self; FindContext.Tool:=Self;
exit(true); exit(true);
end; end;
// search in used units
UsesNode:=FindMainUsesNode; // find unit
if UsesNode=nil then begin // Note: when a component was loaded by an ancestor, its class may not
debugln(['TEventsCodeTool.FindClassOfInstance no main uses section found']); // be in the uses section of the current unit
Tool:=FindCodeToolForUsedUnit(AUnitName,'',ExceptionOnNotFound);
if Tool=nil then exit(false);
// find class
Node:=Tool.FindDeclarationNodeInInterface(AClassName,true);
// check if it is a class
if (Node=nil)
or (not (Node.Desc in [ctnTypeDefinition,ctnGenericType]))
or (Node.LastChild=nil)
or (not (Node.LastChild.Desc in AllClassObjects)) then begin
debugln(['TEventsCodeTool.FindClassOfInstance found node is not a class: ',Node.DescAsString]);
if ExceptionOnNotFound then RaiseClassNotFound; if ExceptionOnNotFound then RaiseClassNotFound;
exit; exit;
end; end;
Params:=TFindDeclarationParams.Create; FindContext.Node:=Node.LastChild;
try FindContext.Tool:=Tool;
Params.ContextNode:=UsesNode; Result:=true;
Params.Flags:=[fdfSearchInParentNodes, fdfSearchInAncestors];
if ExceptionOnNotFound then Include(Params.Flags,fdfExceptionOnNotFound);
Params.SetIdentifier(Self,PChar(AClassName),nil);
if not FindIdentifierInContext(Params) then begin
debugln(['TEventsCodeTool.FindClassOfInstance FindIdentifierInContext failed']);
if ExceptionOnNotFound then RaiseClassNotFound;
exit;
end;
// check if it is a class
Node:=Params.NewNode;
if (Node=nil)
or (not (Node.Desc in [ctnTypeDefinition,ctnGenericType]))
or (Node.LastChild=nil)
or (not (Node.LastChild.Desc in AllClassObjects)) then begin
debugln(['TEventsCodeTool.FindClassOfInstance found node is not a class: ',Node.DescAsString]);
if ExceptionOnNotFound then RaiseClassNotFound;
exit;
end;
FindContext.Node:=Node.LastChild;
FindContext.Tool:=Params.NewCodeTool;
Result:=true;
finally
Params.Free;
end;
end; end;
function TEventsCodeTool.FindTypeOfInstanceProperty(Instance: TPersistent; function TEventsCodeTool.FindTypeOfInstanceProperty(Instance: TPersistent;
@ -1401,7 +1389,9 @@ begin
BuildTree(lsrImplementationStart); BuildTree(lsrImplementationStart);
//debugln(['TEventsCodeTool.GetCompatiblePublishedMethods START']); //debugln(['TEventsCodeTool.GetCompatiblePublishedMethods START']);
ClassNode:=FindClassNodeInInterface(AClassName,true,false,true); ClassNode:=FindClassNodeInInterface(AClassName,true,false,true);
//debugln(['TEventsCodeTool.GetCompatiblePublishedMethods classnode=',ClassNode.DescAsString]); {$IFDEF VerboseMethodPropEdit}
debugln(['TEventsCodeTool.GetCompatiblePublishedMethods ClassName="',AClassName,'" PropInstance=',DbgSName(PropInstance),' PropName="',PropName,'" classnode=',ClassNode.DescAsString]);
{$ENDIF}
// create type list of property // create type list of property
SearchedExprList:=nil; SearchedExprList:=nil;
SearchedCompatibilityList:=nil; SearchedCompatibilityList:=nil;
@ -1409,7 +1399,9 @@ begin
Params:=TFindDeclarationParams.Create; Params:=TFindDeclarationParams.Create;
try try
SearchedExprList:=CreateExprListFromInstanceProperty(PropInstance,PropName); SearchedExprList:=CreateExprListFromInstanceProperty(PropInstance,PropName);
//debugln(['TEventsCodeTool.GetCompatiblePublishedMethods ExprList=',SearchedExprList.AsString]); {$IFDEF VerboseMethodPropEdit}
debugln(['TEventsCodeTool.GetCompatiblePublishedMethods ExprList=',SearchedExprList.AsString]);
{$ENDIF}
fGatheredCompatibleMethods:=TAVLTree.Create(@CompareIdentifierPtrs); fGatheredCompatibleMethods:=TAVLTree.Create(@CompareIdentifierPtrs);
// create compatibility list // create compatibility list
CompListSize:=SizeOf(TTypeCompatibility)*SearchedExprList.Count; CompListSize:=SizeOf(TTypeCompatibility)*SearchedExprList.Count;
@ -1419,7 +1411,7 @@ begin
Params.ContextNode:=ClassNode; Params.ContextNode:=ClassNode;
Params.Flags:=[fdfCollect,fdfSearchInAncestors]; Params.Flags:=[fdfCollect,fdfSearchInAncestors];
Params.SetIdentifier(Self,nil,@CollectPublishedMethods); Params.SetIdentifier(Self,nil,@CollectPublishedMethods);
{$IFDEF CTDEBUG} {$IFDEF VerboseMethodPropEdit}
DebugLn('[TEventsCodeTool.GetCompatiblePublishedMethods] Searching ...'); DebugLn('[TEventsCodeTool.GetCompatiblePublishedMethods] Searching ...');
{$ENDIF} {$ENDIF}
FindIdentifierInContext(Params); FindIdentifierInContext(Params);

48
components/ideintf/propedits.pp
View File

@ -4582,14 +4582,19 @@ var
NewMethodName: String; NewMethodName: String;
begin begin
NewMethodName := GetValue; NewMethodName := GetValue;
//DebugLn('### TMethodPropertyEditor.Edit A OldValue=',NewMethodName); {$IFDEF VerboseMethodPropEdit}
debugln(['TMethodPropertyEditor.Edit OldValue="',NewMethodName,'"']);
DumpStack;
{$ENDIF}
if not LazIsValidIdent(NewMethodName, True, True) if not LazIsValidIdent(NewMethodName, True, True)
or PropertyHook.MethodFromAncestor(GetMethodValue) then or PropertyHook.MethodFromAncestor(GetMethodValue) then
begin begin
// the current method is from the ancestor // the current method is from the ancestor
// -> add an override with the default name // -> add an override with the default name
NewMethodName := GetFormMethodName; NewMethodName := GetFormMethodName;
//DebugLn('### TMethodPropertyEditor.Edit B FormMethodName=',NewMethodName); {$IFDEF VerboseMethodPropEdit}
debugln(['TMethodPropertyEditor.Edit NewValue="',NewMethodName,'"']);
{$ENDIF}
if not IsValidIdent(NewMethodName) then if not IsValidIdent(NewMethodName) then
raise EPropertyError.Create('Method name "'+NewMethodName+'" must be an identifier'); raise EPropertyError.Create('Method name "'+NewMethodName+'" must be an identifier');
SetValue(NewMethodName); // this will jump to the method SetValue(NewMethodName); // this will jump to the method
@ -4725,7 +4730,7 @@ end;
procedure TMethodPropertyEditor.SetValue(const NewValue: ansistring); procedure TMethodPropertyEditor.SetValue(const NewValue: ansistring);
var var
CreateNewMethod: Boolean; CreateNewMethodSrc: Boolean;
CurValue: string; CurValue: string;
NewMethodExists, NewMethodIsCompatible, NewMethodIsPublished, NewMethodExists, NewMethodIsCompatible, NewMethodIsPublished,
NewIdentIsMethod: boolean; NewIdentIsMethod: boolean;
@ -4734,7 +4739,9 @@ var
begin begin
CurValue := GetValue; CurValue := GetValue;
if CurValue = NewValue then exit; if CurValue = NewValue then exit;
//DebugLn('### TMethodPropertyEditor.SetValue A OldValue="',CurValue,'" NewValue=',NewValue); {$IFDEF VerboseMethodPropEdit}
debugln(['TMethodPropertyEditor.SetValue CurValue="',CurValue,'" NewValue="',NewValue,'"']);
{$ENDIF}
IsNil := (NewValue='') or (NewValue=oisNone); IsNil := (NewValue='') or (NewValue=oisNone);
if (not IsNil) and (not IsValidIdent(NewValue)) then if (not IsNil) and (not IsValidIdent(NewValue)) then
@ -4748,7 +4755,9 @@ begin
NewMethodExists := (not IsNil) and NewMethodExists := (not IsNil) and
PropertyHook.CompatibleMethodExists(NewValue, GetInstProp, PropertyHook.CompatibleMethodExists(NewValue, GetInstProp,
NewMethodIsCompatible, NewMethodIsPublished, NewIdentIsMethod); NewMethodIsCompatible, NewMethodIsPublished, NewIdentIsMethod);
//DebugLn('### TMethodPropertyEditor.SetValue B NewMethodExists=',NewMethodExists,' NewMethodIsCompatible=',NewMethodIsCompatible,' ',NewMethodIsPublished,' ',NewIdentIsMethod); {$IFDEF VerboseMethodPropEdit}
debugln(['TMethodPropertyEditor.SetValue NewValue="',NewValue,'" IsCompatible=',NewMethodIsCompatible,' IsPublished=',NewMethodIsPublished,' IsMethpd=',NewIdentIsMethod]);
{$ENDIF}
if NewMethodExists then if NewMethodExists then
begin begin
if not NewIdentIsMethod then if not NewIdentIsMethod then
@ -4779,11 +4788,14 @@ begin
exit; exit;
end; end;
end; end;
//DebugLn('### TMethodPropertyEditor.SetValue C');
if IsNil then if IsNil then
begin begin
// clear
NewMethod.Data := nil; NewMethod.Data := nil;
NewMethod.Code := nil; NewMethod.Code := nil;
{$IFDEF VerboseMethodPropEdit}
debugln(['TMethodPropertyEditor.SetValue SET to NIL']);
{$ENDIF}
SetMethodValue(NewMethod); SetMethodValue(NewMethod);
end end
else else
@ -4796,22 +4808,34 @@ begin
// All other not selected properties that use this method, contain just // All other not selected properties that use this method, contain just
// the TMethod record. So, changing the name in the jitform will change // the TMethod record. So, changing the name in the jitform will change
// all other event names in all other components automatically. // all other event names in all other components automatically.
{$IFDEF VerboseMethodPropEdit}
debugln(['TMethodPropertyEditor.SetValue RENAME']);
{$ENDIF}
PropertyHook.RenameMethod(CurValue, NewValue) PropertyHook.RenameMethod(CurValue, NewValue)
end else end else
begin begin
//DebugLn('### TMethodPropertyEditor.SetValue E'); // change value and create method src if needed
CreateNewMethod := not NewMethodExists; CreateNewMethodSrc := not NewMethodExists;
{$IFDEF VerboseMethodPropEdit}
debugln(['TMethodPropertyEditor.SetValue CHANGE new method=',CreateNewMethodSrc]);
{$ENDIF}
SetMethodValue( SetMethodValue(
PropertyHook.CreateMethod(NewValue, GetPropType, PropertyHook.CreateMethod(NewValue, GetPropType,
GetComponent(0), GetPropertyPath(0))); GetComponent(0), GetPropertyPath(0)));
//DebugLn('### TMethodPropertyEditor.SetValue F NewValue=',GetValue); {$IFDEF VerboseMethodPropEdit}
if CreateNewMethod then debugln(['TMethodPropertyEditor.SetValue CHANGED new method=',CreateNewMethodSrc]);
{$ENDIF}
if CreateNewMethodSrc then
begin begin
//DebugLn('### TMethodPropertyEditor.SetValue G'); {$IFDEF VerboseMethodPropEdit}
debugln(['TMethodPropertyEditor.SetValue SHOW "',NewValue,'"']);
{$ENDIF}
PropertyHook.ShowMethod(NewValue); PropertyHook.ShowMethod(NewValue);
end; end;
end; end;
//DebugLn('### TMethodPropertyEditor.SetValue END NewValue=',GetValue); {$IFDEF VerboseMethodPropEdit}
DebugLn('### TMethodPropertyEditor.SetValue END NewValue=',GetValue);
{$ENDIF}
end; end;
{ TPersistentPropertyEditor } { TPersistentPropertyEditor }