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

codetools: search in virtual directory first virtual units

Browse Source 
git-svn-id: trunk@23652 -
This commit is contained in:
mattias 2010-02-06 01:23:13 +00:00
parent c5a6b22731
commit 0ca654e75d
3 changed files with 67 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
components/codetools/directorycacher.pas
View File

@ -983,10 +983,15 @@ begin
end else begin
// not found in cache -> search in complete source path
SrcPath:=Strings[ctdcsCompleteSrcPath];
// search in search path
Result:=FindUnitSourceInCleanSearchPath(AUnitName,SrcPath,AnyCase);
if Directory='' then begin
// virtual directory => search virtual unit
Result:=Pool.FindVirtualUnit(AUnitName);
end;
if Result='' then begin
// search in search path
SrcPath:=Strings[ctdcsCompleteSrcPath];
Result:=FindUnitSourceInCleanSearchPath(AUnitName,SrcPath,AnyCase);
end;
if Result='' then begin
// search in unit links
{$IFDEF ShowTriedUnits}
@ -1236,12 +1241,30 @@ end;
function TCTDirectoryCachePool.FindVirtualUnit(const AUnitName: string): string;
var
e: TCTPascalExtType;
CurUnitName:String;
begin
// search normal
for e:=Low(CTPascalExtension) to High(CTPascalExtension) do begin
if CTPascalExtension[e]='' then continue;
Result:=FindVirtualFile(AUnitName+CTPascalExtension[e]);
if Result<>'' then exit;
end;
// search lowercase
CurUnitName:=lowercase(AUnitName);
if CurUnitName<>AUnitName then begin
for e:=Low(CTPascalExtension) to High(CTPascalExtension) do begin
if CTPascalExtension[e]='' then continue;
Result:=FindVirtualFile(CurUnitName+CTPascalExtension[e]);
if Result<>'' then exit;
end;
end;
// search uppercase
CurUnitName:=uppercase(AUnitName);
for e:=Low(CTPascalExtension) to High(CTPascalExtension) do begin
if CTPascalExtension[e]='' then continue;
Result:=FindVirtualFile(CurUnitName+uppercase(CTPascalExtension[e]));
if Result<>'' then exit;
end;
Result:='';
end;

38
components/codetools/eventcodetool.pas
View File

