fexpand.inc 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1997-2000 by the Free Pascal development team
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {****************************************************************************
  12. A platform independent FExpand implementation
  13. ****************************************************************************}
  14. {$IFDEF FPC_FEXPAND_VOLUMES}
  15. {$IFNDEF FPC_FEXPAND_DRIVES}
  16. (* Volumes are just a special case of drives. *)
  17. {$DEFINE FPC_FEXPAND_DRIVES}
  18. {$ENDIF FPC_FEXPAND_DRIVES}
  19. {$ENDIF FPC_FEXPAND_VOLUMES}
  20. {$IFDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
  21. {$IFNDEF FPC_FEXPAND_DRIVES}
  22. (* If DirectorySeparator at the beginning marks a relative path, *)
  23. (* an absolute path must always begin with a drive or volume. *)
  24. {$DEFINE FPC_FEXPAND_DRIVES}
  25. {$ENDIF FPC_FEXPAND_DRIVES}
  26. {$IFNDEF FPC_FEXPAND_MULTIPLE_UPDIR}
  27. (* Traversing multiple levels at once explicitely allowed. *)
  28. {$DEFINE FPC_FEXPAND_MULTIPLE_UPDIR}
  29. {$ENDIF FPC_FEXPAND_MULTIPLE_UPDIR}
  30. (* Helper define used to support common features of FPC_FEXPAND_DIRSEP_IS_* *)
  31. {$DEFINE FPC_FEXPAND_UPDIR_HELPER}
  32. {$ENDIF FPC_FEXPAND_DIRSEP_IS_CURDIR}
  33. {$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
  34. {$IFNDEF FPC_FEXPAND_DRIVES}
  35. (* If DirectorySeparator at the beginning marks a relative path, *)
  36. (* an absolute path must always begin with a drive or volume. *)
  37. {$DEFINE FPC_FEXPAND_DRIVES}
  38. {$ENDIF FPC_FEXPAND_DRIVES}
  39. {$IFNDEF FPC_FEXPAND_MULTIPLE_UPDIR}
  40. (* Traversing multiple levels at once explicitely allowed. *)
  41. {$DEFINE FPC_FEXPAND_MULTIPLE_UPDIR}
  42. {$ENDIF FPC_FEXPAND_MULTIPLE_UPDIR}
  43. (* Helper define used to support common features of FPC_FEXPAND_DIRSEP_IS_* *)
  44. {$DEFINE FPC_FEXPAND_UPDIR_HELPER}
  45. {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
  46. procedure GetDirIO (DriveNr: byte; var Dir: OpenString);
  47. (* GetDirIO is supposed to return the root of the given drive *)
  48. (* in case of an error for compatibility of FExpand with TP/BP. *)
  49. var
  50. OldInOutRes: word;
  51. begin
  52. OldInOutRes := InOutRes;
  53. InOutRes := 0;
  54. GetDir (DriveNr, Dir);
  55. InOutRes := OldInOutRes;
  56. end;
  57. {$IFDEF FPC_FEXPAND_VOLUMES}
  58. {$IFNDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
  59. procedure GetDirIO (const VolumeName: OpenString; var Dir: OpenString);
  60. var
  61. OldInOutRes: word;
  62. begin
  63. OldInOutRes := InOutRes;
  64. InOutRes := 0;
  65. GetDir (VolumeName, Dir);
  66. InOutRes := OldInOutRes;
  67. end;
  68. {$ENDIF FPC_FEXPAND_NO_DEFAULT_PATHS}
  69. {$ENDIF FPC_FEXPAND_VOLUMES}
  70. function FExpand (const Path: PathStr): PathStr;
  71. (* LFNSupport boolean constant, variable or function must be declared for all
  72. the platforms, at least locally in the Dos unit implementation part.
  73. In addition, FPC_FEXPAND_UNC, FPC_FEXPAND_DRIVES, FPC_FEXPAND_GETENV_PCHAR,
  74. FPC_FEXPAND_TILDE, FPC_FEXPAND_VOLUMES, FPC_FEXPAND_NO_DEFAULT_PATHS,
  75. FPC_FEXPAND_DRIVESEP_IS_ROOT, FPC_FEXPAND_NO_CURDIR,
  76. FPC_FEXPAND_NO_DOTS_UPDIR, FPC_FEXPAND_DIRSEP_IS_UPDIR,
  77. FPC_FEXPAND_DIRSEP_IS_CURDIR and FPC_FEXPAND_MULTIPLE_UPDIR conditionals
  78. might be defined to specify FExpand behaviour - see end of this file for
  79. individual descriptions.
  80. *)
  81. {$IFDEF FPC_FEXPAND_DRIVES}
  82. var
  83. PathStart: longint;
  84. {$ELSE FPC_FEXPAND_DRIVES}
  85. const
  86. PathStart = 1;
  87. {$ENDIF FPC_FEXPAND_DRIVES}
  88. {$IFDEF FPC_FEXPAND_UNC}
  89. var
  90. RootNotNeeded: boolean;
  91. {$ELSE FPC_FEXPAND_UNC}
  92. const
  93. RootNotNeeded = false;
  94. {$ENDIF FPC_FEXPAND_UNC}
  95. var S, Pa, Dirs: PathStr;
  96. I, J: longint;
  97. begin
  98. {$IFDEF FPC_FEXPAND_UNC}
  99. RootNotNeeded := false;
  100. {$ENDIF FPC_FEXPAND_UNC}
  101. (* First convert the path to uppercase if appropriate for current platform. *)
  102. if FileNameCaseSensitive then
  103. Pa := Path
  104. else
  105. Pa := UpCase (Path);
  106. (* Allow both '/' and '\' as directory separators *)
  107. (* by converting all to the native one. *)
  108. if DirectorySeparator = '\' then
  109. {Allow slash as backslash}
  110. begin
  111. for I := 1 to Length (Pa) do
  112. if Pa [I] = '/' then
  113. Pa [I] := DirectorySeparator
  114. end
  115. else
  116. if DirectorySeparator = '\' then
  117. {Allow backslash as slash}
  118. begin
  119. for I := 1 to Length (Pa) do
  120. if Pa [I] = '\' then
  121. Pa [I] := DirectorySeparator;
  122. end;
  123. (* PathStart is amount of characters to strip to get beginning *)
  124. (* of path without volume/drive specification. *)
  125. {$IFDEF FPC_FEXPAND_DRIVES}
  126. {$IFDEF FPC_FEXPAND_VOLUMES}
  127. {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
  128. PathStart := Pos (DriveSeparator, Pa);
  129. {$ELSE FPC_FEXPAND_DRIVESEP_IS_ROOT}
  130. PathStart := Succ (Pos (DriveSeparator, Pa));
  131. {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT}
  132. {$ELSE FPC_FEXPAND_VOLUMES}
  133. PathStart := 3;
  134. {$ENDIF FPC_FEXPAND_VOLUMES}
  135. {$ENDIF FPC_FEXPAND_DRIVES}
  136. (* Expand tilde to home directory if appropriate. *)
  137. {$IFDEF FPC_FEXPAND_TILDE}
  138. {Replace ~/ with $HOME/}
  139. if (Length (Pa) >= 1) and (Pa [1] = '~') and
  140. ((Pa [2] = DirectorySeparator) or (Length (Pa) = 1)) then
  141. begin
  142. {$IFDEF FPC_FEXPAND_GETENV_PCHAR}
  143. S := StrPas (GetEnv ('HOME'));
  144. {$ELSE FPC_FEXPAND_GETENV_PCHAR}
  145. S := GetEnv ('HOME');
  146. {$ENDIF FPC_FEXPAND_GETENV_PCHAR}
  147. if (S = '') or (Length (S) = 1)
  148. and (S [1] = DirectorySeparator) then
  149. Delete (Pa, 1, 1)
  150. else
  151. if S [Length (S)] = DirectorySeparator then
  152. Pa := S + Copy (Pa, 3, Length (Pa) - 2)
  153. else
  154. Pa := S + Copy (Pa, 2, Pred (Length (Pa)));
  155. end;
  156. {$ENDIF FPC_FEXPAND_TILDE}
  157. (* Do we have a drive/volume specification? *)
  158. {$IFDEF FPC_FEXPAND_VOLUMES}
  159. if PathStart > 1 then
  160. {$ELSE FPC_FEXPAND_VOLUMES}
  161. if (Length (Pa) > 1) and (Pa [1] in ['A'..'Z', 'a'..'z']) and
  162. (Pa [2] = DriveSeparator) then
  163. {$ENDIF FPC_FEXPAND_VOLUMES}
  164. begin
  165. (* We need to know current directory on given *)
  166. (* volume/drive _if_ such a thing is defined. *)
  167. {$IFDEF FPC_FEXPAND_DRIVES}
  168. {$IFNDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
  169. {$IFDEF FPC_FEXPAND_VOLUMES}
  170. GetDirIO (Copy (Pa, 1, PathStart - 2), S);
  171. {$ELSE FPC_FEXPAND_VOLUMES}
  172. { Always uppercase driveletter }
  173. if (Pa [1] in ['a'..'z']) then
  174. Pa [1] := Chr (Ord (Pa [1]) and not ($20));
  175. GetDirIO (Ord (Pa [1]) - Ord ('A') + 1, S);
  176. {$ENDIF FPC_FEXPAND_VOLUMES}
  177. (* Do we have more than just drive/volume specification? *)
  178. if Length (Pa) = Pred (PathStart) then
  179. (* If not, just use the current directory for that drive/volume. *)
  180. Pa := S
  181. else
  182. (* If yes, find out whether the following path is relative or absolute. *)
  183. if Pa [PathStart] <> DirectorySeparator then
  184. {$IFDEF FPC_FEXPAND_VOLUMES}
  185. if Copy (Pa, 1, PathStart - 2) = Copy (S, 1, PathStart - 2)
  186. then
  187. {$ELSE FPC_FEXPAND_VOLUMES}
  188. if Pa [1] = S [1] then
  189. {$ENDIF FPC_FEXPAND_VOLUMES}
  190. begin
  191. { remove ending slash if it already exists }
  192. if S [Length (S)] = DirectorySeparator then
  193. Dec (S [0]);
  194. Pa := S + DirectorySeparator +
  195. Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
  196. end
  197. else
  198. {$IFDEF FPC_FEXPAND_VOLUMES}
  199. Pa := Copy (Pa, 1, PathStart - 2) + DriveSeparator
  200. + DirectorySeparator +
  201. Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
  202. {$ELSE FPC_FEXPAND_VOLUMES}
  203. Pa := Pa [1] + DriveSeparator + DirectorySeparator +
  204. Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
  205. {$ENDIF FPC_FEXPAND_VOLUMES}
  206. {$ENDIF FPC_FEXPAND_NO_DEFAULT_PATHS}
  207. end
  208. else
  209. {$ELSE FPC_FEXPAND_DRIVES}
  210. (* If drives are not supported, but a drive *)
  211. (* was supplied anyway, ignore (remove) it. *)
  212. Delete (Pa, 1, 2);
  213. end;
  214. {Check whether we don't have an absolute path already}
  215. if (Length (Pa) >= PathStart) and (Pa [PathStart] <> DirectorySeparator) or
  216. (Length (Pa) < PathStart) then
  217. {$ENDIF FPC_FEXPAND_DRIVES}
  218. begin
  219. (* Get current directory on selected drive/volume. *)
  220. GetDirIO (0, S);
  221. {$IFDEF FPC_FEXPAND_VOLUMES}
  222. {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
  223. PathStart := Pos (DriveSeparator, S);
  224. {$ELSE FPC_FEXPAND_DRIVESEP_IS_ROOT}
  225. PathStart := Succ (Pos (DriveSeparator, S));
  226. {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT}
  227. {$ENDIF FPC_FEXPAND_VOLUMES}
  228. (* Do we have an absolute path without drive or volume? *)
  229. {$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
  230. {$IFDEF FPC_FEXPAND_DRIVES}
  231. if (Length (Pa) > 0)
  232. {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
  233. and (Pa [1] = DriveSeparator)
  234. {$ELSE FPC_FEXPAND_DRIVESEP_IS_ROOT}
  235. and (Pa [1] = DirectorySeparator)
  236. {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT}
  237. then
  238. begin
  239. {$IFDEF FPC_FEXPAND_UNC}
  240. {Do not touch network drive names}
  241. if (Length (Pa) > 1) and (Pa [2] = DirectorySeparator)
  242. and LFNSupport then
  243. begin
  244. PathStart := 3;
  245. {Find the start of the string of directories}
  246. while (PathStart <= Length (Pa)) and
  247. (Pa [PathStart] <> DirectorySeparator) do
  248. Inc (PathStart);
  249. if PathStart > Length (Pa) then
  250. {We have just a machine name...}
  251. if Length (Pa) = 2 then
  252. {...or not even that one}
  253. PathStart := 2
  254. else
  255. Pa := Pa + DirectorySeparator else
  256. if PathStart < Length (Pa) then
  257. {We have a resource name as well}
  258. begin
  259. RootNotNeeded := true;
  260. {Let's continue in searching}
  261. repeat
  262. Inc (PathStart);
  263. until (PathStart > Length (Pa)) or
  264. (Pa [PathStart] = DirectorySeparator);
  265. end;
  266. end
  267. else
  268. {$ENDIF FPC_FEXPAND_UNC}
  269. {$IFDEF FPC_FEXPAND_VOLUMES}
  270. begin
  271. I := Pos (DriveSeparator, S);
  272. {$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
  273. {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
  274. if (Pa [1] = DriveSeparator) then
  275. Delete (Pa, 1, 1);
  276. {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT}
  277. Pa := Copy (S, 1, I) + Pa;
  278. PathStart := I;
  279. {$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR}
  280. Pa := Copy (S, 1, Pred (I)) + DriveSeparator + Pa;
  281. PathStart := Succ (I);
  282. {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
  283. end;
  284. {$ELSE FPC_FEXPAND_VOLUMES}
  285. Pa := S [1] + DriveSeparator + Pa;
  286. {$ENDIF FPC_FEXPAND_VOLUMES}
  287. end
  288. else
  289. {$ENDIF FPC_FEXPAND_DRIVES}
  290. (* We already have a slash if root is the curent directory. *)
  291. if Length (S) = PathStart then
  292. Pa := S + Pa
  293. {$ELSE FPC_FEXPAND_DIRSEP_IS_CURDIR}
  294. (* More complex with DirectorySeparator as current directory *)
  295. if (S [Length (S)] = DriveSeparator)
  296. and (Pa [1] = DirectorySeparator) then
  297. Pa := S + Copy (Pa, 2, Pred (Length (Pa)))
  298. {$ENDIF FPC_FEXPAND_DIRSEP_IS_CURDIR}
  299. else
  300. (* We need an ending slash if FExpand was called *)
  301. (* with an empty string for compatibility, except *)
  302. (* for platforms where this is invalid. *)
  303. if Length (Pa) = 0 then
  304. {$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
  305. Pa := S
  306. {$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR}
  307. Pa := S + DirectorySeparator
  308. {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
  309. else
  310. {$IFDEF FPC_FEXPAND_UPDIR_HELPER}
  311. if Pa [1] = DirectorySeparator then
  312. Pa := S + Pa
  313. else
  314. {$ENDIF FPC_FEXPAND_UPDIR_HELPER}
  315. Pa := S + DirectorySeparator + Pa;
  316. end;
  317. {Get string of directories to only process relative references on this one}
  318. Dirs := Copy (Pa, Succ (PathStart), Length (Pa) - PathStart);
  319. {$IFNDEF FPC_FEXPAND_NO_CURDIR}
  320. {$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
  321. {First remove all references to '\.\'}
  322. I := Pos (DirectorySeparator + '.' + DirectorySeparator, Dirs);
  323. while I <> 0 do
  324. begin
  325. Delete (Dirs, I, 2);
  326. I := Pos (DirectorySeparator + '.' + DirectorySeparator, Dirs);
  327. end;
  328. {$ENDIF FPC_FEXPAND_DIRSEP_IS_CURDIR}
  329. {$ENDIF FPC_FEXPAND_NO_CURDIR}
  330. {$IFNDEF FPC_FEXPAND_NO_DOTS_UPDIR}
  331. {$IFDEF FPC_FEXPAND_MULTIPLE_UPDIR}
  332. {Now replace all references to '\...' with '\..\..'}
  333. I := Pos (DirectorySeparator + '...', Dirs);
  334. while I <> 0 do
  335. begin
  336. Insert (DirectorySeparator + '.', Dirs, I + 3);
  337. I := Pos (DirectorySeparator + '...', Dirs);
  338. end;
  339. {$ENDIF FPC_FEXPAND_MULTIPLE_UPDIR}
  340. {Now remove also all references to '\..\' + of course previous dirs..}
  341. I := Pos (DirectorySeparator + '..' + DirectorySeparator, Dirs);
  342. while I <> 0 do
  343. begin
  344. J := Pred (I);
  345. while (J > 0) and (Dirs [J] <> DirectorySeparator) do
  346. Dec (J);
  347. Delete (Dirs, Succ (J), I - J + 3);
  348. I := Pos (DirectorySeparator + '..' + DirectorySeparator, Dirs);
  349. end;
  350. {$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
  351. {$IFDEF FPC_FEXPAND_UPDIR_HELPER}
  352. (* Now remove all references to '//' plus previous directories... *)
  353. I := Pos (DirectorySeparator + DirectorySeparator, Dirs);
  354. while I <> 0 do
  355. begin
  356. J := Pred (I);
  357. while (J > 0) and (Dirs [J] <> DirectorySeparator) do
  358. Dec (J);
  359. Delete (Dirs, Succ (J), Succ (I - J));
  360. I := Pos (DirectorySeparator + DirectorySeparator, Dirs);
  361. end;
  362. {$ENDIF FPC_FEXPAND_UPDIR_HELPER}
  363. {$IFNDEF FPC_FEXPAND_NO_DOTS_UPDIR}
  364. {Then remove also a reference to '\..' at the end of line
  365. + the previous directory, of course,...}
  366. I := Pos (DirectorySeparator + '..', Dirs);
  367. if (I <> 0) and (I = Length (Dirs) - 2) then
  368. begin
  369. J := Pred (I);
  370. while (J > 0) and (Dirs [J] <> DirectorySeparator) do
  371. Dec (J);
  372. if (J = 0) then
  373. Dirs := ''
  374. else
  375. Delete (Dirs, Succ (J), I - J + 2);
  376. end;
  377. {$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
  378. {$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
  379. (* Remove a possible reference to '/' at the *)
  380. (* end of line plus the previous directory. *)
  381. I := Length (Dirs);
  382. if (I > 0) and (Dirs [I] = DirectorySeparator) then
  383. begin
  384. J := Pred (I);
  385. while (J > 0) and (Dirs [J] <> DirectorySeparator) do
  386. Dec (J);
  387. if (J = 0) then
  388. Dirs := ''
  389. else
  390. Delete (Dirs, J, Succ (I - J));
  391. end;
  392. {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
  393. {$IFNDEF FPC_FEXPAND_NO_CURDIR}
  394. {$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
  395. {...and also a possible reference to '\.'}
  396. if (Length (Dirs) = 1) then
  397. begin
  398. if (Dirs [1] = '.') then
  399. {A special case}
  400. Dirs := ''
  401. end
  402. else
  403. if (Length (Dirs) <> 0) and (Dirs [Length (Dirs)] = '.') and
  404. (Dirs [Pred (Length (Dirs))] = DirectorySeparator) then
  405. Dec (Dirs [0], 2);
  406. {Finally remove '.\' at the beginning of the string of directories...}
  407. while (Length (Dirs) >= 2) and (Dirs [1] = '.')
  408. and (Dirs [2] = DirectorySeparator) do
  409. Delete (Dirs, 1, 2);
  410. {$ENDIF FPC_FEXPAND_DIRSEP_IS_CURDIR}
  411. {$ENDIF FPC_FEXPAND_NO_CURDIR}
  412. {$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
  413. (* Remove possible (invalid) references to '/' at the beginning. *)
  414. while (Length (Dirs) >= 1) and (Dirs [1] = '/') do
  415. Delete (Dirs, 1, 1);
  416. {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
  417. {$IFNDEF FPC_FEXPAND_NO_DOTS_UPDIR}
  418. {...and possible (invalid) references to '..\' as well}
  419. while (Length (Dirs) >= 3) and (Dirs [1] = '.') and (Dirs [2] = '.') and
  420. (Dirs [3] = DirectorySeparator) do
  421. Delete (Dirs, 1, 3);
  422. {$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
  423. {Two special cases - '.' and '..' alone}
  424. {$IFNDEF FPC_FEXPAND_NO_CURDIR}
  425. {$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
  426. if (Length (Dirs) = 1) and (Dirs [1] = '.') then
  427. Dirs := '';
  428. {$ENDIF FPC_FEXPAND_DIRSEP_IS_CURDIR}
  429. {$ENDIF FPC_FEXPAND_NO_CURDIR}
  430. {$IFNDEF FPC_FEXPAND_NO_DOTS_UPDIR}
  431. if (Length (Dirs) = 2) and (Dirs [1] = '.') and (Dirs [2] = '.') then
  432. Dirs := '';
  433. {$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
  434. {Join the parts back to create the complete path}
  435. if Length (Dirs) = 0 then
  436. begin
  437. Pa := Copy (Pa, 1, PathStart);
  438. {$IFNDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
  439. if Pa [PathStart] <> DirectorySeparator then
  440. Pa := Pa + DirectorySeparator;
  441. {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT}
  442. end
  443. else
  444. Pa := Copy (Pa, 1, PathStart) + Dirs;
  445. {$IFNDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
  446. {Remove ending \ if not supplied originally, the original string
  447. wasn't empty (to stay compatible) and if not really needed}
  448. if (Pa [Length (Pa)] = DirectorySeparator)
  449. and ((Length (Pa) > PathStart) or
  450. {A special case with UNC paths}
  451. (RootNotNeeded and (Length (Pa) = PathStart)))
  452. {Reference to current directory at the end should be removed}
  453. and (Length (Path) <> 0)
  454. and (Path [Length (Path)] <> DirectorySeparator)
  455. then
  456. Dec (Pa [0]);
  457. {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
  458. FExpand := Pa;
  459. end;
  460. (* Description of individual conditional defines supported for FExpand
  461. (disregard the used directory separators in examples, constant
  462. System.DirectorySeparator is used in the real implemenation, of course):
  463. FPC_FEXPAND_UNC - UNC ("Universal Naming Convention") paths are
  464. supported (usually used for networking, used in DOS (with
  465. networking support installed), OS/2, Win32 and at least some
  466. Netware versions as far as I remember. An example of such a path
  467. is '\\servername\sharename\some\path'.
  468. FPC_FEXPAND_DRIVES - drive letters are supported (DOS-like
  469. environments - DOS, OS/2, Win32). Example is 'C:\TEST'.
  470. FPC_FEXPAND_GETENV_PCHAR - an implementation of GetEnv returning
  471. PChar instead of a shortstring is available (Unix) to support
  472. long values of environment variables.
  473. FPC_FEXPAND_TILDE - expansion of '~/' to GetEnv('HOME') - Unix.
  474. Example: '~/some/path'.
  475. FPC_FEXPAND_VOLUMES - volumes are supported (similar to drives,
  476. but the name can be longer; used under Netware, Amiga and
  477. probably MacOS as far as I understand it correctly). Example:
  478. 'VolumeName:Some:Path' or 'ServerName/Volume:Some\Path'
  479. (Netware).
  480. FPC_FEXPAND_NO_DEFAULT_PATHS - Dos keeps information about the
  481. current directory for every drive. If some platform supports
  482. drives or volumes, but keeps no track of current directories for
  483. them (i.e. there's no support for "GetDir(DriveNumber, Dir)" or
  484. "GetDir(Volume, Dir)", but only for "GetDir (0, Dir)" (i.e. the
  485. overall current directory), you should define this. Otherwise
  486. constructs like 'C:Some\Path' refer a path relative to the
  487. current directory on the C: drive.
  488. FPC_FEXPAND_DRIVESEP_IS_ROOT - this means that DriveSeparator
  489. should be used as beginning of the "real" path for a particular
  490. drive or volume instead of the DirectorySeparator. This would be
  491. used in case that there is only one character (DriveSeparator)
  492. delimitting the drive letter or volume name from the remaining
  493. path _and_ the DriveSeparator marks the root of an absolute path
  494. in that case. Example - 'Volume:This/Is/Absolute/Path'.
  495. FPC_FEXPAND_NO_CURDIR - there is no support to refer to current
  496. directory explicitely (like '.' used under both Unix and DOS-like
  497. environments).
  498. FPC_FEXPAND_NO_DOTS_UPDIR - '..' cannot be used to refer to the
  499. upper directory.
  500. FPC_FEXPAND_DIRSEP_IS_UPDIR - DirectorySeparator at the beginning of
  501. a path (or doubled DirectorySeparator inside the path) refer to the
  502. parent directory, one more DirectorySeparator to parent directory of
  503. parent directory and so on (Amiga). Please, note that you can decide
  504. to support both '..' and DirectorySeparator as references to the parent
  505. directory at the same time for compatibility reasons - however this
  506. support makes it impossible to use an otherwise possibly valid name
  507. of '..'.
  508. FPC_FEXPAND_DIRSEP_IS_CURDIR - DirectorySeparator at the beginning of
  509. a path refers to the current directory (i.e. path beginning with
  510. DirectorySeparator is always a relative path). Two DirectorySeparator
  511. characters refer to the parent directory, three refer to parent
  512. directory of the parent directory and so on (MacOS).
  513. FPC_FEXPAND_MULTIPLE_UPDIR - grouping of more characters specifying
  514. upper directory references higher directory levels. Example: '...'
  515. (Netware).
  516. *)
  517. {
  518. $Log$
  519. Revision 1.17 2004-11-21 14:45:17 hajny
  520. + MacOS support
  521. Revision 1.16 2004/05/29 18:25:21 hajny
  522. * description of individual conditional defines added
  523. Revision 1.15 2002/12/07 16:26:39 hajny
  524. * '//' behaviour for Amiga corrected
  525. Revision 1.14 2002/12/01 20:46:44 hajny
  526. * Amiga support hopefully finished
  527. Revision 1.13 2002/11/25 21:03:57 hajny
  528. * Amiga fixes (among others)
  529. Revision 1.12 2002/11/24 15:49:22 hajny
  530. * make use of constants available in the system unit
  531. Revision 1.11 2002/09/07 15:07:45 peter
  532. * old logs removed and tabs fixed
  533. Revision 1.10 2002/05/14 19:25:24 hajny
  534. * fix for bug 1964 merged
  535. Revision 1.9 2002/03/03 15:19:36 carl
  536. * fixes unix conversion of slashes
  537. }