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

MG: fixed used virtual files and IsPartOfProject Bug

Browse Source 
git-svn-id: trunk@3591 -
This commit is contained in:
lazarus 2002-10-30 22:28:50 +00:00
parent 9c8a49f63b
commit 038aaa7cb3
3 changed files with 59 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
components/codetools/codetoolmanager.pas
View File

@ -53,6 +53,9 @@ type
TOnAfterApplyChanges = procedure(Manager: TCodeToolManager) of object;
TCodeTool = TEventsCodeTool;
TOnSearchUsedUnit = function(const SrcFilename: string;
const TheUnitName, TheUnitInFilename: string): TCodeBuffer of object;
TCodeToolManager = class
private
@ -72,6 +75,7 @@ type
FJumpCentered: boolean;
FOnAfterApplyChanges: TOnAfterApplyChanges;
FOnBeforeApplyChanges: TOnBeforeApplyChanges;
FOnSearchUsedUnit: TOnSearchUsedUnit;
FResourceTool: TResourceCodeTool;
FSetPropertyVariablename: string;
FSourceExtensions: string; // default is '.pp;.pas;.lpr;.dpr;.dpk'
@ -85,6 +89,8 @@ type
procedure OnDefineTreeReadValue(Sender: TObject; const VariableName: string;
var Value: string);
procedure OnGlobalValuesChanged;
function DoOnFindUsedUnit(SrcTool: TFindDeclarationTool; const TheUnitName,
TheUnitInFilename: string): TCodeBuffer;
function GetMainCode(Code: TCodeBuffer): TCodeBuffer;
procedure CreateScanner(Code: TCodeBuffer);
function InitCurCodeTool(Code: TCodeBuffer): boolean;
@ -128,6 +134,8 @@ type
function SaveBufferAs(OldBuffer: TCodeBuffer;const ExpandedFilename: string;
var NewBuffer: TCodeBuffer): boolean;
function FilenameHasSourceExt(const AFilename: string): boolean;
property OnSearchUsedUnit: TOnSearchUsedUnit
read FOnSearchUsedUnit write FOnSearchUsedUnit;
// exception handling
property CatchExceptions: boolean
@ -1506,6 +1514,18 @@ begin
end;
end;
function TCodeToolManager.DoOnFindUsedUnit(SrcTool: TFindDeclarationTool;
const TheUnitName, TheUnitInFilename: string): TCodeBuffer;
var
AFilename: string;
begin
if Assigned(OnSearchUsedUnit) then
Result:=OnSearchUsedUnit(SrcTool.MainFilename,
TheUnitName,TheUnitInFilename)
else
Result:=nil;
end;
function TCodeToolManager.OnScannerGetInitValues(Code: Pointer;
var AChangeStep: integer): TExpressionEvaluator;
begin
@ -1652,6 +1672,7 @@ begin
Result.JumpCentered:=FJumpCentered;
Result.CursorBeyondEOL:=FCursorBeyondEOL;
TFindDeclarationTool(Result).OnGetCodeToolForBuffer:=@OnGetCodeToolForBuffer;
TFindDeclarationTool(Result).OnFindUsedUnit:=@DoOnFindUsedUnit;
Result.OnSetGlobalWriteLock:=@OnToolSetWriteLock;
Result.OnGetGlobalWriteLockInfo:=@OnToolGetWriteLockInfo;
end;

14
components/codetools/finddeclarationtool.pas
View File

