linklist.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810
  1. {
  2. This file is part of the Free Pascal run time library.
  3. A file in Amiga system run time library.
  4. Copyright (c) 1998-2003 by Nils Sjoholm
  5. member of the Amiga RTL development team.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$I useamigasmartlink.inc}
  13. {$ifdef use_amiga_smartlink}
  14. {$smartlink on}
  15. {$endif use_amiga_smartlink}
  16. unit linklist;
  17. {
  18. A unit for an easy way to use exec linked lists
  19. for Amiga. Can also be used for other platforms
  20. as it is. I hope.
  21. 27 Oct 1998.
  22. Added the define use_amiga_smartlink.
  23. 13 Jan 2003.
  24. [email protected]
  25. }
  26. interface
  27. uses
  28. {$ifdef Amiga}
  29. Exec,amigalib,
  30. {$endif}
  31. strings;
  32. { $define showall}
  33. {$ifndef Amiga}
  34. type
  35. pNode = ^tNode;
  36. tNode = record
  37. ln_Succ: pNode;
  38. ln_Pred: pNode;
  39. ln_Type: byte;
  40. ln_Pri : shortint;
  41. ln_Name: pchar;
  42. end;
  43. pList = ^tList;
  44. tList = record
  45. lh_Head: pNode;
  46. lh_Tail: pNode;
  47. lh_TailPred: pNode;
  48. lh_Type: byte;
  49. l_pad: byte;
  50. end;
  51. {$endif}
  52. type
  53. pFPCNode = ^tFPCNode;
  54. tFPCNode = record
  55. ln_Succ : pNode;
  56. ln_Pred : pNode;
  57. ln_Type : Byte;
  58. ln_Pri : Shortint;
  59. ln_Name : PChar;
  60. {
  61. Increase this record if you need more information
  62. just add your own to the record. Don't forget to
  63. change the functions or add your own functions.
  64. }
  65. ln_Size : Longint;
  66. end;
  67. {$ifndef Amiga}
  68. procedure NewList (list: pList);
  69. procedure AddHead(list : pList; node : pNode);
  70. procedure AddTail(list : pList; node : pNode);
  71. procedure Insert(list : pList; node, lnode: pNode);
  72. procedure Remove(node : pNode);
  73. function RemHead(list : pList): pNode;
  74. function RemTail(list : pList): pNode;
  75. {$endif}
  76. FUNCTION AddNewNode(VAR fpclist : pList; Str : PChar): pFPCNode;
  77. FUNCTION AddNewNode(VAR fpclist : pList; Str : String): pFPCNode;
  78. PROCEDURE ClearList(VAR fpclist : pList);
  79. PROCEDURE CreateList(VAR fpclist : pList);
  80. FUNCTION CopyList(fpclist : pList): pList;
  81. PROCEDURE DeleteNode(ANode : pFPCNode);
  82. PROCEDURE DestroyList(VAR fpclist : pList);
  83. FUNCTION FindNodeData(fpclist : pList; data : PChar): pFPCNode;
  84. FUNCTION FindNodeData(fpclist : pList; data : String): pFPCNode;
  85. FUNCTION GetFirstNode(fpclist : pList): pFPCNode;
  86. FUNCTION GetLastNode(fpclist : pList): pFPCNode;
  87. FUNCTION GetNextNode( ANode : pFPCNode): pFPCNode;
  88. FUNCTION GetNodeData(Anode : pFPCNode): PChar;
  89. FUNCTION GetNodeNumber(fpclist : pList; num : Longint): pFPCNode;
  90. FUNCTION GetPrevNode( ANode : pFPCNode): pFPCNode;
  91. FUNCTION InsertNewNode(var fpclist : pList; data : PChar; Anode : pFPCNode): pFPCNode;
  92. FUNCTION InsertNewNode(var fpclist : pList; data : String; Anode : pFPCNode): pFPCNode;
  93. PROCEDURE ListToBuffer(fpclist : pList; VAR buf : PChar);
  94. FUNCTION MergeLists(firstlist , secondlist : pList): pList;
  95. PROCEDURE MoveNodeBottom(var fpclist: pList; ANode : pFPCNode);
  96. PROCEDURE MoveNodeDown(VAR fpclist : pList; ANode : pFPCNode);
  97. PROCEDURE MoveNodeTop(VAR fpclist: pList; ANode : pFPCNode);
  98. PROCEDURE MoveNodeUp(VAR fpclist : pList; ANode : pFPCNode);
  99. FUNCTION NodesInList(fpclist : pList): Longint;
  100. PROCEDURE PrintList(fpclist : pList);
  101. PROCEDURE RemoveDupNode( VAR fpclist : pList);
  102. PROCEDURE RemoveLastNode(VAR fpclist : pList);
  103. FUNCTION SizeOfList(fpclist : pList): Longint;
  104. PROCEDURE SortList(VAR fpclist: pList);
  105. FUNCTION UpDateNode(ANode : pFPCNode; data : PChar): BOOLEAN;
  106. FUNCTION UpDateNode(ANode : pFPCNode; data : String): BOOLEAN;
  107. function FileToList(thefile : PChar; var thelist : pList): boolean;
  108. function FileToList(thefile : String; var thelist : pList): boolean;
  109. function ListToFile(TheFile : PChar; thelist : pList): Boolean;
  110. function ListToFile(TheFile : String; thelist : pList): Boolean;
  111. implementation
  112. {$ifndef Amiga}
  113. procedure NewList (list: pList);
  114. begin
  115. list^.lh_Head := pNode(@list^.lh_Tail);
  116. list^.lh_Tail := NIL;
  117. list^.lh_TailPred := pNode(@list^.lh_Head)
  118. end;
  119. procedure AddHead(list : pList; node : pNode);
  120. begin
  121. node^.ln_Succ := list^.lh_Head;
  122. node^.ln_Pred := pNode(@list^.lh_Head);
  123. list^.lh_Head^.ln_Pred := node;
  124. list^.lh_Head := node;
  125. end;
  126. procedure AddTail(list : pList; node : pNode);
  127. begin
  128. node^.ln_Succ := pNode(@list^.lh_Tail);
  129. node^.ln_Pred := list^.lh_TailPred;
  130. list^.lh_TailPred^.ln_Succ := node;
  131. list^.lh_TailPred := node;
  132. end;
  133. procedure Insert(list : pList; node : pNode; lnode: pNode);
  134. begin
  135. {*
  136. * Insert node after lnode. If lnode = NIL then insert
  137. * at head of list.
  138. *}
  139. if (lnode = NIL) then lnode := pNode(@list^.lh_Head);
  140. node^.ln_Pred := lnode;
  141. node^.ln_Succ := lnode^.ln_Succ;
  142. lnode^.ln_Succ := node;
  143. node^.ln_Succ^.ln_Pred := node;
  144. end;
  145. procedure Remove(node : pNode);
  146. begin
  147. node^.ln_Succ^.ln_Pred := node^.ln_Pred;
  148. node^.ln_Pred^.ln_Succ := node^.ln_Succ;
  149. node^.ln_Succ := NIL;
  150. node^.ln_Pred := NIL;
  151. end;
  152. function RemHead(list : pList): pNode;
  153. var
  154. node : pNode;
  155. begin
  156. node := list^.lh_Head;
  157. if (node^.ln_Succ <> NIL) then begin
  158. node^.ln_Succ^.ln_Pred := node^.ln_Pred;
  159. node^.ln_Pred^.ln_Succ := node^.ln_Succ;
  160. node^.ln_Succ := NIL;
  161. node^.ln_Pred := NIL;
  162. end else node := NIL;
  163. RemHead := node;
  164. end;
  165. function RemTail(list : pList): pNode;
  166. var
  167. node : pNode;
  168. begin
  169. node := list^.lh_TailPred;
  170. if (node^.ln_Pred <> NIL) then Remove(node)
  171. else node := NIL;
  172. RemTail := node;
  173. end;
  174. {$endif}
  175. FUNCTION AddNewNode(VAR fpclist : pList; Str : PChar): pFPCNode;
  176. VAR
  177. tempnode : pFPCNode;
  178. BEGIN
  179. New(tempnode);
  180. tempnode^.ln_Name := StrAlloc(StrLen(Str)+1);
  181. IF tempnode^.ln_Name <> NIL THEN BEGIN
  182. StrCopy(tempnode^.ln_Name,Str);
  183. tempnode^.ln_Size := 0;
  184. tempnode^.ln_Type := 0;
  185. tempnode^.ln_Pri := 0;
  186. AddTail(fpclist,pNode(tempnode));
  187. AddNewNode := tempnode;
  188. END ELSE BEGIN
  189. AddNewNode := NIL;
  190. END;
  191. END;
  192. FUNCTION AddNewNode(VAR fpclist : pList; Str : String): pFPCNode;
  193. VAR
  194. tempnode : pFPCNode;
  195. BEGIN
  196. New(tempnode);
  197. tempnode^.ln_Name := StrAlloc(Length(Str)+1);
  198. IF tempnode^.ln_Name <> NIL THEN BEGIN
  199. StrPCopy(tempnode^.ln_Name,Str);
  200. tempnode^.ln_Size := 0;
  201. tempnode^.ln_Type := 0;
  202. tempnode^.ln_Pri := 0;
  203. AddTail(fpclist,pNode(tempnode));
  204. AddNewNode := tempnode;
  205. END ELSE BEGIN
  206. AddNewNode := NIL;
  207. END;
  208. END;
  209. PROCEDURE ClearList(VAR fpclist : pList);
  210. VAR
  211. tempnode : pFPCNode;
  212. dummy : pNode;
  213. BEGIN
  214. WHILE fpclist^.lh_Head <> @fpclist^.lh_Tail DO BEGIN
  215. tempnode := pFPCNode(fpclist^.lh_Head);
  216. if tempnode <> nil then begin
  217. if tempnode^.ln_Name <> nil then begin
  218. StrDispose(tempnode^.ln_Name);
  219. end;
  220. dummy := RemHead(fpclist);
  221. Dispose(tempnode);
  222. end;
  223. END;
  224. END;
  225. FUNCTION CopyList(fpclist : pList): pList;
  226. VAR
  227. templist : pList;
  228. tempnode : pFPCNode;
  229. i, dummy : Longint;
  230. added : pFPCNode;
  231. BEGIN
  232. CreateList(templist);
  233. i := NodesInList(fpclist);
  234. tempnode := pFPCNode(fpclist^.lh_Head);
  235. FOR dummy := 1 TO i DO BEGIN
  236. added := AddNewNode(templist,tempnode^.ln_Name);
  237. tempnode := pFPCNode(tempnode^.ln_Succ);
  238. END;
  239. IF added = NIL THEN BEGIN
  240. CopyList := NIL;
  241. END ELSE BEGIN
  242. CopyList := templist;
  243. END;
  244. END;
  245. PROCEDURE CreateList(VAR fpclist : pList);
  246. BEGIN
  247. New(fpclist);
  248. NewList(fpclist);
  249. END;
  250. PROCEDURE DeleteNode(ANode : pFPCNode);
  251. BEGIN
  252. IF Assigned(ANode)THEN BEGIN
  253. IF Assigned(ANode^.ln_Name)THEN BEGIN
  254. StrDispose(ANode^.ln_Name);
  255. END;
  256. Remove(pNode(ANode));
  257. Dispose(ANode);
  258. END;
  259. END;
  260. { remove all nodes, list is killed }
  261. PROCEDURE DestroyList(VAR fpclist : pList);
  262. VAR
  263. tempnode : pFPCNode;
  264. dummy : pNode;
  265. BEGIN
  266. WHILE fpclist^.lh_Head <> @fpclist^.lh_Tail DO BEGIN
  267. tempnode := pFPCNode(fpclist^.lh_Head);
  268. if Assigned(tempnode) then begin
  269. if Assigned(tempnode^.ln_Name) then begin
  270. {$ifdef showall}
  271. write('releasing ');
  272. writeln(tempnode^.ln_Name);
  273. {$endif}
  274. StrDispose(tempnode^.ln_Name);
  275. end;
  276. dummy := RemHead(fpclist);
  277. {$ifdef showall}
  278. writeln('Disposing node');
  279. {$endif}
  280. Dispose(tempnode);
  281. end;
  282. END;
  283. if Assigned(fpclist) then begin
  284. {$ifdef showall}
  285. writeln('Disposing of list');
  286. {$endif}
  287. Dispose(fpclist);
  288. fpclist := nil;
  289. end;
  290. END;
  291. FUNCTION FindNodeData(fpclist : pList; data : PChar): pFPCNode;
  292. VAR
  293. temp : pFPCNode;
  294. result : pFPCNode;
  295. BEGIN
  296. result := NIL;
  297. IF fpclist^.lh_Head^.ln_Succ <> NIL THEN BEGIN
  298. temp := pFPCNode(fpclist^.lh_Head);
  299. WHILE (temp^.ln_Succ <> NIL) DO BEGIN
  300. IF (StrIComp(temp^.ln_Name,data)=0) THEN BEGIN
  301. result := temp;
  302. break;
  303. END;
  304. temp := pFPCNode(temp^.ln_Succ);
  305. END;
  306. END;
  307. FindNodeData := result;
  308. END;
  309. FUNCTION FindNodeData(fpclist : pList; data : String): pFPCNode;
  310. VAR
  311. temp : pFPCNode;
  312. result : pFPCNode;
  313. p : PChar;
  314. BEGIN
  315. result := NIL;
  316. p := StrAlloc(length(data)+1);
  317. StrPCopy(p,data);
  318. IF fpclist^.lh_Head^.ln_Succ <> NIL THEN BEGIN
  319. temp := pFPCNode(fpclist^.lh_Head);
  320. WHILE (temp^.ln_Succ <> NIL) DO BEGIN
  321. IF (StrIComp(temp^.ln_Name,p)=0) THEN BEGIN
  322. result := temp;
  323. break;
  324. END;
  325. temp := pFPCNode(temp^.ln_Succ);
  326. END;
  327. END;
  328. StrDispose(p);
  329. FindNodeData := result;
  330. END;
  331. FUNCTION GetFirstNode(fpclist : pList): pFPCNode;
  332. var
  333. head : pFPCNode;
  334. BEGIN
  335. head := pFPCNode(fpclist^.lh_Head);
  336. if head^.ln_Succ <> nil then begin
  337. GetFirstNode := pFPCNode(head);
  338. end else GetFirstNode := nil;
  339. END;
  340. FUNCTION GetLastNode(fpclist : pList): pFPCNode;
  341. var
  342. tail : pFPCNode;
  343. BEGIN
  344. tail := pFPCNode(fpclist^.lh_TailPred);
  345. if tail^.ln_Pred <> nil then begin
  346. GetLastNode := pFPCNode(tail);
  347. end else GetLastNode := nil;
  348. END;
  349. FUNCTION GetNextNode( ANode : pFPCNode): pFPCNode;
  350. var
  351. next : pFPCNode;
  352. BEGIN
  353. next := pFPCNode(ANode^.ln_Succ);
  354. if next^.ln_Succ <> nil then begin
  355. GetNextNode := pFPCNode(next);
  356. end else GetNextNode := nil;
  357. END;
  358. FUNCTION GetNodeData(Anode : pFPCNode): PChar;
  359. BEGIN
  360. IF ANode <> NIL THEN BEGIN
  361. IF ANode^.ln_Name <> NIL THEN BEGIN
  362. GetNodeData := ANode^.ln_Name;
  363. END ELSE BEGIN
  364. GetNodeData := NIL;
  365. END;
  366. END;
  367. END;
  368. FUNCTION GetNodeNumber(fpclist : pList; num : Longint): pFPCNode;
  369. VAR
  370. dummy : Longint;
  371. tempnode : pFPCNode;
  372. BEGIN
  373. IF num <= NodesInList(fpclist) then begin
  374. tempnode := pFPCNode(fpclist^.lh_Head);
  375. FOR dummy := 1 TO num DO BEGIN
  376. tempnode := pFPCNode(tempnode^.ln_Succ);
  377. END;
  378. GetNodeNumber := pFPCNode(tempnode);
  379. END ELSE BEGIN
  380. GetNodeNumber := NIL;
  381. END;
  382. END;
  383. FUNCTION GetPrevNode( ANode : pFPCNode): pFPCNode;
  384. var
  385. prev : pFPCNode;
  386. BEGIN
  387. prev := pFPCNode(ANode^.ln_Pred);
  388. if prev^.ln_Pred <> nil then begin
  389. GetPrevNode := pFPCNode(prev);
  390. end else GetPrevNode := nil;
  391. END;
  392. FUNCTION InsertNewNode(var fpclist : pList; data : PChar; Anode : pFPCNode): pFPCNode;
  393. VAR
  394. dummy : pFPCNode;
  395. BEGIN
  396. dummy := AddNewNode(fpclist,data);
  397. IF dummy <> NIL THEN BEGIN
  398. IF (ANode <> NIL) THEN BEGIN
  399. Remove(pNode(dummy));
  400. {$ifdef Amiga}
  401. ExecInsert(fpclist,pNode(dummy),pNode(Anode));
  402. {$else}
  403. Insert(fpclist,pNode(dummy),pNode(Anode));
  404. {$endif}
  405. END;
  406. InsertNewNode := dummy;
  407. END ELSE begin
  408. InsertNewNode := NIL;
  409. END;
  410. END;
  411. FUNCTION InsertNewNode(var fpclist : pList; data : String; Anode : pFPCNode): pFPCNode;
  412. VAR
  413. dummy : pFPCNode;
  414. BEGIN
  415. dummy := AddNewNode(fpclist,data);
  416. IF dummy <> NIL THEN BEGIN
  417. IF (ANode <> NIL) THEN BEGIN
  418. Remove(pNode(dummy));
  419. {$ifdef Amiga}
  420. ExecInsert(fpclist,pNode(dummy),pNode(Anode));
  421. {$else}
  422. Insert(fpclist,pNode(dummy),pNode(Anode));
  423. {$endif}
  424. END;
  425. InsertNewNode := dummy;
  426. END ELSE begin
  427. InsertNewNode := NIL;
  428. END;
  429. END;
  430. PROCEDURE ListToBuffer(fpclist : pList; VAR buf : PChar);
  431. VAR
  432. i : Longint;
  433. dummy : Longint;
  434. tempnode : pFPCNode;
  435. BEGIN
  436. buf[0] := #0;
  437. i := NodesInList(fpclist);
  438. tempnode := pFPCNode(fpclist^.lh_Head);
  439. FOR dummy := 1 TO i DO BEGIN
  440. IF tempnode^.ln_Name <> NIL THEN BEGIN
  441. strcat(buf,tempnode^.ln_Name);
  442. IF dummy < i THEN BEGIN
  443. StrCat(buf,PChar(';'#0));
  444. END;
  445. END;
  446. tempnode := pFPCNode(tempnode^.ln_Succ);
  447. END;
  448. END;
  449. FUNCTION MergeLists(firstlist , secondlist : pList): pList;
  450. VAR
  451. templist : pList;
  452. tempnode : pFPCNode;
  453. i, dummy : Longint;
  454. added : pFPCNode;
  455. BEGIN
  456. CreateList(templist);
  457. i := NodesInList(firstlist);
  458. tempnode := pFPCNode(firstlist^.lh_Head);
  459. FOR dummy := 0 TO i DO BEGIN
  460. added := AddNewNode(templist,tempnode^.ln_Name);
  461. tempnode := pFPCNode(tempnode^.ln_Succ);
  462. END;
  463. IF added = NIL THEN BEGIN
  464. MergeLists := NIL;
  465. END ELSE BEGIN
  466. i := NodesInList(secondlist);
  467. tempnode := pFPCNode(secondlist^.lh_Head);
  468. FOR dummy := 0 TO i DO BEGIN
  469. added := AddNewNode(templist,tempnode^.ln_Name);
  470. tempnode := pFPCNode(tempnode^.ln_Succ);
  471. END;
  472. IF added = NIL THEN BEGIN
  473. MergeLists := NIL;
  474. END ELSE BEGIN
  475. MergeLists := templist;
  476. END;
  477. END;
  478. END;
  479. { move a node to the bottom of the list }
  480. PROCEDURE MoveNodeBottom(var fpclist: pList; ANode : pFPCNode);
  481. BEGIN
  482. IF ANode^.ln_Succ <> NIL THEN BEGIN
  483. Remove(pNode(ANode));
  484. AddTail(fpclist,pNode(ANode));
  485. END;
  486. END;
  487. { move a node down the list }
  488. PROCEDURE MoveNodeDown(VAR fpclist : pList; ANode : pFPCNode);
  489. VAR
  490. suc : pFPCNode;
  491. BEGIN
  492. suc := pFPCNode(ANode^.ln_Succ);
  493. IF (ANode <> NIL) AND (suc <> NIL) THEN BEGIN
  494. Remove(pNode(ANode));
  495. {$ifdef Amiga}
  496. ExecInsert(fpclist,pNode(ANode),pNode(suc));
  497. {$else}
  498. Insert(fpclist,pNode(ANode),pNode(suc));
  499. {$endif}
  500. END;
  501. END;
  502. { move a node up to the top of the list }
  503. PROCEDURE MoveNodeTop(VAR fpclist: pList; ANode : pFPCNode);
  504. BEGIN
  505. IF ANode^.ln_Pred <> NIL THEN BEGIN
  506. Remove(pNode(ANode));
  507. AddHead(fpclist,pNode(ANode));
  508. END;
  509. END;
  510. { move a node up the list }
  511. PROCEDURE MoveNodeUp(VAR fpclist : pList; ANode : pFPCNode);
  512. VAR
  513. prev : pFPCNode;
  514. BEGIN
  515. prev := pFPCNode(Anode^.ln_Pred);
  516. IF (ANode <> NIL) AND (prev <> NIL) THEN BEGIN
  517. prev := pFPCNode(prev^.ln_Pred);
  518. Remove(pNode(ANode));
  519. {$ifdef Amiga}
  520. ExecInsert(fpclist,pNode(ANode),pNode(prev));
  521. {$else}
  522. Insert(fpclist,pNode(ANode),pNode(prev));
  523. {$endif}
  524. END;
  525. END;
  526. FUNCTION NodesInList(fpclist : pList): Longint;
  527. VAR
  528. tempnode : pFPCNode;
  529. i : Longint;
  530. BEGIN
  531. i := 0;
  532. tempnode := pFPCNode(fpclist^.lh_Head);
  533. WHILE tempnode^.ln_Succ <> NIL DO BEGIN
  534. tempnode := pFPCNode(tempnode^.ln_Succ);
  535. INC(i);
  536. END;
  537. NodesInList := i;
  538. END;
  539. PROCEDURE PrintList(fpclist : pList);
  540. VAR
  541. i : Longint;
  542. dummy : Longint;
  543. tempnode : pFPCNode;
  544. BEGIN
  545. i := NodesInList(fpclist);
  546. tempnode := pFPCNode(fpclist^.lh_Head);
  547. FOR dummy := 1 TO i DO BEGIN
  548. IF tempnode^.ln_Name <> NIL THEN BEGIN
  549. WriteLN(tempnode^.ln_Name);
  550. END;
  551. tempnode := pFPCNode(tempnode^.ln_Succ);
  552. END;
  553. END;
  554. PROCEDURE RemoveDupNode( VAR fpclist : pList);
  555. VAR
  556. tempnode : pFPCNode;
  557. nextnode : pFPCNode;
  558. BEGIN
  559. tempnode := pFPCNode(fpclist^.lh_Head);
  560. WHILE tempnode^.ln_Succ <> NIL DO BEGIN
  561. nextnode := pFPCNode(tempnode^.ln_Succ);
  562. IF (StrIComp(tempnode^.ln_Name,nextnode^.ln_Name)=0) THEN BEGIN
  563. DeleteNode(tempnode);
  564. END;
  565. tempnode := nextnode;
  566. END;
  567. END;
  568. PROCEDURE RemoveLastNode(VAR fpclist : pList);
  569. VAR
  570. tempnode : pFPCNode;
  571. dummy : pNode;
  572. BEGIN
  573. tempnode := pFPCNode(fpclist^.lh_TailPred);
  574. if tempnode^.ln_Name <> nil then begin
  575. StrDispose(tempnode^.ln_Name);
  576. end;
  577. dummy := RemTail(fpclist);
  578. Dispose(tempnode);
  579. END;
  580. { get the total size allocated by list }
  581. { size is WITH ';' between the strings }
  582. FUNCTION SizeOfList(fpclist : pList): Longint;
  583. VAR
  584. i : Longint;
  585. dummy : Longint;
  586. tempnode : pFPCNode;
  587. tsize : Longint;
  588. BEGIN
  589. tsize := 0;
  590. i := NodesInList(fpclist);
  591. tempnode := pFPCNode(fpclist^.lh_Head);
  592. FOR dummy := 1 TO i DO BEGIN
  593. IF tempnode^.ln_Name <> NIL THEN BEGIN
  594. tsize := tsize + (StrLen(tempnode^.ln_Name)+1)
  595. END;
  596. tempnode := pFPCNode(tempnode^.ln_Succ);
  597. END;
  598. SizeOfList := tsize;
  599. END;
  600. { sort the list using a bubble sort }
  601. PROCEDURE SortList(VAR fpclist: pList);
  602. VAR
  603. notfinished : BOOLEAN;
  604. first, second : pFPCNode;
  605. n,i : Longint;
  606. BEGIN
  607. IF fpclist^.lh_Head^.ln_Succ <> NIL THEN BEGIN
  608. notfinished := True;
  609. i := NodesInList(fpclist);
  610. WHILE (notfinished) DO BEGIN
  611. notfinished := FALSE;
  612. first := pFPCNode(fpclist^.lh_Head);
  613. IF first <> NIL THEN BEGIN
  614. n := 1;
  615. second := pFPCNode(first^.ln_Succ);
  616. WHILE n <> i DO BEGIN
  617. n := n + 1;
  618. IF (StrIComp(first^.ln_Name,second^.ln_Name)>0) THEN BEGIN
  619. Remove(pNode(first));
  620. {$ifdef Amiga}
  621. ExecInsert(fpclist,pNode(first),pNode(second));
  622. {$else}
  623. Insert(fpclist,pNode(first),pNode(second));
  624. {$endif}
  625. notfinished := True;
  626. END ELSE
  627. first := second;
  628. second := pFPCNode(first^.ln_Succ);
  629. END;
  630. END;
  631. END;
  632. END;
  633. END;
  634. FUNCTION UpDateNode(ANode : pFPCNode; data : PChar): BOOLEAN;
  635. VAR
  636. result : BOOLEAN;
  637. BEGIN
  638. IF ANode^.ln_Succ <> NIL THEN BEGIN
  639. IF ANode^.ln_Name <> NIL THEN BEGIN
  640. StrDispose(ANode^.ln_Name);
  641. ANode^.ln_Name := StrAlloc(StrLen(data)+1);
  642. IF ANode^.ln_Name <> NIL THEN BEGIN
  643. StrCopy(ANode^.ln_Name,data);
  644. result := True;
  645. END ELSE BEGIN
  646. result := FALSE;
  647. END;
  648. END;
  649. END;
  650. UpDateNode := result;
  651. END;
  652. FUNCTION UpDateNode(ANode : pFPCNode; data : String): BOOLEAN;
  653. VAR
  654. result : BOOLEAN;
  655. BEGIN
  656. IF ANode^.ln_Succ <> NIL THEN BEGIN
  657. IF ANode^.ln_Name <> NIL THEN BEGIN
  658. StrDispose(ANode^.ln_Name);
  659. ANode^.ln_Name := StrAlloc(Length(data)+1);
  660. IF ANode^.ln_Name <> NIL THEN BEGIN
  661. StrPCopy(ANode^.ln_Name,data);
  662. result := True;
  663. END ELSE BEGIN
  664. result := FALSE;
  665. END;
  666. END;
  667. END;
  668. UpDateNode := result;
  669. END;
  670. function FileToList(thefile : PChar; var thelist : pList): boolean;
  671. begin
  672. FileToList := FileToList(strpas(thefile), thelist);
  673. end;
  674. function FileToList(thefile : String; var thelist : pList): boolean;
  675. var
  676. Inf : Text;
  677. tempnode : pFPCNode;
  678. buffer : PChar;
  679. buf : Array [0..500] of Char;
  680. begin
  681. buffer := @buf;
  682. Assign(Inf, thefile);
  683. {$I-}
  684. Reset(Inf);
  685. {$I+}
  686. if IOResult = 0 then begin
  687. while not eof(Inf) do begin
  688. { I don't want end of lines here (for use with amiga listviews)
  689. just change this if you need newline characters.
  690. }
  691. Read(Inf, buffer);
  692. tempnode := AddNewNode(thelist,buffer);
  693. Readln(inf, buffer);
  694. end;
  695. CLose(Inf);
  696. FileToList := true;
  697. end else FileToList := false;
  698. end;
  699. function ListToFile(TheFile : PChar; thelist : pList): Boolean;
  700. begin
  701. ListToFile := ListToFile(strpas(TheFile), thelist);
  702. end;
  703. function ListToFile(TheFile : String; thelist : pList): Boolean;
  704. VAR
  705. Out : Text;
  706. i : Longint;
  707. dummy : Longint;
  708. tempnode : pFPCNode;
  709. begin
  710. Assign(Out, TheFile);
  711. {$I-}
  712. Rewrite(Out);
  713. {$I+}
  714. if IOResult = 0 then begin
  715. i := NodesInList(thelist);
  716. IF i > 0 THEN BEGIN
  717. tempnode := pFPCNode(thelist^.lh_Head);
  718. FOR dummy := 1 TO i DO BEGIN
  719. IF tempnode^.ln_Name <> NIL THEN BEGIN
  720. {
  721. Have to check the strlen here, if it's an
  722. empty pchar fpc will write out a #0
  723. }
  724. if strlen(tempnode^.ln_Name) > 0 then
  725. WriteLN(Out,tempnode^.ln_Name)
  726. else writeln(Out);
  727. END;
  728. tempnode := pFPCNode(tempnode^.ln_Succ);
  729. END;
  730. END;
  731. Close(Out);
  732. ListToFile := True;
  733. END Else ListToFile := False;
  734. END;
  735. end.