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

38
components/codetools/fileprocs.pas
View File

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

154
ide/ideprocs.pp
View File

@ -30,6 +30,7 @@ function FileIsWritable(const AFilename: string): boolean;
function FileIsText(const AFilename: string): boolean; function FileIsText(const AFilename: string): boolean;
function CompareFilenames(const Filename1, Filename2: string): integer; function CompareFilenames(const Filename1, Filename2: string): integer;
function AppendPathDelim(const Path: string): string; function AppendPathDelim(const Path: string): string;
function TrimFilename(const AFilename: string): string;
function SearchFileInPath(const Filename, BasePath, SearchPath, function SearchFileInPath(const Filename, BasePath, SearchPath,
Delimiter: string): string; Delimiter: string): string;
procedure SplitCmdLine(const CmdLine: string; procedure SplitCmdLine(const CmdLine: string;
@ -281,31 +282,36 @@ end;
function SearchFileInPath(const Filename, BasePath, SearchPath, function SearchFileInPath(const Filename, BasePath, SearchPath,
Delimiter: string): string; 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 var
p, StartPos, l: integer; p, StartPos, l: integer;
CurPath, Base: string; CurPath, Base: string;
begin begin
//writeln('[SearchFileInPath] Filename="',Filename,'" BasePath="',BasePath,'" SearchPath="',SearchPath,'" Delimiter="',Delimiter,'"'); //writeln('[SearchFileInPath] Filename="',Filename,'" BasePath="',BasePath,'" SearchPath="',SearchPath,'" Delimiter="',Delimiter,'"');
if (Filename='') then begin if (Filename='') then begin
Result:=Filename; Result:='';
exit; exit;
end; end;
// check if filename absolute // check if filename absolute
if FilenameIsAbsolute(Filename) then begin if FilenameIsAbsolute(Filename) then begin
if FileExists(Filename) then begin if FileDoesExists(Filename) then exit;
Result:=ExpandFilename(Filename); Result:='';
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;
exit; exit;
end; end;
Base:=AppendPathDelim(BasePath);
// search in current directory
if FileDoesExists(Base+Filename) then exit;
// search in search path // search in search path
StartPos:=1; StartPos:=1;
l:=length(SearchPath); l:=length(SearchPath);
@ -316,8 +322,7 @@ begin
if CurPath<>'' then begin if CurPath<>'' then begin
if not FilenameIsAbsolute(CurPath) then if not FilenameIsAbsolute(CurPath) then
CurPath:=Base+CurPath; CurPath:=Base+CurPath;
Result:=ExpandFilename(AppendPathDelim(CurPath)+Filename); if FileDoesExists(AppendPathDelim(CurPath)+Filename) then exit;
if FileExists(Result) then exit;
end; end;
StartPos:=p+1; StartPos:=p+1;
end; end;
@ -341,6 +346,125 @@ begin
Params:=RightStr(CmdLine,length(CmdLine)-p+1); Params:=RightStr(CmdLine,length(CmdLine)-p+1);
end; 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); procedure FreeThenNil(var Obj: TObject);
begin begin
Obj.Free; Obj.Free;

15
ide/main.pp
View File

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