From be27984b3b1203d7fcf5aecdcedbe3214773cc9b Mon Sep 17 00:00:00 2001 From: Tomas Hajny Date: Sun, 1 Dec 2002 20:46:44 +0000 Subject: [PATCH] * Amiga support hopefully finished --- rtl/inc/fexpand.inc | 179 ++++++++++++++++++++++++++++++++++++++------ 1 file changed, 155 insertions(+), 24 deletions(-) diff --git a/rtl/inc/fexpand.inc b/rtl/inc/fexpand.inc index 525aad13ae..e500ad8d20 100644 --- a/rtl/inc/fexpand.inc +++ b/rtl/inc/fexpand.inc @@ -16,6 +16,20 @@ A platform independent FExpand implementation ****************************************************************************} +{$IFDEF FPC_FEXPAND_VOLUMES} + {$IFNDEF FPC_FEXPAND_DRIVES} + (* Volumes are just a special case of drives. *) + {$DEFINE FPC_FEXPAND_DRIVES} + {$ENDIF FPC_FEXPAND_DRIVES} +{$ENDIF FPC_FEXPAND_VOLUMES} + +{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR} + {$IFNDEF FPC_FEXPAND_DRIVESEP_IS_ROOT} + (* If DriveSeparator is used for upper directory, *) + (* it cannot be used for marking root at the same time. *) + {$DEFINE FPC_FEXPAND_DRIVESEP_IS_ROOT} + {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT} +{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR} procedure GetDirIO (DriveNr: byte; var Dir: OpenString); @@ -33,6 +47,7 @@ end; {$IFDEF FPC_FEXPAND_VOLUMES} +{$IFNDEF FPC_FEXPAND_NO_DEFAULT_PATHS} procedure GetDirIO (const VolumeName: OpenString; var Dir: OpenString); var @@ -40,13 +55,10 @@ 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_NO_DEFAULT_PATHS} {$ENDIF FPC_FEXPAND_VOLUMES} @@ -55,8 +67,10 @@ 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, FPC_FEXPAND_VOLUMES and FPC_FEXPAND_NO_DEFAULT_PATHS - conditionals might be defined to specify FExpand behaviour. + FPC_FEXPAND_TILDE, FPC_FEXPAND_VOLUMES, FPC_FEXPAND_NO_DEFAULT_PATHS, + FPC_FEXPAND_DRIVESEP_IS_ROOT, FPC_FEXPAND_NO_CURDIR, + FPC_FEXPAND_NO_DOTS_UPDIR and FPC_FEXPAND_DIRSEP_IS_UPDIR conditionals might + be defined to specify FExpand behaviour. *) {$IFDEF FPC_FEXPAND_DRIVES} @@ -81,10 +95,15 @@ begin {$IFDEF FPC_FEXPAND_UNC} RootNotNeeded := false; {$ENDIF FPC_FEXPAND_UNC} + +(* First convert the path to uppercase if appropriate for current platform. *) if FileNameCaseSensitive then Pa := Path else Pa := UpCase (Path); + +(* Allow both '/' and '\' as directory separators *) +(* by converting all to the native one. *) if DirectorySeparator = '\' then {Allow slash as backslash} begin @@ -99,17 +118,22 @@ begin if Pa [I] = '\' then Pa [I] := DirectorySeparator; end; + +(* PathStart is amount of characters to strip to get beginning *) +(* of path without volume/drive specification. *) {$IFDEF FPC_FEXPAND_DRIVES} {$IFDEF FPC_FEXPAND_VOLUMES} - {$IFDEF FPC_FEXPAND_NO_DEFAULT_PATHS} + {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT} PathStart := Pos (DriveSeparator, Pa); - {$ELSE FPC_FEXPAND_NO_DEFAULT_PATHS} + {$ELSE FPC_FEXPAND_DRIVESEP_IS_ROOT} PathStart := Succ (Pos (DriveSeparator, Pa)); - {$ENDIF FPC_FEXPAND_NO_DEFAULT_PATHS} + {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT} {$ELSE FPC_FEXPAND_VOLUMES} PathStart := 3; {$ENDIF FPC_FEXPAND_VOLUMES} {$ENDIF FPC_FEXPAND_DRIVES} + +(* Expand tilde to home directory if appropriate. *) {$IFDEF FPC_FEXPAND_TILDE} {Replace ~/ with $HOME/} if (Length (Pa) >= 1) and (Pa [1] = '~') and @@ -130,6 +154,8 @@ begin Pa := S + Copy (Pa, 2, Pred (Length (Pa))); end; {$ENDIF FPC_FEXPAND_TILDE} + +(* Do we have a drive/volume specification? *) {$IFDEF FPC_FEXPAND_VOLUMES} if PathStart > 1 then {$ELSE FPC_FEXPAND_VOLUMES} @@ -137,6 +163,9 @@ begin (Pa [2] = DriveSeparator) then {$ENDIF FPC_FEXPAND_VOLUMES} begin + +(* We need to know current directory on given *) +(* volume/drive _if_ such a thing is defined. *) {$IFDEF FPC_FEXPAND_DRIVES} {$IFNDEF FPC_FEXPAND_NO_DEFAULT_PATHS} {$IFDEF FPC_FEXPAND_VOLUMES} @@ -147,9 +176,15 @@ begin Pa [1] := Chr (Ord (Pa [1]) and not ($20)); GetDirIO (Ord (Pa [1]) - Ord ('A') + 1, S); {$ENDIF FPC_FEXPAND_VOLUMES} + +(* Do we have more than just drive/volume specification? *) if Length (Pa) = Pred (PathStart) then + +(* If not, just use the current directory for that drive/volume. *) Pa := S else + +(* If yes, find out whether the following path is relative or absolute. *) if Pa [PathStart] <> DirectorySeparator then {$IFDEF FPC_FEXPAND_VOLUMES} if Copy (Pa, 1, PathStart - 2) = Copy (S, 1, PathStart - 2) @@ -177,6 +212,9 @@ begin end else {$ELSE FPC_FEXPAND_DRIVES} + +(* If drives are not supported, but a drive *) +(* was supplied anyway, ignore (remove) it. *) Delete (Pa, 1, 2); end; {Check whether we don't have an absolute path already} @@ -184,14 +222,34 @@ begin (Length (Pa) < PathStart) then {$ENDIF FPC_FEXPAND_DRIVES} begin + +(* Get current directory on selected drive/volume. *) GetDirIO (0, S); +{$IFDEF FPC_FEXPAND_VOLUMES} + {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT} + PathStart := Pos (DriveSeparator, S); + {$ELSE FPC_FEXPAND_DRIVESEP_IS_ROOT} + PathStart := Succ (Pos (DriveSeparator, S)); + {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT} +{$ENDIF FPC_FEXPAND_VOLUMES} + +(* Do we have an absolute path? *) {$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 + if (Length (Pa) > 0) + {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT} + and (Pa [1] = DriveSeparator) + {$ELSE FPC_FEXPAND_DRIVESEP_IS_ROOT} + and (Pa [1] = DirectorySeparator) + {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT} + {$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR} + {$IFNDEF FPC_FEXPAND_UNC} + or (Length (Pa) > 1) and (Pa [1] = DirectorySeparator) + and (Pa [2] = DirectorySeparator) + {$ENDIF FPC_FEXPAND_UNC} + {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR} + 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 @@ -220,33 +278,56 @@ 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); + {$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR} + {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT} + if (Pa [1] = DriveSeparator) then + Delete (Pa, 1, 1); + {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT} + Pa := Copy (S, 1, I) + Pa; + PathStart := I; + {$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR} Pa := Copy (S, 1, Pred (I)) + DriveSeparator + Pa; PathStart := Succ (I); + {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR} 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 Pa := S + Pa else - (* We need an ending slash if FExpand was called - with an empty string for compatibility. *) + + (* We need an ending slash if FExpand was called *) + (* with an empty string for compatibility, except *) + (* for platforms where this is invalid. *) if Length (Pa) = 0 then +{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR} + Pa := S +{$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR} Pa := S + DirectorySeparator +{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR} else + {$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR} + if Pa [1] = DirectorySeparator then + Pa := S + Pa + else + {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR} Pa := S + DirectorySeparator + Pa; end; + {Get string of directories to only process relative references on this one} Dirs := Copy (Pa, Succ (PathStart), Length (Pa) - PathStart); + +{$IFNDEF FPC_FEXPAND_NO_CURDIR} {First remove all references to '\.\'} I := Pos (DirectorySeparator + '.' + DirectorySeparator, Dirs); while I <> 0 do @@ -254,6 +335,9 @@ begin Delete (Dirs, I, 2); I := Pos (DirectorySeparator + '.' + DirectorySeparator, Dirs); end; +{$ENDIF FPC_FEXPAND_NO_CURDIR} + +{$IFNDEF FPC_FEXPAND_NO_DOTS_UPDIR} {Now remove also all references to '\..\' + of course previous dirs..} I := Pos (DirectorySeparator + '..' + DirectorySeparator, Dirs); while I <> 0 do @@ -264,6 +348,7 @@ begin Delete (Dirs, Succ (J), I - J + 3); I := Pos (DirectorySeparator + '..' + DirectorySeparator, Dirs); end; + {Then remove also a reference to '\..' at the end of line + the previous directory, of course,...} I := Pos (DirectorySeparator + '..', Dirs); @@ -277,6 +362,25 @@ begin else Delete (Dirs, Succ (J), I - J + 2); end; +{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR} + +{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR} + (* Remove a reference to '/' at the end *) + (* of line + the previous directory. *) + I := Length (Dirs); + if (I > 0) and (Dirs [I] = DirectorySeparator) then + begin + J := Pred (I); + while (J > 0) and (Dirs [J] <> DirectorySeparator) do + Dec (J); + if (J = 0) then + Dirs := '' + else + Delete (Dirs, J, Succ (I - J)); + end; +{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR} + +{$IFNDEF FPC_FEXPAND_NO_CURDIR} {...and also a possible reference to '\.'} if (Length (Dirs) = 1) then begin @@ -288,27 +392,49 @@ begin if (Length (Dirs) <> 0) and (Dirs [Length (Dirs)] = '.') and (Dirs [Pred (Length (Dirs))] = DirectorySeparator) then Dec (Dirs [0], 2); + {Finally remove '.\' at the beginning of the string of directories...} while (Length (Dirs) >= 2) and (Dirs [1] = '.') and (Dirs [2] = DirectorySeparator) do Delete (Dirs, 1, 2); +{$ENDIF FPC_FEXPAND_NO_CURDIR} + +{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR} + (* Remove possible (invalid) references to '/' at the beginning. *) + while (Length (Dirs) >= 1) and (Dirs [1] = '/') do + Delete (Dirs, 1, 1); +{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR} + +{$IFNDEF FPC_FEXPAND_NO_DOTS_UPDIR} {...and possible (invalid) references to '..\' as well} while (Length (Dirs) >= 3) and (Dirs [1] = '.') and (Dirs [2] = '.') and (Dirs [3] = DirectorySeparator) do Delete (Dirs, 1, 3); +{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR} + {Two special cases - '.' and '..' alone} - if (Length (Dirs) = 1) and (Dirs [1] = '.') or - (Length (Dirs) = 2) and (Dirs [1] = '.') and (Dirs [2] = '.') then +{$IFNDEF FPC_FEXPAND_NO_CURDIR} + if (Length (Dirs) = 1) and (Dirs [1] = '.') then Dirs := ''; +{$ENDIF FPC_FEXPAND_NO_CURDIR} +{$IFNDEF FPC_FEXPAND_NO_DOTS_UPDIR} + if (Length (Dirs) = 2) and (Dirs [1] = '.') and (Dirs [2] = '.') then + Dirs := ''; +{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR} + {Join the parts back to create the complete path} if Length (Dirs) = 0 then begin Pa := Copy (Pa, 1, PathStart); +{$IFNDEF FPC_FEXPAND_DRIVESEP_IS_ROOT} if Pa [PathStart] <> DirectorySeparator then Pa := Pa + DirectorySeparator; +{$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT} end else Pa := Copy (Pa, 1, PathStart) + Dirs; + +{$IFNDEF FPC_FEXPAND_DIRSEP_IS_UPDIR} {Remove ending \ if not supplied originally, the original string wasn't empty (to stay compatible) and if not really needed} if (Pa [Length (Pa)] = DirectorySeparator) @@ -318,12 +444,17 @@ begin (Length (Path) <> 0) and (Path [Length (Path)] <> DirectorySeparator) then Dec (Pa [0]); +{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR} + FExpand := Pa; end; { $Log$ - Revision 1.13 2002-11-25 21:03:57 hajny + Revision 1.14 2002-12-01 20:46:44 hajny + * Amiga support hopefully finished + + Revision 1.13 2002/11/25 21:03:57 hajny * Amiga fixes (among others) Revision 1.12 2002/11/24 15:49:22 hajny