@ -734,21 +734,27 @@ function TEventsCodeTool.CreateMethod(ClassNode: TCodeTreeNode;
end;
function FindPropertyType(out FindContext: TFindContext): boolean;
var
Tool: TFindDeclarationTool;
begin
Result:=false;
if APropertyPath<>'' then begin
// find unit of property
Tool:=nil;
FindContext:=CleanFindContext;
if APropertyUnitName='' then begin
FindContext.Tool:=Self;
Tool:=Self;
end else begin
FindContext.Tool:=FindCodeToolForUsedUnit(APropertyUnitName,'',true);
if FindContext.Tool=nil then
Tool:=FindCodeToolForUsedUnit(APropertyUnitName,'',true);
if Tool=nil then
raise Exception.Create('failed to get codetool for unit '+APropertyUnitName);
end;
// find property with type
if not FindContext.Tool.FindDeclarationOfPropertyPath(
APropertyPath,FindContext,true)
then exit;
if not Tool.FindDeclarationOfPropertyPath(APropertyPath,FindContext,true)
then begin
DebugLn(['FindPropertyType FindDeclarationOfPropertyPath failed: ',Tool.MainFilename,' APropertyPath=',APropertyPath]);
exit;
end;
if FindContext.Node.Desc<>ctnProperty then
FindContext.Tool.RaiseException(
APropertyPath+' is not a property.'
@ -775,9 +781,9 @@ begin
try
if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) or (AMethodName='')
or (ATypeInfo=nil) or (SourceChangeCache=nil) or (Scanner=nil) then exit;
{$IFDEF CTDEBUG}
{ $IFDEF CTDEBUG}
DebugLn(['[TEventsCodeTool.CreateMethod] A AMethodName="',AMethodName,'" in "',MainFilename,'" UseTypeInfoForParameters=',UseTypeInfoForParameters]);
{$ENDIF}
{ $ENDIF}
// initialize class for code completion
CodeCompleteClassNode:=ClassNode;
CodeCompleteSrcChgCache:=SourceChangeCache;
@ -798,9 +804,9 @@ begin
[phpWithoutClassName, phpWithoutName, phpInUpperCase]);
end;
if not ProcExistsInCodeCompleteClass(CleanMethodDefinition) then begin
{$IFDEF CTDEBUG}
{ $IFDEF CTDEBUG}
DebugLn('[TEventsCodeTool.CreateMethod] insert method definition to class');
{$ENDIF}
{ $ENDIF}
// insert method definition into class
InsertCall:='';
if UseTypeInfoForParameters then begin
@ -829,9 +835,9 @@ begin
phpWithoutParamTypes]));
end;
end;
{$IFDEF CTDEBUG}
{ $IFDEF CTDEBUG}
DebugLn('[TEventsCodeTool.CreateMethod] MethodDefinition="',MethodDefinition,'"');
{$ENDIF}
{ $ENDIF}
if Section in [pcsPublished,pcsPublic] then
NewSection:=ncpPublishedProcs
else
@ -856,9 +862,9 @@ begin
AddClassInsertion(CleanMethodDefinition, MethodDefinition, AMethodName,
NewSection,nil,ProcBody);
end;
{$IFDEF CTDEBUG}
{ $IFDEF CTDEBUG}
DebugLn('[TEventsCodeTool.CreateMethod] invoke class completion');
{$ENDIF}
{ $ENDIF}
if not InsertAllNewClassParts then
RaiseException(ctsErrorDuringInsertingNewClassParts);
if not CreateMissingProcBodies then
@ -869,9 +875,9 @@ begin
// apply the changes
if not SourceChangeCache.Apply then
RaiseException(ctsUnableToApplyChanges);
{$IFDEF CTDEBUG}
{ $IFDEF CTDEBUG}
DebugLn('[TEventsCodeTool.CreateMethod] END');
{$ENDIF}
{ $ENDIF}
Result:=true;
finally
FreeClassInsertionList;

33
components/codetools/finddeclarationtool.pas
View File

@ -1603,24 +1603,26 @@ begin
NewContext:=CleanFindContext;
//DebugLn('TFindDeclarationTool.FindDeclarationOfPropertyPath PropertyPath="',PropertyPath,'"');
if PropertyPath='' then exit;
BuildTree(false);
// first search the class/variable in the interface
StartPos:=1;
Identifier:=GetNextIdentifier;
if Identifier='' then exit;
Context.Tool:=Self;
Context.Node:=FindDeclarationNodeInInterface(Identifier,true);
if Context.Node=nil then begin
//DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath Identifier not found in interface ',Identifier]);
exit;
end;
Params:=TFindDeclarationParams.Create;
ActivateGlobalWriteLock;
Params:=TFindDeclarationParams.Create;
try
BuildTree(false);
//DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath ',Src]);
// first search the class/variable in the interface
StartPos:=1;
Identifier:=GetNextIdentifier;
if Identifier='' then exit;
Context.Tool:=Self;
Context.Node:=FindDeclarationNodeInInterface(Identifier,true);
if Context.Node=nil then begin
DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath Identifier not found in interface ',Identifier]);
exit;
end;
Context:=FindBaseTypeOfNode(Params,Context.Node);
if Context.Node=nil then begin
//DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath context not found']);
DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath context not found']);
exit;
end;
// then search the properties
@ -1988,9 +1990,10 @@ begin
begin
RaiseException('TFindDeclarationTool.FindUnitSource Invalid Data');
end;
NewUnitName:=AnUnitName;
NewInFilename:=AnUnitInFilename;
AFilename:=DirectoryCache.FindUnitSourceInCompletePath(
NewUnitName,NewInFilename,false);
Result:=TCodeBuffer(Scanner.OnLoadSource(Self,AFilename,true));