paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-16 00:00:49 +01:00
Code Issues Packages Projects Releases Wiki Activity

codetools: added OnGetClassUnitName

Browse Source
This commit is contained in:
mattias 2022-04-15 01:20:04 +02:00
parent 5bcbf905a8
commit e18dd7be66
3 changed files with 26 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
components/codetools/codetoolmanager.pas
View File

@ -126,6 +126,7 @@ type
FOnFindDefinePropertyForContext: TOnFindDefinePropertyForContext;
FOnFindDefineProperty: TOnFindDefineProperty;
FOnGatherUserIdentifiers: TOnGatherUserIdentifiers;
FOnGetClassUnitName: TOnGetClassUnitName;
FOnGetIndenterExamples: TOnGetFABExamples;
FOnGetMethodName: TOnGetMethodname;
FOnRescanFPCDirectoryCache: TNotifyEvent;
@ -160,6 +161,7 @@ type
const AFilename: string): string;
function DoOnInternalGetMethodName(const AMethod: TMethod;
CheckOwner: TObject): string;
function DoOnInternalGetClassUnitName(aClass: TClass): string;
function FindCodeOfMainUnitHint(Code: TCodeBuffer): TCodeBuffer;
procedure CreateScanner(Code: TCodeBuffer);
procedure SetAbortable(const AValue: boolean);
@ -381,6 +383,8 @@ type
// miscellaneous
property OnGetMethodName: TOnGetMethodname read FOnGetMethodName
write FOnGetMethodName;
property OnGetClassUnitName: TOnGetClassUnitName read FOnGetClassUnitName
write FOnGetClassUnitName;
property OnGetIndenterExamples: TOnGetFABExamples
read FOnGetIndenterExamples write FOnGetIndenterExamples;
property OnGatherUserIdentifiers: TOnGatherUserIdentifiers
@ -5963,6 +5967,14 @@ begin
Result:=TObject(AMethod.Data).MethodName(AMethod.Code);
end;
function TCodeToolManager.DoOnInternalGetClassUnitName(aClass: TClass): string;
begin
if Assigned(OnGetClassUnitName) then
Result:=OnGetClassUnitName(aClass)
else
Result:=aClass.UnitName;
end;
function TCodeToolManager.DoOnParserProgress(Tool: TCustomCodeTool): boolean;
begin
Result:=true;
@ -6247,6 +6259,7 @@ begin
TCodeTool(Result).OnFindUsedUnit:=@DoOnFindUsedUnit;
TCodeTool(Result).OnGetSrcPathForCompiledUnit:=@DoOnGetSrcPathForCompiledUnit;
TCodeTool(Result).OnGetMethodName:=@DoOnInternalGetMethodName;
TCodeTool(Result).OnGetClassUnitName:=@DoOnInternalGetClassUnitName;
TCodeTool(Result).OnRescanFPCDirectoryCache:=@DoOnRescanFPCDirectoryCache;
TCodeTool(Result).OnGatherUserIdentifiers:=@DoOnGatherUserIdentifiers;
TCodeTool(Result).DirectoryCache:=

2
components/codetools/eventcodetool.pas
View File

@ -1094,7 +1094,7 @@ begin
FindContext:=CleanFindContext;
AClassName:=Instance.ClassName;
if AClassName='' then exit;
AUnitName:=Instance.UnitName;
AUnitName:=GetClassUnitName(Instance.ClassType);
{$IFDEF VerboseMethodPropEdit}
debugln(['TEventsCodeTool.FindClassOfInstance Unit=',ExtractFileNameOnly(MainFilename),' Class=',AClassName,' Instance.Unit=',AUnitName]);
{$ENDIF}

12
components/codetools/finddeclarationtool.pas
View File

@ -143,6 +143,7 @@ type
//----------------------------------------------------------------------------
TOnGetMethodName = function(const AMethod: TMethod;
CheckOwner: TObject): string of object;
TOnGetClassUnitName = function(aClass: TClass): string of object;
//----------------------------------------------------------------------------
// flags/states for searching
@ -749,6 +750,7 @@ type
FInterfaceIdentifierCache: TInterfaceIdentifierCache;
FInterfaceHelperCache: array[TFDHelpersListKind] of TFDHelpersList;
FOnFindUsedUnit: TOnFindUsedUnit;
FOnGetClassUnitName: TOnGetClassUnitName;
FOnGetCodeToolForBuffer: TOnGetCodeToolForBuffer;
FOnGetDirectoryCache: TOnGetDirectoryCache;
FOnGetMethodName: TOnGetMethodname;
@ -929,6 +931,7 @@ type
destructor Destroy; override;
procedure ConsistencyCheck; override;
procedure CalcMemSize(Stats: TCTMemStats); override;
function GetClassUnitName(aClass: TClass): string;
procedure BeginParsing(Range: TLinkScannerRange); override;
procedure ValidateToolDependencies; override;
@ -1106,6 +1109,7 @@ type
read FOnGetSrcPathForCompiledUnit write fOnGetSrcPathForCompiledUnit;
property OnGetMethodName: TOnGetMethodname read FOnGetMethodName
write FOnGetMethodName;
property OnGetClassUnitName: TOnGetClassUnitName read FOnGetClassUnitName write FOnGetClassUnitName;
property AdjustTopLineDueToComment: boolean
read FAdjustTopLineDueToComment write FAdjustTopLineDueToComment;
property DirectoryCache: TCTDirectoryCache read FDirectoryCache write FDirectoryCache;
@ -12433,6 +12437,14 @@ begin
FDependsOnCodeTools.Count*SizeOf(TAVLTreeNode));
end;
function TFindDeclarationTool.GetClassUnitName(aClass: TClass): string;
begin
if Assigned(OnGetClassUnitName) then
Result:=OnGetClassUnitName(aClass)
else
Result:=aClass.UnitName;
end;
procedure TFindDeclarationTool.ValidateToolDependencies;
begin
//debugln(['TFindDeclarationTool.ValidateToolDependencies ',MainFilename]);