فهرست منبع

* Amiga fixes (among others)

Tomas Hajny 23 سال پیش
والد
کامیت
5592fb0dae
1فایلهای تغییر یافته به همراه54 افزوده شده و 34 حذف شده
  1. 54 34
      rtl/inc/fexpand.inc

+ 54 - 34
rtl/inc/fexpand.inc

@@ -40,7 +40,11 @@ var
 begin
   OldInOutRes := InOutRes;
   InOutRes := 0;
+{$IFDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
+  GetDir (0, Dir);
+{$ELSE FPC_FEXPAND_NO_DEFAULT_PATHS}
   GetDir (VolumeName, Dir);
+{$ENDIF FPC_FEXPAND_NO_DEFAULT_PATHS}
   InOutRes := OldInOutRes;
 end;
 {$ENDIF FPC_FEXPAND_VOLUMES}
@@ -51,9 +55,8 @@ function FExpand (const Path: PathStr): PathStr;
 (* LFNSupport boolean constant, variable or function must be declared for all
    the platforms, at least locally in the Dos unit implementation part.
    In addition, FPC_FEXPAND_UNC, FPC_FEXPAND_DRIVES, FPC_FEXPAND_GETENV_PCHAR,
-   FPC_FEXPAND_TILDE and FPC_FEXPAND_VOLUMES conditionals might be defined to
-   specify FExpand behaviour. Only forward slashes are supported if UNIX
-   conditional is defined, both forward and backslashes otherwise.
+   FPC_FEXPAND_TILDE, FPC_FEXPAND_VOLUMES and FPC_FEXPAND_NO_DEFAULT_PATHS
+   conditionals might be defined to specify FExpand behaviour.
 *)
 
 {$IFDEF FPC_FEXPAND_DRIVES}
@@ -68,7 +71,7 @@ var
     RootNotNeeded: boolean;
 {$ELSE FPC_FEXPAND_UNC}
 const
- RootNotNeeded = false;
+    RootNotNeeded = false;
 {$ENDIF FPC_FEXPAND_UNC}
 
 var S, Pa, Dirs: PathStr;
@@ -78,27 +81,35 @@ begin
 {$IFDEF FPC_FEXPAND_UNC}
     RootNotNeeded := false;
 {$ENDIF FPC_FEXPAND_UNC}
-{$IFDEF FPC_FEXPAND_DRIVES}
-    PathStart := 3;
-{$ENDIF FPC_FEXPAND_DRIVES}
     if FileNameCaseSensitive then
         Pa := Path
     else
         Pa := UpCase (Path);
-{$IFNDEF UNIX}
+    if DirectorySeparator = '\' then
     {Allow slash as backslash}
-    for I := 1 to Length (Pa) do
-        if Pa [I] = '/' then
-            Pa [I] := DirectorySeparator;
-{$ELSE}
+        begin
+            for I := 1 to Length (Pa) do
+                if Pa [I] = '/' then
+                    Pa [I] := DirectorySeparator
+        end
+    else
     {Allow backslash as slash}
-    for I := 1 to Length (Pa) do
-        if Pa [I] = '\' then
-            Pa [I] := DirectorySeparator;
-{$ENDIF UNIX}
-{$IFDEF FPC_FEXPAND_VOLUMES}
+        begin
+            for I := 1 to Length (Pa) do
+                if Pa [I] = '\' then
+                    Pa [I] := DirectorySeparator;
+        end;
+{$IFDEF FPC_FEXPAND_DRIVES}
+ {$IFDEF FPC_FEXPAND_VOLUMES}
+  {$IFDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
+    PathStart := Pos (DriveSeparator, Pa);
+  {$ELSE FPC_FEXPAND_NO_DEFAULT_PATHS}
     PathStart := Succ (Pos (DriveSeparator, Pa));
-{$ENDIF FPC_FEXPAND_VOLUMES}
+  {$ENDIF FPC_FEXPAND_NO_DEFAULT_PATHS}
+ {$ELSE FPC_FEXPAND_VOLUMES}
+    PathStart := 3;
+ {$ENDIF FPC_FEXPAND_VOLUMES}
+{$ENDIF FPC_FEXPAND_DRIVES}
 {$IFDEF FPC_FEXPAND_TILDE}
     {Replace ~/ with $HOME/}
     if (Length (Pa) >= 1) and (Pa [1] = '~') and
@@ -127,24 +138,25 @@ begin
 {$ENDIF FPC_FEXPAND_VOLUMES}
         begin
 {$IFDEF FPC_FEXPAND_DRIVES}
- {$IFDEF FPC_FEXPAND_VOLUMES}
+ {$IFNDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
+  {$IFDEF FPC_FEXPAND_VOLUMES}
             GetDirIO (Copy (Pa, 1, PathStart - 2), S);
- {$ELSE FPC_FEXPAND_VOLUMES}
+  {$ELSE FPC_FEXPAND_VOLUMES}
             { Always uppercase driveletter }
             if (Pa [1] in ['a'..'z']) then
                 Pa [1] := Chr (Ord (Pa [1]) and not ($20));
             GetDirIO (Ord (Pa [1]) - Ord ('A') + 1, S);
- {$ENDIF FPC_FEXPAND_VOLUMES}
+  {$ENDIF FPC_FEXPAND_VOLUMES}
             if Length (Pa) = Pred (PathStart) then
                 Pa := S
             else
                 if Pa [PathStart] <> DirectorySeparator then
- {$IFDEF FPC_FEXPAND_VOLUMES}
+  {$IFDEF FPC_FEXPAND_VOLUMES}
                     if Copy (Pa, 1, PathStart - 2) = Copy (S, 1, PathStart - 2)
                                                                            then
- {$ELSE FPC_FEXPAND_VOLUMES}
+  {$ELSE FPC_FEXPAND_VOLUMES}
                     if Pa [1] = S [1] then
- {$ENDIF FPC_FEXPAND_VOLUMES}
+  {$ENDIF FPC_FEXPAND_VOLUMES}
                         begin
                             { remove ending slash if it already exists }
                             if S [Length (S)] = DirectorySeparator then
@@ -153,14 +165,15 @@ begin
                               Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
                         end
                     else
- {$IFDEF FPC_FEXPAND_VOLUMES}
+  {$IFDEF FPC_FEXPAND_VOLUMES}
                         Pa := Copy (Pa, 1, PathStart - 2) + DriveSeparator
                            + DirectorySeparator +
                               Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
- {$ELSE FPC_FEXPAND_VOLUMES}
+  {$ELSE FPC_FEXPAND_VOLUMES}
                         Pa := Pa [1] + DriveSeparator + DirectorySeparator +
                               Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
- {$ENDIF FPC_FEXPAND_VOLUMES}
+  {$ENDIF FPC_FEXPAND_VOLUMES}
+ {$ENDIF FPC_FEXPAND_NO_DEFAULT_PATHS}
         end
     else
 {$ELSE FPC_FEXPAND_DRIVES}
@@ -173,9 +186,12 @@ begin
         begin
             GetDirIO (0, S);
 {$IFDEF FPC_FEXPAND_DRIVES}
+ {$IFDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
+                PathStart := Pos (DriveSeparator, S);
+ {$ELSE FPC_FEXPAND_NO_DEFAULT_PATHS}
             if (Length (Pa) > 0) and (Pa [1] = DirectorySeparator) then
                 begin
- {$IFDEF FPC_FEXPAND_UNC}
+  {$IFDEF FPC_FEXPAND_UNC}
                     {Do not touch network drive names}
                     if (Length (Pa) > 1) and (Pa [2] = DirectorySeparator)
                                                             and LFNSupport then
@@ -204,18 +220,19 @@ begin
                                     end;
                         end
                     else
- {$ENDIF FPC_FEXPAND_UNC}
- {$IFDEF FPC_FEXPAND_VOLUMES}
+  {$ENDIF FPC_FEXPAND_UNC}
+  {$IFDEF FPC_FEXPAND_VOLUMES}
                         begin
                             I := Pos (DriveSeparator, S);
                             Pa := Copy (S, 1, Pred (I)) + DriveSeparator + Pa;
                             PathStart := Succ (I);
                         end;
- {$ELSE FPC_FEXPAND_VOLUMES}
+  {$ELSE FPC_FEXPAND_VOLUMES}
                         Pa := S [1] + DriveSeparator + Pa;
- {$ENDIF FPC_FEXPAND_VOLUMES}
+  {$ENDIF FPC_FEXPAND_VOLUMES}
                 end
             else
+ {$ENDIF FPC_FEXPAND_NO_DEFAULT_PATHS}
 {$ENDIF FPC_FEXPAND_DRIVES}
                 (* We already have a slash if root is the curent directory. *)
                 if Length (S) = PathStart then
@@ -253,7 +270,7 @@ begin
     if (I <> 0) and (I = Length (Dirs) - 2) then
         begin
             J := Pred (I);
-            while (J >= 0) and (Dirs [J] <> DirectorySeparator) do
+            while (J > 0) and (Dirs [J] <> DirectorySeparator) do
                 Dec (J);
             if (J = 0) then
                 Dirs := ''
@@ -306,7 +323,10 @@ end;
 
 {
   $Log$
-  Revision 1.12  2002-11-24 15:49:22  hajny
+  Revision 1.13  2002-11-25 21:03:57  hajny
+    * Amiga fixes (among others)
+
+  Revision 1.12  2002/11/24 15:49:22  hajny
     * make use of constants available in the system unit
 
   Revision 1.11  2002/09/07 15:07:45  peter