From 48195f2943c678a14c3cc55ee19f77a1921b14fa Mon Sep 17 00:00:00 2001 From: mattias Date: Fri, 23 Jan 2004 19:36:49 +0000 Subject: [PATCH] fixed searching dir in searchpath under win32 git-svn-id: trunk@5090 - --- components/codetools/sourcechanger.pas | 55 ++++++++++++++++---------- components/codetools/stdcodetools.pas | 13 +++--- ide/delphiunit2laz.pas | 16 ++++++-- ide/ideprocs.pp | 37 ++++++++++++----- lcl/filectrl.pp | 5 +++ lcl/include/filectrl.inc | 38 ++++++++++++++++++ tools/install/create_lazarus_rpm.sh | 2 +- 7 files changed, 126 insertions(+), 40 deletions(-) diff --git a/components/codetools/sourcechanger.pas b/components/codetools/sourcechanger.pas index 5637500d13..dcb3057820 100644 --- a/components/codetools/sourcechanger.pas +++ b/components/codetools/sourcechanger.pas @@ -390,35 +390,49 @@ end; function TSourceChangeCache.FindEntryInRange( FromPos, ToPos: integer): TSourceChangeCacheEntry; var ANode: TAVLTreeNode; + NextNode: TAVLTreeNode; begin ANode:=FEntries.Root; + // find nearest node to FromPos while ANode<>nil do begin Result:=TSourceChangeCacheEntry(ANode.Data); - if Result.ToPos<=FromPos then - ANode:=ANode.Left - else if Result.FromPos>=ToPos then - ANode:=ANode.Right + if FromPos<=Result.FromPos then + NextNode:=ANode.Left else - exit; + NextNode:=ANode.Right; + if NextNode=nil then begin + // ANode is now one behind or at the first candidate + NextNode:=FEntries.FindPrecessor(ANode); + if NextNode<>nil then begin + ANode:=NextNode; + Result:=TSourceChangeCacheEntry(ANode.Data); + end; + while (Result.FromPosFromPos) then begin + // entry intersects range + exit; + end; + ANode:=FEntries.FindSuccessor(ANode); + if ANode=nil then begin + Result:=nil; + exit; + end; + Result:=TSourceChangeCacheEntry(ANode.Data); + end; + // not found + break; + end; + ANode:=NextNode; end; Result:=nil; end; function TSourceChangeCache.FindEntryAtPos( APos: integer): TSourceChangeCacheEntry; -var ANode: TAVLTreeNode; begin - ANode:=FEntries.Root; - while ANode<>nil do begin - Result:=TSourceChangeCacheEntry(ANode.Data); - if Result.ToPos<=APos then - ANode:=ANode.Left - else if Result.FromPos>APos then - ANode:=ANode.Right - else - exit; - end; - Result:=nil; + Result:=FindEntryInRange(APos,APos); end; function TSourceChangeCache.ReplaceEx(FrontGap, AfterGap: TGapTyp; @@ -505,10 +519,12 @@ begin end; if ToPos>FromPos then begin - // this is a delete operation -> check the whole range for writable buffers + // this is a replace/delete operation + // -> check the whole range for writable buffers if not MainScanner.WholeRangeIsWritable(FromPos,ToPos,true) then exit; end else if (DirectCode<>nil) and (FromDirectPos check if the DirectCode is writable + // this is a direct replace/delete operation + // -> check if the DirectCode is writable if DirectCode.ReadOnly then RaiseCodeReadOnly(DirectCode); end; @@ -1285,7 +1301,6 @@ procedure TBeautifyCodeOptions.WriteDebugReport; begin writeln('TBeautifyCodeOptions.WriteDebugReport Consistency=', ConsistencyCheck); - end; { ESourceChangeCacheError } diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index 0e88465afa..01ebbfa669 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -565,19 +565,20 @@ begin if (UpperUnitName='') or (length(UpperUnitName)>255) or (SourceChangeCache=nil) then exit; BuildTree(false); - Result:=true; SectionNode:=Tree.Root; while (SectionNode<>nil) do begin - if (SectionNode.Desc in [ctnProgram,ctnInterface,ctnImplementation]) then - begin - if RemoveUnitFromUsesSection(SectionNode.FirstChild,UpperUnitName, - SourceChangeCache) then begin - Result:=RemoveUnitFromAllUsesSections(UpperUnitName,SourceChangeCache); + if (SectionNode.Desc in [ctnProgram,ctnInterface,ctnImplementation]) + and (SectionNode.FirstChild<>nil) + and (SectionNode.FirstChild.Desc=ctnUsesSection) then begin + if not RemoveUnitFromUsesSection(SectionNode.FirstChild,UpperUnitName, + SourceChangeCache) + then begin exit; end; end; SectionNode:=SectionNode.NextBrother; end; + Result:=true; end; function TStandardCodeTool.FindUsedUnits(var MainUsesSection, diff --git a/ide/delphiunit2laz.pas b/ide/delphiunit2laz.pas index 67ff40cb03..0de7096a35 100644 --- a/ide/delphiunit2laz.pas +++ b/ide/delphiunit2laz.pas @@ -83,18 +83,28 @@ begin end; function CheckFilenameForLCLPaths(const Filename: string): TModalResult; +// check if the unitpath of the directory of filename contains the path to the +// LCL var Directory: String; UnitPath: String; LazarusSrcDir: string; LCLPath: String; + NextStartPos: Integer; begin + // get directory of filename Directory:=ExtractFilePath(Filename); + // get unitpath definition of directory UnitPath:=CodeToolBoss.GetUnitPathForDirectory(Directory); + // get lazarus source directory LazarusSrcDir:= CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'LazarusDir']; - LCLPath:=TrimFilename(LazarusSrcDir+PathDelim+'lcl'+PathDelim+'units'); - if SearchDirectoryInSearchPath(UnitPath,LCLPath,1)<1 then begin + // create base path to LCL compiled units /lcl/units/ + LCLPath:=TrimFilename(LazarusSrcDir+SetDirSeparators('/lcl/units/')); + NextStartPos:=1; + writeln('CheckFilenameForLCLPaths UnitPath="',UnitPath,'" LCLPath="',LCLPath,'"'); + if GetNextUsedDirectoryInSearchPath(UnitPath,LCLPath,NextStartPos)='' then begin + LCLPath:=LCLPath+'$(TargetCPU)'+PathDelim+'$(TargetOS)'; Result:=MessageDlg('LCL unit path missing', 'The current unit path for the file'#13 +'"'+Filename+'" is'#13 @@ -103,7 +113,7 @@ begin +'The path to the LCL units "'+LCLPath+'" is missing.'#13 +#13 +'Hint for newbies:'#13 - +'Create a lazarus application and put the file into project directory.', + +'Create a lazarus application and put the file into the project directory.', mtError,[mbCancel,mbAbort],0); exit; end; diff --git a/ide/ideprocs.pp b/ide/ideprocs.pp index b1555b6a51..b458849330 100644 --- a/ide/ideprocs.pp +++ b/ide/ideprocs.pp @@ -112,6 +112,8 @@ function CreateRelativeSearchPath(const SearchPath, BaseDirectory: string): stri function ShortenSearchPath(const SearchPath, BaseDirectory, ChompDirectory: string): string; function GetNextDirectoryInSearchPath(const SearchPath: string; var NextStartPos: integer): string; +function GetNextUsedDirectoryInSearchPath(const SearchPath, + FilterDir: string; var NextStartPos: integer): string; function SearchDirectoryInSearchPath(const SearchPath, Directory: string; DirStartPos: integer): integer; @@ -464,7 +466,8 @@ var begin PathLen:=length(SearchPath); repeat - while (NextStartPos<=PathLen) and (SearchPath[NextStartPos]=';') do + while (NextStartPos<=PathLen) + and (SearchPath[NextStartPos] in [';',#0..#32]) do inc(NextStartPos); CurStartPos:=NextStartPos; while (NextStartPos<=PathLen) and (SearchPath[NextStartPos]<>';') do @@ -475,6 +478,22 @@ begin Result:=''; end; +function GetNextUsedDirectoryInSearchPath(const SearchPath, + FilterDir: string; var NextStartPos: integer): string; +// searches next directory in search path, +// which is equal to FilterDir or is in FilterDir +begin + while (NextStartPos<=length(SearchPath)) do begin + Result:=GetNextDirectoryInSearchPath(SearchPath,NextStartPos); + if (Result<>'') + and ((CompareFilenames(Result,FilterDir)=0) + or FileIsInPath(Result,FilterDir)) + then + exit; + end; + Result:='' +end; + function SearchDirectoryInSearchPath(const SearchPath, Directory: string; DirStartPos: integer): integer; var @@ -484,7 +503,6 @@ var StartPos: Integer; DirEndPos: Integer; CurDirLen: Integer; - i: Integer; CurDirEndPos: Integer; begin Result:=-1; @@ -506,7 +524,7 @@ begin EndPos:=1; while EndPos<=PathLen do begin StartPos:=EndPos; - while (SearchPath[StartPos]=';') do begin + while (SearchPath[StartPos] in [';',#0..#32]) do begin inc(StartPos); if StartPos>PathLen then exit; end; @@ -523,13 +541,12 @@ begin if CurDirEndPos=StartPos then CurDirEndPos:=StartPos+1; end; if CurDirEndPos-StartPos=CurDirLen then begin - i:=CurDirLen-1; - while i>=0 do begin - if SearchPath[StartPos+i]<>Directory[DirStartPos+i] then break; - dec(i); - end; - if i<0 then begin - + // directories have same length -> compare chars + if FileCtrl.CompareFilenames(@SearchPath[StartPos],CurDirLen, + @Directory[DirStartPos],CurDirLen, + false)=0 + then begin + // directory found Result:=StartPos; exit; end; diff --git a/lcl/filectrl.pp b/lcl/filectrl.pp index 64dd92e453..825391bc8d 100644 --- a/lcl/filectrl.pp +++ b/lcl/filectrl.pp @@ -47,6 +47,8 @@ uses function CompareFilenames(const Filename1, Filename2: string): integer; function CompareFilenames(const Filename1, Filename2: string; ResolveLinks: boolean): integer; +function CompareFilenames(Filename1: PChar; Len1: integer; + Filename2: PChar; Len2: integer; ResolveLinks: boolean): integer; function FilenameIsAbsolute(TheFilename: string):boolean; procedure CheckIfFileIsExecutable(const AFilename: string); procedure CheckIfFileIsSymlink(const AFilename: string); @@ -127,6 +129,9 @@ end. { $Log$ + Revision 1.21 2004/01/23 19:36:49 mattias + fixed searching dir in searchpath under win32 + Revision 1.20 2003/12/21 13:58:06 mattias renamed DirectoryExists to DirPathExists to reduce ambigiousity diff --git a/lcl/include/filectrl.inc b/lcl/include/filectrl.inc index 909c389b1a..390f64940c 100644 --- a/lcl/include/filectrl.inc +++ b/lcl/include/filectrl.inc @@ -66,6 +66,41 @@ begin Result:=CompareFilenames(File1,File2); end; +function CompareFilenames(Filename1: PChar; Len1: integer; + Filename2: PChar; Len2: integer; ResolveLinks: boolean): integer; +var + File1: string; + File2: string; + i: Integer; +begin + if (Len1=0) or (Len2=0) then begin + Result:=Len1-Len2; + exit; + end; + if ResolveLinks then begin + SetLength(File1,Len1); + Move(Filename1^,File1[1],Len1); + SetLength(File2,Len2); + Move(Filename2^,File2[1],Len2); + Result:=CompareFilenames(File1,File2); + end else begin + Result:=0; + i:=1; + while (Result=0) and ((i<=Len1) and (i<=Len2)) do begin + {$IFDEF Win32} + Result:=Ord(LowerCaseTable[Ord(Filename1[i])]) + -Ord(LowerCaseTable[Ord(Filename2[i])]); //!! Must be replaced by ansi characters !! + {$ELSE} + Result:=Ord(Filename1[i]) + -Ord(Filename2[i]); //!! Must be replaced by ansi characters !! + {$ENDIF} + Inc(i); + end; + if Result=0 Then + Result:=Len1-Len2; + end; +end; + {------------------------------------------------------------------------------ function FilenameIsAbsolute(TheFilename: string):boolean; ------------------------------------------------------------------------------} @@ -898,6 +933,9 @@ end; { $Log$ + Revision 1.41 2004/01/23 19:36:49 mattias + fixed searching dir in searchpath under win32 + Revision 1.40 2004/01/03 20:19:22 mattias fixed reopening virtual files diff --git a/tools/install/create_lazarus_rpm.sh b/tools/install/create_lazarus_rpm.sh index eb8f323604..10fb166315 100644 --- a/tools/install/create_lazarus_rpm.sh +++ b/tools/install/create_lazarus_rpm.sh @@ -15,7 +15,7 @@ if [ "x$FPCRPM" = "x" ]; then exit fi -Date=20$Year$Month$Day +Date=$Year$Month$Day LazVersion=0.9.0.9 LazRelease=`echo $FPCRPM | sed -e 's/-/_/g'` SrcTGZ=lazarus-$Date.tgz