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

MG: IDE and codetools work now with trimmed filenames

Browse Source 
git-svn-id: trunk@1642 -
This commit is contained in:
lazarus 2002-04-26 13:50:15 +00:00
parent 711208a191
commit 486bb0667d
4 changed files with 185 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
components/codetools/codecache.pas
View File

@ -58,7 +58,7 @@ type
FIsVirtual: boolean;
FIsDeleted: boolean;
function GetLastIncludedByFile: string;
procedure SetFilename(const Value: string);
procedure SetFilename(Value: string);
procedure SetScanner(const Value: TLinkScanner);
procedure SetIsDeleted(const NewValue: boolean);
procedure MakeFileDateValid;
@ -117,7 +117,7 @@ type
procedure UpdateIncludeLinks;
public
function Count: integer;
function FindFile(const AFilename: string): TCodeBuffer;
function FindFile(AFilename: string): TCodeBuffer;
function LoadFile(const AFilename: string): TCodeBuffer;
function CreateFile(const AFilename: string): TCodeBuffer;
function SaveBufferAs(OldBuffer: TCodeBuffer; const AFilename: string;
@ -203,17 +203,18 @@ begin
inherited Destroy;
end;
function TCodeCache.FindFile(const AFilename: string): TCodeBuffer;
function TCodeCache.FindFile(AFilename: string): TCodeBuffer;
var c: integer;
ANode: TAVLTreeNode;
begin
AFilename:=TrimFilename(AFilename);
ANode:=FItems.Root;
while ANode<>nil do begin
Result:=TCodeBuffer(ANode.Data);
c:=CompareFilenames(AFilename,Result.Filename);
{$IFDEF CTDEBUG}
if c=0 then writeln(' File found !!! ',Result.Filename);
{$ENDIF}
{$IFDEF CTDEBUG}
if c=0 then writeln(' File found !!! ',Result.Filename);
{$ENDIF}
if c<0 then ANode:=ANode.Left
else if c>0 then ANode:=ANode.Right
else exit;
@ -229,7 +230,8 @@ begin
// load new buffer
Result:=TCodeBuffer.Create;
Result.Filename:=AFilename;
if (not FileExists(AFilename)) or (not Result.LoadFromFile(AFilename)) then
if (not FileExists(Result.Filename))
or (not Result.LoadFromFile(Result.Filename)) then
begin
Result.Free;
Result:=nil;
@ -238,8 +240,8 @@ begin
FItems.Add(Result);
with Result do begin
FCodeCache:=Self;
LastIncludedByFile:=FindIncludeLink(AFilename);
ReadOnly:=not FileIsWritable(Filename);
LastIncludedByFile:=FindIncludeLink(Result.Filename);
ReadOnly:=not FileIsWritable(Result.Filename);
end;
end else if Result.IsDeleted then begin
// file in cache, but marked as deleted -> load from disk
@ -261,7 +263,7 @@ begin
Result.FileName:=AFileName;
FItems.Add(Result);
Result.FCodeCache:=Self;
Result.LastIncludedByFile:=FindIncludeLink(AFilename);
Result.LastIncludedByFile:=FindIncludeLink(Result.Filename);
end;
end;
@ -685,13 +687,14 @@ begin
if Result=Filename then Result:='';
end;
procedure TCodeBuffer.SetFilename(const Value: string);
procedure TCodeBuffer.SetFilename(Value: string);
var OldFilename: string;
begin
Value:=TrimFilename(Value);
if FFilename=Value then exit;
OldFilename:=FFilename;
FFilename := Value;
FIsVirtual:=(ExpandFilename(FFilename)<>FFilename);
FIsVirtual:=not FilenameIsAbsolute(Filename);
if CompareFilenames(OldFileName,Value)<>0 then begin
FFileDateValid:=false;
end;

38
components/codetools/fileprocs.pas
View File

@ -299,15 +299,16 @@ begin
inc(SrcPos,2);
continue;
{$ENDIF}
end else begin
DirStart:=DestPos;
while (DirStart>1) and (Result[DirStart-1]<>PathDelim) do
dec(DirStart);
if (DestPos-DirStart=2) and (Result[DirStart]='.')
and (Result[DirStart+1]='.') then begin
// 6. xxx../.. -> copy
end else if (DestPos>1) and (Result[DestPos-1]=PathDelim) then begin
if (DestPos>3)
and (Result[DestPos-2]='.') and (Result[DestPos-3]='.')
and ((DestPos=4) or (Result[DestPos-4]=PathDelim)) then begin
// 6. ../.. -> copy
end else begin
// 7. xxxdir/.. -> trim dir and skip ..
DirStart:=DestPos-2;
while (DirStart>1) and (Result[DirStart-1]<>PathDelim) do
dec(DirStart);
DestPos:=DirStart;
inc(SrcPos,2);
continue;
@ -352,10 +353,12 @@ function SearchFileInPath(const Filename, BasePath, SearchPath,
Delimiter: string; SearchLoUpCase: boolean): string;
function FileDoesExists(const AFilename: string): boolean;
var s: string;
begin
Result:=FileExists(AFilename);
s:=ExpandFilename(TrimFilename(AFilename));
Result:=FileExists(s);
if Result then begin
SearchFileInPath:=ExpandFilename(AFilename);
SearchFileInPath:=s;
exit;
end;
{$IFNDEF Win32}
@ -376,13 +379,20 @@ begin
end;
// check if filename absolute
if FilenameIsAbsolute(Filename) then begin
if FileDoesExists(Filename) then exit;
Result:='';
exit;
if FileExists(Filename) then begin
Result:=ExpandFilename(Filename);
exit;
end else begin
Result:='';
exit;
end;
end;
Base:=ExpandFilename(AppendPathDelim(BasePath));
// search in current directory
if FileDoesExists(Base+Filename) then exit;
if FileExists(Base+Filename) then begin
Result:=Base+Filename;
exit;
end;
// search in search path
StartPos:=1;
l:=length(SearchPath);
@ -394,7 +404,7 @@ begin
if not FilenameIsAbsolute(CurPath) then
CurPath:=Base+CurPath;
Result:=ExpandFilename(AppendPathDelim(CurPath)+Filename);
if FileDoesExists(Result) then exit;
if FileExists(Result) then exit;
end;
StartPos:=p+1;
end;

154
ide/ideprocs.pp
View File

@ -30,6 +30,7 @@ function FileIsWritable(const AFilename: string): boolean;
function FileIsText(const AFilename: string): boolean;
function CompareFilenames(const Filename1, Filename2: string): integer;
function AppendPathDelim(const Path: string): string;
function TrimFilename(const AFilename: string): string;
function SearchFileInPath(const Filename, BasePath, SearchPath,
Delimiter: string): string;
procedure SplitCmdLine(const CmdLine: string;
@ -281,31 +282,36 @@ end;
function SearchFileInPath(const Filename, BasePath, SearchPath,
Delimiter: string): string;
function FileDoesExists(const AFilename: string): boolean;
var s: string;
begin
s:=ExpandFilename(TrimFilename(AFilename));
Result:=FileExists(s);
if Result then begin
SearchFileInPath:=s;
exit;
end;
end;
var
p, StartPos, l: integer;
CurPath, Base: string;
begin
//writeln('[SearchFileInPath] Filename="',Filename,'" BasePath="',BasePath,'" SearchPath="',SearchPath,'" Delimiter="',Delimiter,'"');
if (Filename='') then begin
Result:=Filename;
Result:='';
exit;
end;
// check if filename absolute
if FilenameIsAbsolute(Filename) then begin
if FileExists(Filename) then begin
Result:=ExpandFilename(Filename);
exit;
end else begin
Result:='';
exit;
end;
end;
Base:=ExpandFilename(AppendPathDelim(BasePath));
// search in current directory
if FileExists(Base+Filename) then begin
Result:=Base+Filename;
if FileDoesExists(Filename) then exit;
Result:='';
exit;
end;
Base:=AppendPathDelim(BasePath);
// search in current directory
if FileDoesExists(Base+Filename) then exit;
// search in search path
StartPos:=1;
l:=length(SearchPath);
@ -316,8 +322,7 @@ begin
if CurPath<>'' then begin
if not FilenameIsAbsolute(CurPath) then
CurPath:=Base+CurPath;
Result:=ExpandFilename(AppendPathDelim(CurPath)+Filename);
if FileExists(Result) then exit;
if FileDoesExists(AppendPathDelim(CurPath)+Filename) then exit;
end;
StartPos:=p+1;
end;
@ -341,6 +346,125 @@ begin
Params:=RightStr(CmdLine,length(CmdLine)-p+1);
end;
function TrimFilename(const AFilename: string): string;
// trim double path delims, heading and trailing spaces
// and special dirs . and ..
var SrcPos, DestPos, l, DirStart: integer;
c: char;
begin
Result:=AFilename;
l:=length(AFilename);
SrcPos:=1;
DestPos:=1;
// skip trailing spaces
while (l>=1) and (AFilename[SrcPos]=' ') do dec(l);
// skip heading spaces
while (SrcPos<=l) and (AFilename[SrcPos]=' ') do inc(SrcPos);
// trim double path delims and special dirs . and ..
while (SrcPos<=l) do begin
c:=AFilename[SrcPos];
// check for double path delims
if (c=PathDelim) then begin
inc(SrcPos);
{$IFDEF win32}
if (DestPos>2)
{$ELSE}
if (DestPos>1)
{$ENDIF}
and (Result[DestPos-1]=PathDelim) then begin
// skip second PathDelim
continue;
end;
Result[DestPos]:=c;
inc(DestPos);
continue;
end;
// check for special dirs . and ..
if (c='.') then begin
if (SrcPos<l) then begin
if (AFilename[SrcPos+1]=PathDelim) then begin
// special dir ./
// -> skip
inc(SrcPos,2);
continue;
end else if (AFilename[SrcPos+1]='.')
and (SrcPos+1=l) or (AFilename[SrcPos+2]=PathDelim) then
begin
// special dir ..
// 1. .. -> copy
// 2. /.. -> skip .., keep /
// 3. C:.. -> copy
// 4. C:\.. -> skip .., keep C:\
// 5. \\.. -> skip .., keep \\
// 6. xxx../.. -> copy
// 7. xxxdir/.. -> trim dir and skip ..
if DestPos=1 then begin
// 1. .. -> copy
end else if (DestPos=2) and (Result[1]=PathDelim) then begin
// 2. /.. -> skip .., keep /
inc(SrcPos,2);
continue;
{$IFDEF win32}
end else if (DestPos=3) and (Result[2]=':')
and (Result[1] in ['a'..'z','A'..'Z']) then begin
// 3. C:.. -> copy
end else if (DestPos=4) and (Result[2]=':') and (Result[3]=PathDelim)
and (Result[1] in ['a'..'z','A'..'Z']) then begin
// 4. C:\.. -> skip .., keep C:\
inc(SrcPos,2);
continue;
end else if (DestPos=3) and (Result[1]=PathDelim)
and (Result[2]=PathDelim) then
// 5. \\.. -> skip .., keep \\
inc(SrcPos,2);
continue;
{$ENDIF}
end else if (DestPos>1) and (Result[DestPos-1]=PathDelim) then begin
if (DestPos>3)
and (Result[DestPos-2]='.') and (Result[DestPos-3]='.')
and ((DestPos=4) or (Result[DestPos-4]=PathDelim)) then begin
// 6. ../.. -> copy
end else begin
// 7. xxxdir/.. -> trim dir and skip ..
DirStart:=DestPos-2;
while (DirStart>1) and (Result[DirStart-1]<>PathDelim) do
dec(DirStart);
DestPos:=DirStart;
inc(SrcPos,2);
continue;
end;
end;
end;
end else begin
// special dir . at end of filename
if DestPos=1 then begin
Result:='.';
exit;
end else begin
// skip
break;
end;
end;
end;
// copy directory
repeat
Result[DestPos]:=c;
inc(DestPos);
inc(SrcPos);
if (SrcPos>l) then break;
c:=AFilename[SrcPos];
if c=PathDelim then break;
until false;
end;
// trim result
if DestPos<=length(AFilename) then
SetLength(Result,DestPos-1);
writeln(' TrimFilename "',AFilename,'" -> "',Result,'"');
end;
procedure FreeThenNil(var Obj: TObject);
begin
Obj.Free;

15
ide/main.pp
View File

@ -3491,7 +3491,7 @@ writeln('TMainIDE.DoCloseEditorUnit end');
Result:=mrOk;
end;
function TMainIDE.DoOpenEditorFile(const AFileName:string;
function TMainIDE.DoOpenEditorFile(const AFileName:string;
Flags: TOpenFlags):TModalResult;
var
i: integer;
@ -3513,7 +3513,6 @@ begin
Result:=DoOpenMainUnit(ofProjectLoading in Flags);
exit;
end;
// check if the project knows this file
i:=Project1.IndexOfFilename(AFilename);
ReOpen:=(i>=0);
@ -3998,7 +3997,7 @@ writeln('TMainIDE.DoOpenProjectFile A "'+AFileName+'"');
Result:=mrCancel;
if ExtractFileNameOnly(AFileName)='' then exit;
AFilename:=ExpandFileName(AFilename);
AFilename:=ExpandFileName(TrimFilename(AFilename));
Ext:=lowercase(ExtractFileExt(AFilename));
// check if file exists
@ -4044,13 +4043,11 @@ writeln('TMainIDE.DoOpenProjectFile B');
{$IFDEF IDE_MEM_CHECK}CheckHeap(IntToStr(GetMem_Cnt));{$ENDIF}
Project1:=TProject.Create(ptProgram);
Project1.OnFileBackup:=@DoBackupFile;
// read project info file
Project1.ReadProject(AFilename);
Result:=DoCompleteLoadingProjectInfo;
if Result<>mrOk then exit;
if Project1.MainUnit>=0 then begin
// read MainUnit Source
Result:=DoLoadCodeBuffer(NewBuf,Project1.MainFilename,
@ -4063,7 +4060,7 @@ writeln('TMainIDE.DoOpenProjectFile B');
writeln('TMainIDE.DoOpenProjectFile C');
{$ENDIF}
{$IFDEF IDE_MEM_CHECK}CheckHeap(IntToStr(GetMem_Cnt));{$ENDIF}
// restore files
LastEditorIndex:=-1;
repeat
@ -6060,8 +6057,7 @@ end;
procedure TMainIDE.mnuEditIndentBlockClicked(Sender: TObject);
begin
writeln('AAA1 TMainIDE.mnuEditIndentBlockClicked');
//DoEditMenuCommand(ecBlockIndent);
DoEditMenuCommand(ecBlockIndent);
end;
procedure TMainIDE.mnuEditUnindentBlockClicked(Sender: TObject);
@ -6241,6 +6237,9 @@ end.
{ =============================================================================
$Log$
Revision 1.286 2002/04/26 13:50:14 lazarus
MG: IDE and codetools work now with trimmed filenames
Revision 1.285 2002/04/26 12:53:29 lazarus
MG: fixed debug line coloring