fixed searching dir in searchpath under win32

git-svn-id: trunk@5090 -

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.FromPos<ToPos) do begin
+        if (Result.FromPos<Result.ToPos) // entry has a range (is a delete operation)
+        and (Result.FromPos<ToPos)
+        and (Result.ToPos>FromPos) 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<ToDirectPos) then begin
-    // this is a direct delete operation -> 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 }

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,

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 <LazarusSrcDir>/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;

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;

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
 

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
 

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