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

implemented compiled unit search and indirect search path

Browse Source 
git-svn-id: trunk@3973 -
This commit is contained in:
mattias 2003-03-27 12:42:54 +00:00
parent 04eb311c3f
commit 8e965a3f58
4 changed files with 157 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
components/codetools/codetoolmanager.pas
View File

@ -39,9 +39,9 @@ uses
{$IFDEF MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, BasicCodeTools, CodeToolsStrConsts, EventCodeTool,
CodeTree, CodeAtom, SourceChanger, DefineTemplates, CodeCache, ExprEval,
LinkScanner, KeywordFuncLists, TypInfo, AVL_Tree, CustomCodeTool,
Classes, SysUtils, FileProcs, BasicCodeTools, CodeToolsStrConsts,
EventCodeTool, CodeTree, CodeAtom, SourceChanger, DefineTemplates, CodeCache,
ExprEval, LinkScanner, KeywordFuncLists, TypInfo, AVL_Tree, CustomCodeTool,
FindDeclarationTool, IdentCompletionTool, ResourceCodeTool, CodeToolsStructs;
type
@ -94,6 +94,8 @@ type
procedure OnGlobalValuesChanged;
function DoOnFindUsedUnit(SrcTool: TFindDeclarationTool; const TheUnitName,
TheUnitInFilename: string): TCodeBuffer;
function DoOnGetSrcPathForCompiledUnit(Sender: TObject;
const AFilename: string): string;
function GetMainCode(Code: TCodeBuffer): TCodeBuffer;
procedure CreateScanner(Code: TCodeBuffer);
function InitCurCodeTool(Code: TCodeBuffer): boolean;
@ -193,6 +195,10 @@ type
function GetUnitPathForDirectory(const Directory: string): string;
function GetIncludePathForDirectory(const Directory: string): string;
function GetSrcPathForDirectory(const Directory: string): string;
function GetPPUSrcPathForDirectory(const Directory: string): string;
function GetPPWSrcPathForDirectory(const Directory: string): string;
function GetDCUSrcPathForDirectory(const Directory: string): string;
function GetCompiledSrcPathForDirectory(const Directory: string): string;
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -599,6 +605,30 @@ begin
Result:=DefineTree.GetSrcPathForDirectory(Directory);
end;
function TCodeToolManager.GetPPUSrcPathForDirectory(const Directory: string
): string;
begin
Result:=DefineTree.GetPPUSrcPathForDirectory(Directory);
end;
function TCodeToolManager.GetPPWSrcPathForDirectory(const Directory: string
): string;
begin
Result:=DefineTree.GetPPWSrcPathForDirectory(Directory);
end;
function TCodeToolManager.GetDCUSrcPathForDirectory(const Directory: string
): string;
begin
Result:=DefineTree.GetDCUSrcPathForDirectory(Directory);
end;
function TCodeToolManager.GetCompiledSrcPathForDirectory(const Directory: string
): string;
begin
Result:=DefineTree.GetCompiledSrcPathForDirectory(Directory);
end;
function TCodeToolManager.InitCurCodeTool(Code: TCodeBuffer): boolean;
var MainCode: TCodeBuffer;
begin
@ -1880,6 +1910,19 @@ begin
Result:=nil;
end;
function TCodeToolManager.DoOnGetSrcPathForCompiledUnit(Sender: TObject;
const AFilename: string): string;
begin
if CompareFileExt(AFilename,'.ppu',false)=0 then
Result:=GetPPUSrcPathForDirectory(ExtractFilePath(AFilename))
else if CompareFileExt(AFilename,'.ppw',false)=0 then
Result:=GetPPWSrcPathForDirectory(ExtractFilePath(AFilename))
else if CompareFileExt(AFilename,'.dcu',false)=0 then
Result:=GetDCUSrcPathForDirectory(ExtractFilePath(AFilename));
if Result='' then
Result:=GetCompiledSrcPathForDirectory(ExtractFilePath(AFilename));
end;
function TCodeToolManager.OnParserProgress(Tool: TCustomCodeTool): boolean;
begin
Result:=true;
@ -2043,6 +2086,7 @@ begin
Result.CursorBeyondEOL:=FCursorBeyondEOL;
TFindDeclarationTool(Result).OnGetCodeToolForBuffer:=@OnGetCodeToolForBuffer;
TFindDeclarationTool(Result).OnFindUsedUnit:=@DoOnFindUsedUnit;
TFindDeclarationTool(Result).OnGetSrcPathForCompiledUnit:=@DoOnGetSrcPathForCompiledUnit;
Result.OnSetGlobalWriteLock:=@OnToolSetWriteLock;
Result.OnGetGlobalWriteLockInfo:=@OnToolGetWriteLockInfo;
TFindDeclarationTool(Result).OnParserProgress:=@OnParserProgress;

1
components/codetools/codetoolsstrconsts.pas
View File

@ -210,6 +210,7 @@ ResourceString
ctsInsufficientMemory = 'insufficient memory';
ctsFileHasCircularSymLink = '%s has a circular symbolic link';
ctsFileIsNotExecutable = '%s is not executable';
ctsSrcPathForCompiledUnits = 'src path for compiled units';
implementation

41
components/codetools/definetemplates.pas
View File

@ -281,6 +281,7 @@ type
function GetPPUSrcPathForDirectory(const Directory: string): string;
function GetPPWSrcPathForDirectory(const Directory: string): string;
function GetDCUSrcPathForDirectory(const Directory: string): string;
function GetCompiledSrcPathForDirectory(const Directory: string): string;
function ReadValue(const DirDef: TDirectoryDefines;
const PreValue, CurDefinePath: string): string;
constructor Create;
@ -1334,6 +1335,18 @@ begin
end;
end;
function TDefineTree.GetCompiledSrcPathForDirectory(const Directory: string
): string;
var ExprEval: TExpressionEvaluator;
begin
ExprEval:=GetDefinesForDirectory(Directory,true);
if ExprEval<>nil then begin
Result:=ExprEval.Variables[ExternalMacroStart+'CompiledSrcPath'];
end else begin
Result:='';
end;
end;
function TDefineTree.GetDefinesForDirectory(
const Path: string; WithVirtualDir: boolean): TExpressionEvaluator;
var ExpPath: string;
@ -2501,12 +2514,17 @@ end;
function TDefinePool.CreateLazarusSrcTemplate(
const LazarusSrcDir, WidgetType, ExtraOptions: string): TDefineTemplate;
type
TLazWidgetSet = (wsGtk, wsGtk2, wsGnome, wsWin32);
const
ds: char = PathDelim;
LazWidgetSets: array[TLazWidgetSet] of string = (
'gtk','gtk2','gnome','win32');
var
MainDir, DirTempl, SubDirTempl, IntfDirTemplate, IfTemplate,
SubTempl: TDefineTemplate;
TargetOS, SrcPath: string;
TargetOS, SrcPath, WidgetStr: string;
WidgetSet: TLazWidgetSet;
begin
Result:=nil;
if (LazarusSrcDir='') or (WidgetType='') then exit;
@ -2642,6 +2660,27 @@ begin
ExternalMacroStart+'IncPath',
'include',da_Define));
MainDir.AddChild(DirTempl);
// lcl/units
SubDirTempl:=TDefineTemplate.Create('Units',Format(ctsNamedDirectory,['Units']),
'','units',da_Directory);
SubDirTempl.AddChild(TDefineTemplate.Create('CompiledSrcPath',
ctsSrcPathForCompiledUnits,
ExternalMacroStart+'CompiledSrcPath',
'..',da_Define));
DirTempl.AddChild(SubDirTempl);
// lcl/units/{gtk,gtk2,gnome,win32}
for WidgetSet:=Low(TLazWidgetSet) to High(TLazWidgetSet) do begin
WidgetStr:=LazWidgetSets[WidgetSet];
IntfDirTemplate:=TDefineTemplate.Create(WidgetStr+'IntfUnitsDirectory',
ctsGtkIntfDirectory,'',WidgetStr,da_Directory);
IntfDirTemplate.AddChild(TDefineTemplate.Create('CompiledSrcPath',
ctsSrcPathForCompiledUnits,
ExternalMacroStart+'CompiledSrcPath',
'..'+ds+'..'+ds+'interfaces'+ds+WidgetStr,da_Define));
SubDirTempl.AddChild(IntfDirTemplate);
end;
// lcl/interfaces
SubDirTempl:=TDefineTemplate.Create('WidgetDirectory',

93
components/codetools/finddeclarationtool.pas
View File

@ -123,7 +123,9 @@ type
//----------------------------------------------------------------------------
// searchpath delimiter is semicolon
TOnGetSearchPath = function(Sender: TObject): string of object;
TOnGetSrcPathForCompiledUnit =
function(Sender: TObject; const Filename: string): string of object;
TOnGetCodeToolForBuffer = function(Sender: TObject;
Code: TCodeBuffer): TFindDeclarationTool of object;
@ -457,6 +459,7 @@ type
FOnGetCodeToolForBuffer: TOnGetCodeToolForBuffer;
FOnFindUsedUnit: TOnFindUsedUnit;
FOnGetUnitSourceSearchPath: TOnGetSearchPath;
FOnGetSrcPathForCompiledUnit: TOnGetSrcPathForCompiledUnit;
FFirstNodeCache: TCodeTreeNodeCache;
FLastNodeCachesGlobalWriteLockStep: integer;
FRootNodeCache: TCodeTreeNodeCache;
@ -613,6 +616,8 @@ type
read FOnGetUnitSourceSearchPath write FOnGetUnitSourceSearchPath;
property OnFindUsedUnit: TOnFindUsedUnit
read FOnFindUsedUnit write FOnFindUsedUnit;
property OnGetSrcPathForCompiledUnit: TOnGetSrcPathForCompiledUnit
read FOnGetSrcPathForCompiledUnit write FOnGetSrcPathForCompiledUnit;
function ConsistencyCheck: integer; override;
end;
@ -1073,6 +1078,8 @@ end;
function TFindDeclarationTool.FindUnitSource(const AnUnitName,
AnUnitInFilename: string): TCodeBuffer;
var
CurDir, CompiledSrcExt: string;
function LoadFile(const AFilename: string;
var NewCode: TCodeBuffer): boolean;
@ -1085,22 +1092,28 @@ function TFindDeclarationTool.FindUnitSource(const AnUnitName,
Result:=NewCode<>nil;
end;
function SearchUnitFileInDir(const ADir, AnUnitName: string): TCodeBuffer;
function SearchUnitFileInDir(const ADir, AnUnitName: string;
SearchSource: boolean): TCodeBuffer;
var APath: string;
begin
APath:=ADir;
if (APath<>'') and (APath[length(APath)]<>PathDelim) then
APath:=APath+PathDelim;
{$IFNDEF win32}
if LoadFile(ADir+lowercase(AnUnitName)+'.pp',Result) then exit;
if LoadFile(ADir+lowercase(AnUnitName)+'.pas',Result) then exit;
{$ENDIF}
if LoadFile(ADir+AnUnitName+'.pp',Result) then exit;
if LoadFile(ADir+AnUnitName+'.pas',Result) then exit;
if SearchSource then begin
{$IFNDEF win32}
if LoadFile(ADir+lowercase(AnUnitName)+'.pp',Result) then exit;
if LoadFile(ADir+lowercase(AnUnitName)+'.pas',Result) then exit;
{$ENDIF}
if LoadFile(ADir+AnUnitName+'.pp',Result) then exit;
if LoadFile(ADir+AnUnitName+'.pas',Result) then exit;
end else begin
if LoadFile(ADir+lowercase(AnUnitName)+CompiledSrcExt,Result) then exit;
end;
Result:=nil;
end;
function SearchUnitFileInPath(const APath, TheUnitName: string): TCodeBuffer;
function SearchUnitFileInPath(const APath, TheUnitName: string;
SearchSource: boolean): TCodeBuffer;
var PathStart, PathEnd: integer;
ADir: string;
begin
@ -1112,9 +1125,8 @@ function TFindDeclarationTool.FindUnitSource(const AnUnitName,
ADir:=copy(APath,PathStart,PathEnd-PathStart);
if (ADir<>'') and (ADir[length(ADir)]<>PathDelim) then
ADir:=ADir+PathDelim;
if not FilenameIsAbsolute(ADir) then
ADir:=ExtractFilePath(TCodeBuffer(Scanner.MainCode).Filename)+ADir;
Result:=SearchUnitFileInDir(ADir,TheUnitName);
if not FilenameIsAbsolute(ADir) then ADir:=CurDir+ADir;
Result:=SearchUnitFileInDir(ADir,TheUnitName,SearchSource);
if Result<>nil then exit;
end;
PathStart:=PathEnd+1;
@ -1134,8 +1146,7 @@ function TFindDeclarationTool.FindUnitSource(const AnUnitName,
ADir:=copy(APath,PathStart,PathEnd-PathStart);
if (ADir<>'') and (ADir[length(ADir)]<>PathDelim) then
ADir:=ADir+PathDelim;
if not FilenameIsAbsolute(ADir) then
ADir:=ExtractFilePath(TCodeBuffer(Scanner.MainCode).Filename)+ADir;
if not FilenameIsAbsolute(ADir) then ADir:=CurDir+ADir;
if LoadFile(ADir+RelativeFilename,Result) then exit;
end;
PathStart:=PathEnd+1;
@ -1201,8 +1212,9 @@ function TFindDeclarationTool.FindUnitSource(const AnUnitName,
end;
var CurDir, UnitSrcSearchPath: string;
var UnitSrcSearchPath: string;
MainCodeIsVirtual: boolean;
CompiledResult: TCodeBuffer;
begin
{$IFDEF ShowTriedFiles}
writeln('TFindDeclarationTool.FindUnitSource A AnUnitName=',AnUnitName,' AnUnitInFilename=',AnUnitInFilename);
@ -1228,8 +1240,11 @@ begin
end else begin
CurDir:='';
end;
CompiledSrcExt:='.ppu';
// search as the compiler would search
if AnUnitInFilename<>'' then begin
// unitname in 'filename'
// uses IN parameter
if FilenameIsAbsolute(AnUnitInFilename) then begin
Result:=TCodeBuffer(Scanner.OnLoadSource(Self,AnUnitInFilename,true));
end else begin
@ -1242,22 +1257,52 @@ begin
end;
end;
end else begin
// normal unit name -> search as the compiler would search
// first search in current directory (= where the maincode is)
// normal unit name
// first source search in current directory (= where the maincode is)
{$IFDEF ShowTriedFiles}
writeln('TFindDeclarationTool.FindUnitSource Search in current dir=',CurDir);
{$ENDIF}
Result:=SearchUnitFileInDir(CurDir,AnUnitName);
Result:=SearchUnitFileInDir(CurDir,AnUnitName,true);
if Result=nil then begin
// search in search path
// search source in search path
{$IFDEF ShowTriedFiles}
writeln('TFindDeclarationTool.FindUnitSource Search in search path=',UnitSrcSearchPath);
{$ENDIF}
Result:=SearchUnitFileInPath(UnitSrcSearchPath,AnUnitName);
if Result=nil then begin
// search in FPC source directory
Result:=SearchUnitInUnitLinks(AnUnitName);
Result:=SearchUnitFileInPath(UnitSrcSearchPath,AnUnitName,true);
end;
if Result=nil then begin
{$IFDEF ShowTriedFiles}
writeln('TFindDeclarationTool.FindUnitSource Search Compiled unit in current dir=',CurDir);
{$ENDIF}
// search compiled unit in current directory
if Scanner.InitialValues.IsDefined('WIN32') then
CompiledSrcExt:='.ppw';
CompiledResult:=SearchUnitFileInDir(CurDir,AnUnitName,false);
if CompiledResult=nil then begin
// search compiled unit in search path
{$IFDEF ShowTriedFiles}
writeln('TFindDeclarationTool.FindUnitSource Search Compiled unit in search path=',UnitSrcSearchPath);
{$ENDIF}
CompiledResult:=SearchUnitFileInPath(UnitSrcSearchPath,AnUnitName,false);
end;
if (CompiledResult<>nil) then begin
// there is a compiled unit
if Assigned(OnGetSrcPathForCompiledUnit)
and (not CompiledResult.IsVirtual) then begin
UnitSrcSearchPath:=
OnGetSrcPathForCompiledUnit(Self,CompiledResult.Filename);
CurDir:=ExtractFilePath(CompiledResult.Filename);
// search source in search path of compiled unit
{$IFDEF ShowTriedFiles}
writeln('TFindDeclarationTool.FindUnitSource Search in Compiled unit search path=',UnitSrcSearchPath);
{$ENDIF}
Result:=SearchUnitFileInPath(UnitSrcSearchPath,AnUnitName,true);
end;
end;
end;
if Result=nil then begin
// search in FPC source directory
Result:=SearchUnitInUnitLinks(AnUnitName);
end;
end;
if (Result=nil) and Assigned(OnFindUsedUnit) then begin