@ -339,6 +339,8 @@ const
type
TOnIdentifierFound = function(Params: TFindDeclarationParams;
FoundContext: TFindContext): TIdentifierFoundResult of object;
TOnFindUsedUnit = function(SrcTool: TFindDeclarationTool;
const TheUnitName, TheUnitInFilename: string): TCodeBuffer of object;
TFindDeclarationInput = record
Flags: TFindDeclarationFlags;
@ -396,6 +398,7 @@ type
private
FInterfaceIdentifierCache: TInterfaceIdentifierCache;
FOnGetCodeToolForBuffer: TOnGetCodeToolForBuffer;
FOnFindUsedUnit: TOnFindUsedUnit;
FOnGetUnitSourceSearchPath: TOnGetSearchPath;
FFirstNodeCache: TCodeTreeNodeCache;
FLastNodeCachesGlobalWriteLockStep: integer;
@ -538,6 +541,8 @@ type
read FOnGetCodeToolForBuffer write FOnGetCodeToolForBuffer;
property OnGetUnitSourceSearchPath: TOnGetSearchPath
read FOnGetUnitSourceSearchPath write FOnGetUnitSourceSearchPath;
property OnFindUsedUnit: TOnFindUsedUnit
read FOnFindUsedUnit write FOnFindUsedUnit;
function ConsistencyCheck: integer; override;
end;
@ -1062,7 +1067,7 @@ function TFindDeclarationTool.FindUnitSource(const AnUnitName,
break;
end;
end;
var CurDir, UnitSrcSearchPath: string;
MainCodeIsVirtual: boolean;
@ -1096,7 +1101,8 @@ begin
if FilenameIsAbsolute(AnUnitInFilename) then begin
Result:=TCodeBuffer(Scanner.OnLoadSource(Self,AnUnitInFilename,true));
end else begin
// search file in current directory
// file is virtual
// -> search file in current directory
CurDir:=AppendPathDelim(CurDir);
if not LoadFile(CurDir+AnUnitInFilename,Result) then begin
// search AnUnitInFilename in searchpath
@ -1122,6 +1128,10 @@ begin
end;
end;
end;
if (Result=nil) and Assigned(OnFindUsedUnit) then begin
// no unit found
Result:=OnFindUsedUnit(Self,AnUnitName,AnUnitInFilename);
end;
end;
function TFindDeclarationTool.IsIncludeDirectiveAtPos(CleanPos,

29
ide/project.pp
View File

@ -285,9 +285,11 @@ type
function IndexOfUnitWithFormName(const AFormName: string;
OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo): integer;
function IndexOfFilename(const AFilename: string): integer;
function ProjectUnitWithFilename(const AFilename: string): TUnitInfo;
function ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo;
function UnitWithEditorIndex(Index:integer): TUnitInfo;
Function UnitWithForm(AForm: TComponent): TUnitInfo;
procedure CloseEditorIndex(EditorIndex:integer);
procedure InsertEditorIndex(EditorIndex:integer);
procedure MoveEditorIndex(OldEditorIndex, NewEditorIndex: integer);
@ -611,9 +613,9 @@ begin
fFilename:=AFilename;
fFormName:=XMLConfig.GetValue(Path+'FormName/Value','');
HasResources:=XMLConfig.GetValue(Path+'HasResources/Value',false);
fIsPartOfProject:=XMLConfig.GetValue(Path+'IsPartOfProject/Value',false);
IsPartOfProject:=XMLConfig.GetValue(Path+'IsPartOfProject/Value',false);
Loaded:=XMLConfig.GetValue(Path+'Loaded/Value',false);
fReadOnly:=XMLConfig.GetValue(Path+'ReadOnly/Value',false);
ReadOnly:=XMLConfig.GetValue(Path+'ReadOnly/Value',false);
AFilename:=XMLConfig.GetValue(Path+'ResourceFilename/Value','');
if Assigned(fOnLoadSaveFilename) then
fOnLoadSaveFilename(AFilename,true);
@ -1922,6 +1924,24 @@ begin
end;
end;
function TProject.ProjectUnitWithFilename(const AFilename: string): TUnitInfo;
begin
Result:=fFirstPartOfProject;
while Result<>nil do begin
if CompareFileNames(AFilename,Result.Filename)=0 then exit;
Result:=Result.NextPartOfProject;
end;
end;
function TProject.ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo;
begin
Result:=fFirstPartOfProject;
while Result<>nil do begin
if AnsiCompareText(AnUnitName,Result.UnitName)=0 then exit;
Result:=Result.NextPartOfProject;
end;
end;
procedure TProject.SetSrcPath(const NewSrcPath: string);
begin
if FSrcPath=NewSrcPath then exit;
@ -2080,6 +2100,9 @@ end.
{
$Log$
Revision 1.85 2002/10/30 22:28:49 lazarus
MG: fixed used virtual files and IsPartOfProject Bug
Revision 1.84 2002/10/26 15:15:43 lazarus
MG: broke LCL<->interface circles