mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-14 09:39:25 +02:00
codetools: TEventsCodeTool.FindClassOfInstance: search unit in unitpath, the uses section is not enough
git-svn-id: branches/fixes_1_8@55205 -
This commit is contained in:
mattias
parent
c70e25128b
commit
bc01ed015e
@ -1039,8 +1039,7 @@ var
|
||||
var
|
||||
Node: TCodeTreeNode;
|
||||
AUnitName: String;
|
||||
UsesNode: TCodeTreeNode;
|
||||
Params: TFindDeclarationParams;
|
||||
Tool: TFindDeclarationTool;
|
||||
begin
|
||||
Result:=false;
|
||||
//debugln(['TEventsCodeTool.FindClassOfInstance START']);
|
||||
@ -1048,7 +1047,9 @@ begin
|
||||
AClassName:=Instance.ClassName;
|
||||
if AClassName='' then exit;
|
||||
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='')
|
||||
or (CompareIdentifiers(PChar(ExtractFileNameOnly(MainFilename)),
|
||||
PChar(AUnitName))=0)
|
||||
@ -1065,40 +1066,27 @@ begin
|
||||
FindContext.Tool:=Self;
|
||||
exit(true);
|
||||
end;
|
||||
// search in used units
|
||||
UsesNode:=FindMainUsesNode;
|
||||
if UsesNode=nil then begin
|
||||
debugln(['TEventsCodeTool.FindClassOfInstance no main uses section found']);
|
||||
|
||||
// find unit
|
||||
// Note: when a component was loaded by an ancestor, its class may not
|
||||
// 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;
|
||||
exit;
|
||||
end;
|
||||
Params:=TFindDeclarationParams.Create;
|
||||
try
|
||||
Params.ContextNode:=UsesNode;
|
||||
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;
|
||||
FindContext.Node:=Node.LastChild;
|
||||
FindContext.Tool:=Tool;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TEventsCodeTool.FindTypeOfInstanceProperty(Instance: TPersistent;
|
||||
@ -1401,7 +1389,9 @@ begin
|
||||
BuildTree(lsrImplementationStart);
|
||||
//debugln(['TEventsCodeTool.GetCompatiblePublishedMethods START']);
|
||||
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
|
||||
SearchedExprList:=nil;
|
||||
SearchedCompatibilityList:=nil;
|
||||
@ -1409,7 +1399,9 @@ begin
|
||||
Params:=TFindDeclarationParams.Create;
|
||||
try
|
||||
SearchedExprList:=CreateExprListFromInstanceProperty(PropInstance,PropName);
|
||||
//debugln(['TEventsCodeTool.GetCompatiblePublishedMethods ExprList=',SearchedExprList.AsString]);
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TEventsCodeTool.GetCompatiblePublishedMethods ExprList=',SearchedExprList.AsString]);
|
||||
{$ENDIF}
|
||||
fGatheredCompatibleMethods:=TAVLTree.Create(@CompareIdentifierPtrs);
|
||||
// create compatibility list
|
||||
CompListSize:=SizeOf(TTypeCompatibility)*SearchedExprList.Count;
|
||||
@ -1419,7 +1411,7 @@ begin
|
||||
Params.ContextNode:=ClassNode;
|
||||
Params.Flags:=[fdfCollect,fdfSearchInAncestors];
|
||||
Params.SetIdentifier(Self,nil,@CollectPublishedMethods);
|
||||
{$IFDEF CTDEBUG}
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
DebugLn('[TEventsCodeTool.GetCompatiblePublishedMethods] Searching ...');
|
||||
{$ENDIF}
|
||||
FindIdentifierInContext(Params);
|
||||
|
||||
@ -4582,14 +4582,19 @@ var
|
||||
NewMethodName: String;
|
||||
begin
|
||||
NewMethodName := GetValue;
|
||||
//DebugLn('### TMethodPropertyEditor.Edit A OldValue=',NewMethodName);
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.Edit OldValue="',NewMethodName,'"']);
|
||||
DumpStack;
|
||||
{$ENDIF}
|
||||
if not LazIsValidIdent(NewMethodName, True, True)
|
||||
or PropertyHook.MethodFromAncestor(GetMethodValue) then
|
||||
begin
|
||||
// the current method is from the ancestor
|
||||
// -> add an override with the default name
|
||||
NewMethodName := GetFormMethodName;
|
||||
//DebugLn('### TMethodPropertyEditor.Edit B FormMethodName=',NewMethodName);
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.Edit NewValue="',NewMethodName,'"']);
|
||||
{$ENDIF}
|
||||
if not IsValidIdent(NewMethodName) then
|
||||
raise EPropertyError.Create('Method name "'+NewMethodName+'" must be an identifier');
|
||||
SetValue(NewMethodName); // this will jump to the method
|
||||
@ -4725,7 +4730,7 @@ end;
|
||||
|
||||
procedure TMethodPropertyEditor.SetValue(const NewValue: ansistring);
|
||||
var
|
||||
CreateNewMethod: Boolean;
|
||||
CreateNewMethodSrc: Boolean;
|
||||
CurValue: string;
|
||||
NewMethodExists, NewMethodIsCompatible, NewMethodIsPublished,
|
||||
NewIdentIsMethod: boolean;
|
||||
@ -4734,7 +4739,9 @@ var
|
||||
begin
|
||||
CurValue := GetValue;
|
||||
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);
|
||||
|
||||
if (not IsNil) and (not IsValidIdent(NewValue)) then
|
||||
@ -4748,7 +4755,9 @@ begin
|
||||
NewMethodExists := (not IsNil) and
|
||||
PropertyHook.CompatibleMethodExists(NewValue, GetInstProp,
|
||||
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
|
||||
begin
|
||||
if not NewIdentIsMethod then
|
||||
@ -4779,11 +4788,14 @@ begin
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
//DebugLn('### TMethodPropertyEditor.SetValue C');
|
||||
if IsNil then
|
||||
begin
|
||||
// clear
|
||||
NewMethod.Data := nil;
|
||||
NewMethod.Code := nil;
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.SetValue SET to NIL']);
|
||||
{$ENDIF}
|
||||
SetMethodValue(NewMethod);
|
||||
end
|
||||
else
|
||||
@ -4796,22 +4808,34 @@ begin
|
||||
// All other not selected properties that use this method, contain just
|
||||
// the TMethod record. So, changing the name in the jitform will change
|
||||
// all other event names in all other components automatically.
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.SetValue RENAME']);
|
||||
{$ENDIF}
|
||||
PropertyHook.RenameMethod(CurValue, NewValue)
|
||||
end else
|
||||
begin
|
||||
//DebugLn('### TMethodPropertyEditor.SetValue E');
|
||||
CreateNewMethod := not NewMethodExists;
|
||||
// change value and create method src if needed
|
||||
CreateNewMethodSrc := not NewMethodExists;
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.SetValue CHANGE new method=',CreateNewMethodSrc]);
|
||||
{$ENDIF}
|
||||
SetMethodValue(
|
||||
PropertyHook.CreateMethod(NewValue, GetPropType,
|
||||
GetComponent(0), GetPropertyPath(0)));
|
||||
//DebugLn('### TMethodPropertyEditor.SetValue F NewValue=',GetValue);
|
||||
if CreateNewMethod then
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.SetValue CHANGED new method=',CreateNewMethodSrc]);
|
||||
{$ENDIF}
|
||||
if CreateNewMethodSrc then
|
||||
begin
|
||||
//DebugLn('### TMethodPropertyEditor.SetValue G');
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.SetValue SHOW "',NewValue,'"']);
|
||||
{$ENDIF}
|
||||
PropertyHook.ShowMethod(NewValue);
|
||||
end;
|
||||
end;
|
||||
//DebugLn('### TMethodPropertyEditor.SetValue END NewValue=',GetValue);
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
DebugLn('### TMethodPropertyEditor.SetValue END NewValue=',GetValue);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{ TPersistentPropertyEditor }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user