LISTUTIL.MOD 34 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977
  1. IMPLEMENTATION MODULE ListUtils;
  2. (*
  3. * REPERTOIRE
  4. * Release 1.6
  5. * By Charles Bradford and Cole Brecheen
  6. * (c) Copyright 1985-1992 PMI
  7. * Green Bay, Wisconsin
  8. * All rights reserved
  9. * (414) 468-6040
  10. *
  11. * $Header: D:/logfiles/mods/listutil.mov 1.6 10 Mar 1991 15:35:08 coleb $
  12. *
  13. *
  14. * For GenList manipulation routines that don't need access to
  15. * the internal structure of a GenList.
  16. *)
  17. IMPORT ByteFiddler;
  18. IMPORT EnvironUtils;
  19. IMPORT ErrorManager;
  20. IMPORT HandleIO;
  21. IMPORT GenLists;
  22. IMPORT LowLevel;
  23. IMPORT M2Strings;
  24. IMPORT Numbers;
  25. IMPORT NumTypes;
  26. IMPORT PosUtils;
  27. IMPORT StrConv;
  28. IMPORT StrEdit;
  29. IMPORT StringIO;
  30. IMPORT SYSTEM;
  31. IMPORT VStorage;
  32. VAR
  33. Initialized : BOOLEAN;
  34. PROCEDURE Init();
  35. BEGIN
  36. IF Initialized THEN
  37. RETURN;
  38. ELSE
  39. Initialized := TRUE;
  40. END;
  41. ByteFiddler.Init();
  42. EnvironUtils.Init();
  43. ErrorManager.Init();
  44. HandleIO.Init();
  45. GenLists.Init();
  46. LowLevel.Init();
  47. M2Strings.Init();
  48. Numbers.Init();
  49. NumTypes.Init();
  50. PosUtils.Init();
  51. StrConv.Init();
  52. StrEdit.Init();
  53. StringIO.Init();
  54. VStorage.Init();
  55. END Init;
  56. PROCEDURE InitResponse(msg : ARRAY OF CHAR);
  57. (*All calls to InitResponse are diagnostic. Remove them from
  58. finished programs.*)
  59. VAR
  60. TmpStr : ARRAY [0..79] OF CHAR;
  61. BEGIN
  62. StrEdit.AssignStr('Uninit. list passed to ', TmpStr);
  63. StrEdit.Append(TmpStr, msg);
  64. ErrorManager.WARN(TmpStr);
  65. END InitResponse;
  66. (*$O-*)
  67. PROCEDURE CharCount( TheList : GenLists.GenList;
  68. StartLine, EndLine: CARDINAL ): LONGINT;
  69. VAR
  70. tmp1, tmp2: LONGINT;
  71. lngth, cnt: CARDINAL;
  72. BEGIN
  73. tmp2 := NumTypes.L0;
  74. lngth := GenLists.ListLength( TheList );
  75. IF EndLine > lngth THEN
  76. EndLine := lngth;
  77. END;
  78. FOR cnt := StartLine TO EndLine DO
  79. tmp1 := Numbers.Lc( ElmtSize(TheList, cnt) );
  80. (*Workaround for Logitech LONGINT bug.*)
  81. tmp2 := tmp2 + tmp1;
  82. END;
  83. RETURN tmp2;
  84. END CharCount;
  85. (*$O=*)
  86. PROCEDURE CheckLength(VAR TheList : GenLists.GenList;
  87. LeftMargin, LngthLimit : CARDINAL);
  88. VAR
  89. delimiters : ARRAY [0..15] OF CHAR;
  90. tmpsize, cnt, DumType, BreakSpot : CARDINAL;
  91. tmpadr: SYSTEM.ADDRESS;
  92. BEGIN
  93. delimiters := ' -,)]?+';
  94. cnt := 1;
  95. WHILE cnt <= GenLists.ListLength( TheList) DO
  96. tmpsize := ElmtSize( TheList, cnt );
  97. (* we assign this out here to make it easier to see in
  98. the RTD *)
  99. IF tmpsize > LngthLimit THEN
  100. GenLists.GetElmtAdr( TheList, cnt, tmpadr, tmpsize, DumType );
  101. tmpsize := LowLevel.ScanEQ( tmpsize, 0C, tmpadr );
  102. (*reduce size to real string length*)
  103. BreakSpot := PosUtils.BreakPtAdr( tmpadr, tmpsize, LngthLimit,
  104. delimiters) + 1;
  105. GenLists.ListInsertAdr( LowLevel.AddAddr(tmpadr,
  106. BreakSpot), (tmpsize -BreakSpot) + LeftMargin + 1,
  107. 0, TheList, cnt + 1 );
  108. (* We can't use StrCode as the type in this
  109. ListInsertAdr because we need to reserve room in
  110. the list element beyond the null. *)
  111. GenLists.ChangeTypeCode( TheList, cnt + 1, GenLists.StrCode );
  112. LowLevel.Fill( LowLevel.AddAddr(tmpadr, BreakSpot), 1, 0C );
  113. (*Make sure there's a null terminator at end of old
  114. string.*)
  115. IF LeftMargin > 0 THEN
  116. GenLists.GetElmtAdr( TheList, cnt + 1, tmpadr, tmpsize, DumType );
  117. LowLevel.ShiftArrayRight( tmpadr, tmpsize, LeftMargin );
  118. LowLevel.Fill( tmpadr, LeftMargin, ' ' );
  119. END;
  120. END;
  121. INC( cnt );
  122. END;
  123. END CheckLength;
  124. PROCEDURE IndentationAt( TheList : GenLists.GenList;
  125. Line : CARDINAL ): CARDINAL;
  126. VAR
  127. tmpsize, indent, DumType: CARDINAL;
  128. tmpadr: SYSTEM.ADDRESS;
  129. BEGIN
  130. GenLists.GetElmtAdr( TheList, Line, tmpadr, tmpsize, DumType );
  131. tmpsize := LowLevel.ScanEQ( tmpsize, 0C, tmpadr );
  132. IF tmpsize = 0 THEN
  133. RETURN 65535;
  134. END;
  135. indent := LowLevel.ScanNE(tmpsize, ' ', tmpadr);
  136. RETURN indent;
  137. END IndentationAt;
  138. PROCEDURE ReformPara( VAR TheList : GenLists.GenList;
  139. LeftMargin, RightMargin : CARDINAL; VAR
  140. StartLine, CursorLine, CursorCol: CARDINAL;
  141. VAR LinesAdded, BytesAdded: INTEGER; VAR
  142. CursorBytePos: LONGINT );
  143. VAR
  144. blank : ARRAY [0..0] OF CHAR;
  145. delimiters : ARRAY [0..15] OF CHAR;
  146. tmpsize, cnt, indent, DumType, BreakSpot : CARDINAL;
  147. tmpadr: SYSTEM.ADDRESS;
  148. done : BOOLEAN;
  149. BEGIN
  150. blank[0] := ' ';
  151. delimiters := ' -,)]?+';
  152. cnt := StartLine;
  153. LinesAdded := 0;
  154. BytesAdded := 0;
  155. done := FALSE;
  156. WHILE (NOT done) AND (cnt <= GenLists.ListLength( TheList)) DO
  157. IF cnt = GenLists.ListLength( TheList ) THEN
  158. StartLine := cnt;
  159. done := TRUE;
  160. ELSE
  161. indent := IndentationAt( TheList, cnt + 1 );
  162. END;
  163. IF (NOT done) AND (indent = LeftMargin) THEN
  164. (* We bring the next line up and append it to this one. Means the
  165. reformat stops when we reach a line where indentation <>
  166. LeftMargin. *)
  167. GenLists.GetElmtAdr( TheList, cnt, tmpadr, tmpsize, DumType );
  168. tmpsize := LowLevel.ScanEQ( tmpsize, 0C, tmpadr );
  169. (*reduce size to real string length*)
  170. IF (tmpsize > 0) AND (ByteFiddler.PeekChar(
  171. LowLevel.AddAddr( tmpadr, tmpsize - 1 )) # ' ') THEN
  172. (* If this line doesn't end with a blank. *)
  173. InsertIntoElmt( TheList, cnt, SYSTEM.ADR(blank), 1, 65535 );
  174. (*Append a blank to this line because we're not going to
  175. insert leading blanks from the line below.*)
  176. INC( BytesAdded );
  177. END;
  178. IF CursorLine > (cnt + 1) THEN
  179. DEC( CursorLine );
  180. ELSIF (CursorLine = (cnt + 1)) THEN
  181. DEC( CursorLine );
  182. CursorCol := CursorCol + ElmtSize(TheList, cnt);
  183. END;
  184. GenLists.GetElmtAdr( TheList, cnt + 1, tmpadr, tmpsize, DumType );
  185. InsertIntoElmt( TheList, cnt, LowLevel.AddAddr(tmpadr, indent),
  186. ElmtSize(TheList, cnt + 1) - indent, 65535 );
  187. BytesAdded := BytesAdded - INTEGER(indent) - 2;
  188. (* We've deleted leading spaces and separating CR/LF. *)
  189. GenLists.ListDelete( TheList, cnt + 1, 1 );
  190. DEC( LinesAdded );
  191. ELSE
  192. done := TRUE;
  193. END;
  194. GenLists.GetElmtAdr( TheList, cnt, tmpadr, tmpsize, DumType );
  195. tmpsize := LowLevel.ScanEQ( tmpsize, 0C, tmpadr );
  196. (*reduce size to real string length*)
  197. IF (tmpsize > RightMargin) THEN
  198. done := FALSE;
  199. BreakSpot := PosUtils.BreakPtAdr( tmpadr, tmpsize, RightMargin,
  200. delimiters) + 1;
  201. IF CursorLine > cnt THEN
  202. INC( CursorLine );
  203. ELSIF (CursorLine = cnt) AND (CursorCol >= BreakSpot) THEN
  204. INC( CursorLine );
  205. CursorCol := CursorCol - BreakSpot;
  206. END;
  207. GenLists.ListInsertAdr( LowLevel.AddAddr(tmpadr,
  208. BreakSpot), (tmpsize -BreakSpot) + LeftMargin + 1,
  209. 0, TheList, cnt + 1 );
  210. (* We can't use StrCode as the type in this
  211. ListInsertAdr because we need to reserve room in
  212. the list element beyond the null. *)
  213. INC( LinesAdded );
  214. GenLists.ChangeTypeCode( TheList, cnt + 1, GenLists.StrCode );
  215. LowLevel.Fill( LowLevel.AddAddr(tmpadr, BreakSpot), 1, 0C );
  216. (*Make sure there's a null terminator at end of old
  217. string.*)
  218. IF LeftMargin > 0 THEN
  219. GenLists.GetElmtAdr( TheList, cnt + 1, tmpadr, tmpsize, DumType );
  220. LowLevel.ShiftArrayRight( tmpadr, tmpsize, LeftMargin );
  221. LowLevel.Fill( tmpadr, LeftMargin, ' ' );
  222. IF CursorLine = (cnt + 1) THEN
  223. CursorCol := CursorCol + LeftMargin;
  224. END;
  225. BytesAdded := BytesAdded + INTEGER(LeftMargin) + 2 ;
  226. (* We've added leading spaces on new line plus CR/LF
  227. on this one. *)
  228. ELSE
  229. BytesAdded := BytesAdded + 2;
  230. (* We've added only the CR/LF. *)
  231. END;
  232. END;
  233. INC( cnt );
  234. END;
  235. IF (CursorBytePos > NumTypes.L0) THEN
  236. (* They want us to compute new byte position. *)
  237. IF CursorLine > 1 THEN
  238. CursorBytePos := CharCount( TheList, 1, CursorLine - 1 ) +
  239. Numbers.Lc( CursorCol );
  240. ELSE
  241. CursorBytePos := Numbers.Lc( CursorCol );
  242. END;
  243. END;
  244. StartLine := cnt;
  245. END ReformPara;
  246. PROCEDURE DeTabList( VAR TheList: GenLists.GenList; VAR
  247. ListChanged: BOOLEAN );
  248. VAR
  249. TmpStr: ARRAY [0..255] OF CHAR;
  250. ListEnd, StartingSpot, StrSpot: CARDINAL;
  251. TabStr: ARRAY [0..0] OF CHAR;
  252. BEGIN
  253. TabStr[0] := 11C;
  254. ListEnd := GenLists.ListLength( TheList );
  255. StartingSpot := 1;
  256. ListChanged := FALSE;
  257. WHILE (StartingSpot <= ListEnd) AND (StartingSpot # 0) DO
  258. StartingSpot := GenLists.ScanList( TabStr, TheList, StartingSpot,
  259. ListEnd, StrSpot );
  260. IF StartingSpot > 0 THEN
  261. ListChanged := TRUE;
  262. GetStr( TheList, StartingSpot, TmpStr );
  263. StrEdit.CutTrailingChars( ' ', TmpStr );
  264. StrEdit.ReplaceTabs( TmpStr, 8 );
  265. GenLists.ListReplace( TmpStr, GenLists.StrCode, TheList,
  266. StartingSpot );
  267. END;
  268. END;
  269. END DeTabList;
  270. PROCEDURE EnTabList( VAR TheList: GenLists.GenList; LeadingOnly: BOOLEAN; VAR
  271. ListChanged: BOOLEAN );
  272. VAR
  273. TmpStr: ARRAY [0..255] OF CHAR;
  274. ListEnd, StartingSpot, StrSpot: CARDINAL;
  275. BlankStr: ARRAY [0..8] OF CHAR;
  276. BEGIN
  277. BlankStr := ' ';
  278. ListEnd := GenLists.ListLength( TheList );
  279. StartingSpot := 1;
  280. ListChanged := FALSE;
  281. WHILE (StartingSpot <= ListEnd) AND (StartingSpot # 0) DO
  282. StartingSpot := GenLists.ScanList( BlankStr, TheList, StartingSpot,
  283. ListEnd, StrSpot );
  284. IF StartingSpot > 0 THEN
  285. ListChanged := TRUE;
  286. GetStr( TheList, StartingSpot, TmpStr );
  287. StrEdit.CutTrailingChars( ' ', TmpStr );
  288. StrEdit.InsertTabs( TmpStr, 8, LeadingOnly );
  289. GenLists.ListReplace( TmpStr, GenLists.StrCode, TheList,
  290. StartingSpot );
  291. END;
  292. END;
  293. END EnTabList;
  294. PROCEDURE ElmtSize( TheList: GenLists.GenList; spot: CARDINAL ): CARDINAL;
  295. VAR
  296. TheAddr: SYSTEM.ADDRESS;
  297. TheSize, TypeCode: CARDINAL;
  298. BEGIN
  299. GenLists.GetElmtAdr( TheList, spot, TheAddr, TheSize, TypeCode );
  300. IF TypeCode = GenLists.StrCode THEN
  301. TheSize := LowLevel.ScanEQ( TheSize, 0C, TheAddr );
  302. END;
  303. RETURN TheSize;
  304. END ElmtSize;
  305. PROCEDURE GetStr( TheList: GenLists.GenList; spot: CARDINAL; VAR
  306. TheStr: ARRAY OF CHAR );
  307. VAR
  308. TypeCode: CARDINAL;
  309. BEGIN
  310. GenLists.GetElmt( TheList, spot, TheStr, TypeCode );
  311. IF TypeCode # GenLists.StrCode THEN
  312. ErrorManager.WARN('Not a string');
  313. END;
  314. END GetStr;
  315. PROCEDURE HandleToList( TheHandle : VStorage.MemHandle;
  316. BlockSize : CARDINAL; delimiter1, delimiter2 : ARRAY OF
  317. CHAR; RecSize, TypeCode : CARDINAL; VAR TheList : GenLists.GenList);
  318. VAR
  319. BytesDone, Delim1Len, Delim2Len : CARDINAL;
  320. TwoDelimiters, FixedLengthRecs : BOOLEAN;
  321. PROCEDURE AnElmtStartsHere( OffSet: CARDINAL ): BOOLEAN;
  322. VAR
  323. TmpAdr: SYSTEM.ADDRESS;
  324. BEGIN
  325. IF FixedLengthRecs OR (NOT TwoDelimiters) THEN
  326. RETURN FALSE;
  327. END;
  328. TmpAdr := VStorage.LockMem( TheHandle );
  329. VStorage.UnLockMem( TheHandle );
  330. LowLevel.IncAddr( TmpAdr, OffSet );
  331. IF (BytesDone >= BlockSize) OR (0 = PosUtils.PosAdr(
  332. delimiter1, TmpAdr, BlockSize - BytesDone)) THEN
  333. RETURN TRUE;
  334. END;
  335. RETURN FALSE;
  336. END AnElmtStartsHere;
  337. PROCEDURE AnElmtEndsHere( OffSet: CARDINAL ): BOOLEAN;
  338. VAR
  339. TmpAdr: SYSTEM.ADDRESS;
  340. BEGIN
  341. IF FixedLengthRecs OR (NOT TwoDelimiters) THEN
  342. RETURN FALSE;
  343. END;
  344. TmpAdr := VStorage.LockMem( TheHandle );
  345. VStorage.UnLockMem( TheHandle );
  346. LowLevel.IncAddr( TmpAdr, OffSet );
  347. IF (BytesDone >= BlockSize) OR (0 = PosUtils.PosAdr(
  348. delimiter2, TmpAdr, BlockSize - BytesDone)) THEN
  349. RETURN TRUE;
  350. END;
  351. RETURN FALSE;
  352. END AnElmtEndsHere;
  353. PROCEDURE SizeOfElement( OldAdr: SYSTEM.ADDRESS ): CARDINAL;
  354. (*Returns the address of the first byte following delimiter2,
  355. but dist includes only the bytes preceding delimiter2.*)
  356. BEGIN
  357. IF FixedLengthRecs THEN
  358. RETURN RecSize;
  359. ELSE
  360. RETURN PosUtils.PosAdr( delimiter2, OldAdr, BlockSize-BytesDone);
  361. END;
  362. END SizeOfElement;
  363. PROCEDURE MakeOneList( TheList : GenLists.GenList );
  364. VAR
  365. TmpTypeCode, TmpSize: CARDINAL;
  366. TmpAdr: SYSTEM.ADDRESS;
  367. SubList : GenLists.GenList;
  368. BEGIN
  369. LOOP
  370. IF TwoDelimiters THEN
  371. LOOP
  372. (*Skip the leading delim1, if there is one, and
  373. move at least to the byte just beyond the next
  374. delim1.*)
  375. IF AnElmtStartsHere(BytesDone) THEN
  376. INC( BytesDone, Delim1Len );
  377. EXIT;
  378. ELSE
  379. INC( BytesDone, Delim1Len );
  380. END;
  381. END;
  382. END;
  383. IF (BytesDone >= BlockSize) THEN
  384. EXIT;
  385. END;
  386. IF (TypeCode < 65000)
  387. AND (NOT FixedLengthRecs)
  388. AND TwoDelimiters THEN
  389. TmpAdr := VStorage.LockMem( TheHandle );
  390. LowLevel.IncAddr( TmpAdr, BytesDone );
  391. LowLevel.Move( TmpAdr, SYSTEM.ADR(TmpTypeCode), 2);
  392. VStorage.UnLockMem( TheHandle );
  393. INC( BytesDone, 2 );
  394. ELSE
  395. TmpTypeCode := TypeCode;
  396. END;
  397. IF (TmpTypeCode = GenLists.ListCode) OR AnElmtStartsHere(
  398. BytesDone ) THEN
  399. GenLists.NewList( SubList );
  400. IF AnElmtEndsHere( BytesDone ) THEN
  401. (*Null list.*)
  402. INC( BytesDone, Delim2Len );
  403. ELSE
  404. MakeOneList( SubList );
  405. END;
  406. GenLists.ListInsert( SubList, GenLists.ListCode, TheList, 65535 );
  407. ELSE
  408. TmpAdr := VStorage.LockMem( TheHandle );
  409. VStorage.UnLockMem( TheHandle );
  410. LowLevel.IncAddr( TmpAdr, BytesDone );
  411. TmpSize := SizeOfElement( TmpAdr );
  412. GenLists.ListInsertAdr( TmpAdr, TmpSize, TmpTypeCode,
  413. TheList, 65535 );
  414. INC( BytesDone, TmpSize + Delim2Len );
  415. END;
  416. IF (BytesDone >= BlockSize) OR (AnElmtEndsHere(BytesDone)) THEN
  417. (*Increment past the delimiter2 that ends the whole list.*)
  418. INC( BytesDone, Delim2Len );
  419. EXIT;
  420. END;
  421. END;
  422. END MakeOneList;
  423. BEGIN
  424. (*HandleToList*)
  425. IF NOT GenLists.Initialized( TheList ) THEN
  426. InitResponse( 'HandleToList' );
  427. END;
  428. Delim1Len := M2Strings.Length(delimiter1);
  429. Delim2Len := M2Strings.Length(delimiter2);
  430. TwoDelimiters := FALSE;
  431. IF ((Delim1Len>0) OR (Delim2Len>0)) AND (RecSize>0) THEN
  432. ErrorManager.WARN("Delim-RecSize conflict");
  433. RETURN;
  434. END;
  435. FixedLengthRecs := RecSize>0;
  436. IF FixedLengthRecs THEN
  437. IF ((BlockSize MOD RecSize) # 0) THEN
  438. ErrorManager.WARN('Bad Recsize');
  439. RETURN;
  440. END;
  441. ELSE
  442. IF NOT PosUtils.Equal(delimiter1,delimiter2) THEN
  443. TwoDelimiters := TRUE;
  444. END;
  445. END;
  446. BytesDone := 0;
  447. MakeOneList( TheList );
  448. VStorage.DeallocMem( TheHandle, BlockSize );
  449. END HandleToList;
  450. (*$O-*)
  451. (*We turn off optimization for this procedure because of a bug in
  452. Logitech's v3.0.*)
  453. PROCEDURE ListToFileHandle( TheList: GenLists.GenList; TheHandle:
  454. CARDINAL; delim1, delim2: ARRAY OF CHAR;
  455. InitialNestingLevel: CARDINAL; VAR BytesWritten:
  456. LONGINT ): CARDINAL;
  457. VAR
  458. TmpAdr: SYSTEM.ADDRESS;
  459. LstCount, LstLngth, TypeCode, TmpSize, DumRecSz,
  460. Delim1Lngth, Delim2Lngth, tmpc: CARDINAL;
  461. SubList: GenLists.GenList;
  462. NilList, TwoDelimiters: BOOLEAN;
  463. SavedMessage: CARDINAL;
  464. TmpL, TmpBytesWritten: LONGINT;
  465. BEGIN
  466. BytesWritten := NumTypes.L0;
  467. Delim1Lngth := M2Strings.Length( delim1 );
  468. Delim2Lngth := M2Strings.Length( delim2 );
  469. TwoDelimiters := (Delim1Lngth > 0) AND (Delim2Lngth > 0);
  470. (*We begin and end the procedure by bracketing the
  471. entire block with a StartSep and EndSep, if the
  472. parameter list indicates that they're in use. That's
  473. the convention NdxFiles uses to indicate that the block
  474. as a whole represents a list.*)
  475. IF (Delim1Lngth > 0) AND (InitialNestingLevel = 0) THEN
  476. SavedMessage := HandleIO.BlockWrite( TheHandle,
  477. SYSTEM.ADR(delim1), Delim1Lngth );
  478. TmpL := Numbers.Lc(Delim1Lngth);
  479. (*Necessary because of a bug in Logitech's LONGINT
  480. addition.*)
  481. BytesWritten := BytesWritten + TmpL;
  482. END;
  483. IF TwoDelimiters AND (InitialNestingLevel = 0) THEN
  484. tmpc := GenLists.ListCode;
  485. (*We have to do this because some implementations won't
  486. give us the address of a constant.*)
  487. SavedMessage := HandleIO.BlockWrite( TheHandle,
  488. SYSTEM.ADR(tmpc), SYSTEM.TSIZE(CARDINAL) );
  489. BytesWritten := BytesWritten + Numbers.Lc(SYSTEM.TSIZE(CARDINAL));
  490. END;
  491. IF GenLists.Initialized( TheList ) THEN
  492. NilList := FALSE;
  493. ELSE
  494. GenLists.NewList( TheList );
  495. NilList := TRUE;
  496. END;
  497. GenLists.ListToBlock( TheList, delim1, delim2,
  498. TmpAdr, TmpSize, DumRecSz);
  499. IF (GenLists.ErrorFlag = GenLists.NoListError) THEN
  500. SavedMessage := HandleIO.BlockWrite( TheHandle,
  501. TmpAdr, TmpSize );
  502. (*Write the Ndx as a single block.*)
  503. VStorage.DosDealloc( TmpAdr, TmpSize);
  504. (*Get rid of temporary buffer space used.*)
  505. BytesWritten := BytesWritten + Numbers.Lc(TmpSize);
  506. IF (Delim2Lngth > 0) AND (InitialNestingLevel = 0) THEN
  507. SavedMessage := HandleIO.BlockWrite( TheHandle,
  508. SYSTEM.ADR(delim2), Delim2Lngth );
  509. BytesWritten := BytesWritten + Numbers.Lc(Delim2Lngth);
  510. END;
  511. IF NilList THEN
  512. GenLists.DisposeList( TheList );
  513. END;
  514. RETURN SavedMessage;
  515. END;
  516. (*Write the NdxElements one by one if there isn't
  517. enough memory to write them as a block.*)
  518. LstLngth := GenLists.ListLength( TheList );
  519. LstCount := 1;
  520. WHILE LstCount <= LstLngth DO
  521. GenLists.GetElmtAdr( TheList, LstCount, TmpAdr,
  522. TmpSize, TypeCode );
  523. IF Delim1Lngth > 0 THEN
  524. SavedMessage := HandleIO.BlockWrite( TheHandle,
  525. SYSTEM.ADR(delim1), Delim1Lngth );
  526. BytesWritten := BytesWritten + Numbers.Lc(Delim1Lngth);
  527. END;
  528. IF TwoDelimiters THEN
  529. SavedMessage := HandleIO.BlockWrite( TheHandle,
  530. SYSTEM.ADR(TypeCode), SYSTEM.TSIZE(CARDINAL) );
  531. BytesWritten := BytesWritten + Numbers.Lc(SYSTEM.TSIZE(CARDINAL));
  532. END;
  533. IF TypeCode = GenLists.ListCode THEN
  534. GenLists.GetChildList( TheList, LstCount, SubList );
  535. SavedMessage := ListToFileHandle( SubList, TheHandle,
  536. delim1, delim2, InitialNestingLevel + 1,
  537. TmpBytesWritten );
  538. BytesWritten := BytesWritten + TmpBytesWritten;
  539. IF SavedMessage # StringIO.NoError THEN
  540. IF NilList THEN
  541. GenLists.DisposeList( TheList );
  542. END;
  543. RETURN SavedMessage;
  544. END;
  545. ELSE
  546. SavedMessage := HandleIO.BlockWrite( TheHandle,
  547. TmpAdr, TmpSize );
  548. BytesWritten := BytesWritten + Numbers.Lc( TmpSize );
  549. END;
  550. IF Delim2Lngth > 0 THEN
  551. SavedMessage := HandleIO.BlockWrite( TheHandle,
  552. SYSTEM.ADR(delim2), Delim2Lngth );
  553. BytesWritten := BytesWritten + Numbers.Lc(Delim2Lngth);
  554. END;
  555. INC(LstCount);
  556. END;
  557. IF (Delim2Lngth > 0) AND (InitialNestingLevel = 0) THEN
  558. SavedMessage := HandleIO.BlockWrite( TheHandle,
  559. SYSTEM.ADR(delim2), Delim2Lngth );
  560. BytesWritten := BytesWritten + Numbers.Lc(Delim2Lngth);
  561. END;
  562. IF NilList THEN
  563. GenLists.DisposeList( TheList );
  564. END;
  565. RETURN SavedMessage;
  566. END ListToFileHandle;
  567. (*$O=*)
  568. PROCEDURE InsertElmtsOf( List1: GenLists.GenList; StartingAt,
  569. NumberOfLines: CARDINAL; VAR List2: GenLists.GenList;
  570. InsertionPoint: CARDINAL );
  571. VAR
  572. cnt, tmpsize, TypeCode, List2Lngth : CARDINAL;
  573. tmpadr: SYSTEM.ADDRESS;
  574. BEGIN
  575. NumberOfLines := Numbers.Min( NumberOfLines,
  576. GenLists.ListLength( List1 ) );
  577. List2Lngth := GenLists.ListLength( List2 );
  578. IF Numbers.Lc(InsertionPoint) +
  579. Numbers.Lc( NumberOfLines ) > NumTypes.L65535 THEN
  580. InsertionPoint := List2Lngth + 1;
  581. END;
  582. FOR cnt := 1 TO NumberOfLines DO
  583. GenLists.GetElmtAdr( List1, StartingAt + cnt - 1, tmpadr,
  584. tmpsize, TypeCode );
  585. GenLists.ListInsertAdr( tmpadr, tmpsize, TypeCode, List2,
  586. InsertionPoint + (cnt - 1) );
  587. END;
  588. END InsertElmtsOf;
  589. PROCEDURE InsertIntoElmt( VAR TheList: GenLists.GenList;
  590. ListSpot: CARDINAL; StrAdr: SYSTEM.ADDRESS; StrSize:
  591. CARDINAL; ElmtSpot: CARDINAL );
  592. VAR
  593. tmpadr1, tmpadr2: SYSTEM.ADDRESS;
  594. TypeCode, tmpsize: CARDINAL;
  595. BEGIN
  596. GenLists.GetElmtAdr( TheList, ListSpot, tmpadr1, tmpsize, TypeCode );
  597. (* Make sure we're inserting into a string. *)
  598. IF TypeCode # GenLists.StrCode THEN
  599. ErrorManager.WARN('Not a string');
  600. END;
  601. tmpsize := LowLevel.ScanEQ( tmpsize, 0C, tmpadr1 );
  602. (* This means you can insert your string at ElmtSpot 65535 and
  603. have it neatly appended. *)
  604. IF ElmtSpot > tmpsize THEN
  605. ElmtSpot := tmpsize;
  606. END;
  607. VStorage.DosAlloc( tmpadr2, tmpsize + StrSize );
  608. LowLevel.Move( tmpadr1, tmpadr2, ElmtSpot );
  609. LowLevel.Move( StrAdr, LowLevel.AddAddr(tmpadr2, ElmtSpot), StrSize );
  610. LowLevel.Move( LowLevel.AddAddr(tmpadr1, ElmtSpot),
  611. LowLevel.AddAddr(tmpadr2, ElmtSpot + StrSize), tmpsize - ElmtSpot );
  612. GenLists.ListReplaceAdr( tmpadr2, tmpsize + StrSize, GenLists.StrCode,
  613. TheList, ListSpot );
  614. VStorage.DosDealloc( tmpadr2, tmpsize + StrSize );
  615. END InsertIntoElmt;
  616. PROCEDURE IsBlankList( TheList: GenLists.GenList ): BOOLEAN;
  617. (*We use this procedure to test Editor fields that have been
  618. marked "required."*)
  619. VAR
  620. SomethingFound: BOOLEAN;
  621. lngth, cnt, TypeCode: CARDINAL;
  622. LocalStr: ARRAY [0..127] OF CHAR;
  623. BEGIN
  624. IF NOT GenLists.Initialized(TheList) THEN
  625. RETURN TRUE;
  626. END;
  627. SomethingFound := FALSE;
  628. lngth := GenLists.ListLength( TheList );
  629. cnt := 1;
  630. WHILE (cnt <= lngth) AND (NOT SomethingFound) DO
  631. GenLists.GetElmt( TheList, cnt, LocalStr, TypeCode );
  632. SomethingFound := (TypeCode # GenLists.StrCode) OR (NOT
  633. PosUtils.IsBlank( LocalStr ));
  634. INC(cnt);
  635. END;
  636. RETURN NOT SomethingFound;
  637. END IsBlankList;
  638. PROCEDURE ListToString( TheList: GenLists.GenList; VAR TheStr: ARRAY OF CHAR);
  639. VAR
  640. tmpstr: ARRAY [0..255] OF CHAR;
  641. lngth, TypeCode, cnt: CARDINAL;
  642. BEGIN
  643. lngth := GenLists.ListLength( TheList );
  644. StrEdit.SetLength( TheStr, 0 );
  645. FOR cnt := 1 TO lngth DO
  646. GenLists.GetElmt( TheList, cnt, tmpstr, TypeCode );
  647. IF TypeCode = GenLists.StrCode THEN
  648. StrEdit.Append( TheStr, tmpstr );
  649. END;
  650. END;
  651. END ListToString;
  652. PROCEDURE LongestLine( TheList: GenLists.GenList ): CARDINAL;
  653. VAR
  654. LstLngth, lngth, cnt, longest: CARDINAL;
  655. BEGIN
  656. LstLngth := GenLists.ListLength( TheList );
  657. longest := 0;
  658. FOR cnt := 1 TO LstLngth DO
  659. lngth := ElmtSize( TheList, cnt );
  660. IF lngth > longest THEN
  661. longest := lngth;
  662. END;
  663. END;
  664. RETURN longest;
  665. END LongestLine;
  666. PROCEDURE OverwriteElmt( VAR TheList: GenLists.GenList;
  667. ListSpot: CARDINAL; StrAdr: SYSTEM.ADDRESS; StrSize:
  668. CARDINAL; ElmtSpot: CARDINAL );
  669. VAR
  670. tmpadr1, tmpadr2: SYSTEM.ADDRESS;
  671. excess, TypeCode, tmpsize: CARDINAL;
  672. BEGIN
  673. GenLists.GetElmtAdr( TheList, ListSpot, tmpadr1, tmpsize, TypeCode );
  674. IF TypeCode # GenLists.StrCode THEN
  675. ErrorManager.WARN('Not a string');
  676. END;
  677. IF tmpsize >= (ElmtSpot + StrSize) THEN
  678. LowLevel.Move( StrAdr, LowLevel.AddAddr(tmpadr1, ElmtSpot), StrSize );
  679. ELSE
  680. excess := (ElmtSpot + StrSize) - tmpsize;
  681. VStorage.DosAlloc( tmpadr2, tmpsize + excess );
  682. LowLevel.Move( tmpadr1, tmpadr2, ElmtSpot );
  683. LowLevel.Move( StrAdr, LowLevel.AddAddr(tmpadr2, ElmtSpot), StrSize );
  684. GenLists.ListReplaceAdr( tmpadr2, tmpsize + excess,
  685. GenLists.StrCode, TheList, ListSpot );
  686. VStorage.DosDealloc( tmpadr2, tmpsize + excess );
  687. END;
  688. END OverwriteElmt;
  689. PROCEDURE ObjectSpot( BinaryObject : ARRAY OF SYSTEM.BYTE;
  690. TheList : GenLists.GenList; StartingAt, EndingAt :
  691. CARDINAL) : CARDINAL;
  692. VAR
  693. cnt, ListEnd, ObjSize, TmpSize, TypeCode : CARDINAL;
  694. TmpAdr : SYSTEM.ADDRESS;
  695. BEGIN
  696. (*ObjectSpot*)
  697. ListEnd := GenLists.ListLength( TheList );
  698. IF ListEnd < EndingAt THEN
  699. EndingAt := ListEnd;
  700. END;
  701. IF StartingAt > EndingAt THEN
  702. RETURN 0;
  703. END;
  704. ObjSize := HIGH( BinaryObject ) + 1;
  705. FOR cnt := StartingAt TO EndingAt DO
  706. GenLists.GetElmtAdr( TheList, cnt, TmpAdr, TmpSize, TypeCode );
  707. IF TmpSize = ObjSize THEN
  708. IF PosUtils.PatternScan( SYSTEM.ADR(BinaryObject), ObjSize,
  709. TmpAdr, TmpSize ) = 0 THEN
  710. RETURN cnt;
  711. END;
  712. END;
  713. END;
  714. RETURN 0;
  715. (*BinaryObject not found between StartingAt and EndingAt.*)
  716. END ObjectSpot;
  717. PROCEDURE PrintList( fhandle: CARDINAL; TheList : GenLists.GenList;
  718. LeftMargin: CARDINAL; Separator: ARRAY OF CHAR );
  719. PROCEDURE PrintRecursive( fhandle: CARDINAL; TheList :
  720. GenLists.GenList; Separator: ARRAY OF CHAR; InSubList:
  721. BOOLEAN );
  722. VAR
  723. SubLeader, TmpStr : ARRAY [0..80] OF CHAR;
  724. SubList : GenLists.GenList;
  725. TmpSiz, cnt, ListLen, TypeCode, spot : CARDINAL;
  726. FirstTime: BOOLEAN;
  727. TmpAdr: SYSTEM.ADDRESS;
  728. BEGIN
  729. IF InSubList THEN
  730. StringIO.PrintMessage( HandleIO.FillFile( fhandle,
  731. LeftMargin, ' ' ) );
  732. StringIO.WriteStr( fhandle, '{' );
  733. END;
  734. FirstTime := TRUE;
  735. spot := 1;
  736. ListLen := GenLists.ListLength(TheList);
  737. IF GenLists.ErrorFlag # GenLists.NoListError THEN
  738. ErrorManager.WARN('Uninitialized list?');
  739. END;
  740. REPEAT
  741. IF spot<=ListLen THEN
  742. GenLists.GetElmtAdr( TheList, spot, TmpAdr, TmpSiz, TypeCode );
  743. IF TypeCode=GenLists.ListCode THEN
  744. GenLists.GetChildList(TheList, spot, SubList);
  745. PrintRecursive( fhandle, SubList, Separator, TRUE);
  746. ELSE
  747. IF FirstTime THEN
  748. FirstTime := FALSE;
  749. ELSE
  750. StringIO.WriteStr( fhandle, Separator );
  751. END;
  752. IF TypeCode = GenLists.StrCode THEN
  753. GetStr( TheList, spot, TmpStr );
  754. IF PosUtils.Present( Separator, TmpStr ) THEN
  755. StringIO.WriteStr( fhandle, '"' );
  756. StringIO.WriteStr( fhandle, TmpStr );
  757. StringIO.WriteStr( fhandle, '"' );
  758. ELSE
  759. StringIO.PrintMessage( HandleIO.FillFile( fhandle,
  760. LeftMargin, ' ' ) );
  761. StringIO.WriteStr( fhandle, TmpStr );
  762. END;
  763. ELSE
  764. StrConv.CardinalToStr( spot, 2, TmpStr );
  765. StringIO.PrintMessage( HandleIO.FillFile( fhandle,
  766. LeftMargin, ' ' ) );
  767. StringIO.WriteStr( fhandle, TmpStr );
  768. StringIO.WriteStr( fhandle, ': ' );
  769. StringIO.WriteStr( fhandle, 'Size = ' );
  770. StrConv.CardinalToStr( TmpSiz, 4, TmpStr );
  771. StringIO.WriteStr( fhandle, TmpStr );
  772. StringIO.WriteStr( fhandle, '; Type = ' );
  773. StrConv.CardinalToStr( TypeCode, 0, TmpStr );
  774. StringIO.WriteStr( fhandle, TmpStr );
  775. END;
  776. END;
  777. END;
  778. INC(spot);
  779. UNTIL spot>ListLen;
  780. IF InSubList THEN
  781. StringIO.WriteStr( fhandle, '}' );
  782. END;
  783. END PrintRecursive;
  784. BEGIN (* PrintList *)
  785. PrintRecursive( fhandle, TheList, Separator, FALSE );
  786. (*We don't call PrintList itself recursively because we
  787. don't want the CrLf from the WriteEol below to follow
  788. embedded lists.*)
  789. StringIO.WriteEol( fhandle, '' );
  790. END PrintList;
  791. PROCEDURE TextFileToList( VAR TheFile: ARRAY OF CHAR;
  792. VAR TheList: GenLists.GenList): CARDINAL;
  793. (* finds the file, reads it into the list, closes the file *)
  794. VAR
  795. SizeLeft, SizeOK, DoSizeL : LONGINT;
  796. ResultErr: CARDINAL;
  797. NextList: GenLists.GenList;
  798. DoSizeC, TheHandl : CARDINAL;
  799. GoBack : INTEGER;
  800. buffer: SYSTEM.ADDRESS;
  801. BEGIN
  802. IF NOT GenLists.Initialized( TheList ) THEN
  803. InitResponse( 'TextFileToList' );
  804. END;
  805. ResultErr := HandleIO.FindFile( TheHandl, TheFile, 'PATH');
  806. IF StringIO.NoError # ResultErr THEN
  807. RETURN ResultErr;
  808. END;
  809. SizeLeft := HandleIO.FileLength( TheHandl);
  810. WHILE SizeLeft # Numbers.Lc( 0) DO
  811. (* first, get a mem block <= 65000 bytes *)
  812. DoSizeC := 65000;
  813. IF NOT VStorage.DosAvail( DoSizeC) THEN
  814. (* If there's not a 64K chunk available, get as much as there
  815. is.*)
  816. DoSizeC := EnvironUtils.MemAvail( 100);
  817. END;
  818. SizeOK := Numbers.Lc( DoSizeC);
  819. IF ( SizeLeft > SizeOK)
  820. AND ( Numbers.Lc( 64000) > SizeLeft) THEN
  821. GenLists.DisposeList( TheList );
  822. ResultErr := HandleIO.CloseHandle( TheHandl);
  823. RETURN StringIO.TooLittleMemory;
  824. END;
  825. IF SizeLeft > SizeOK THEN
  826. DoSizeL := SizeOK;
  827. ELSE
  828. DoSizeL := SizeLeft;
  829. END;
  830. SizeLeft := SizeLeft - DoSizeL;
  831. DoSizeC := Numbers.C( DoSizeL );
  832. IF NOT VStorage.DosAvail( DoSizeC ) THEN
  833. ResultErr := HandleIO.CloseHandle( TheHandl);
  834. RETURN StringIO.TooLittleMemory;
  835. END;
  836. VStorage.DosAlloc( buffer, DoSizeC );
  837. ResultErr := HandleIO.BlockRead( TheHandl, buffer, DoSizeC);
  838. IF StringIO.NoError # ResultErr THEN
  839. ResultErr := HandleIO.CloseHandle( TheHandl);
  840. RETURN ResultErr;
  841. END;
  842. IF SizeLeft # Numbers.Lc( 0) THEN
  843. GoBack := LowLevel.ScanEQ( -32000, 12C,
  844. LowLevel.AddAddr(buffer, DoSizeC - 1) );
  845. (* to locate a cut-ff line, look for the last
  846. line-feed character before the end of the block *)
  847. IF GoBack = -32000 THEN
  848. (* No LF found in last 32000 bytes of block *)
  849. ResultErr := HandleIO.CloseHandle( TheHandl);
  850. RETURN StringIO.BadData;
  851. END;
  852. DoSizeL := Numbers.Lc( -GoBack );
  853. SizeLeft := SizeLeft + DoSizeL;
  854. DoSizeL := -DoSizeL;
  855. HandleIO.SetFilePtr( TheHandl, HandleIO.FromCurrent, DoSizeL);
  856. (* change file position and counters to start from
  857. beginning of the line that was cut off *)
  858. END;
  859. GenLists.NewList( NextList );
  860. GenLists.BlockToList( buffer, DoSizeC, StringIO.CrLf,
  861. StringIO.CrLf, 0, GenLists.StrCode, NextList);
  862. GenLists.JoinLists( NextList, TheList, 65535);
  863. END;
  864. ResultErr := HandleIO.CloseHandle( TheHandl);
  865. RETURN ResultErr;
  866. END TextFileToList;
  867. PROCEDURE TextListToFile( VAR TheList: GenLists.GenList;
  868. TheFile: ARRAY OF CHAR): CARDINAL;
  869. (* creates the file; writes the list to it and closes file *)
  870. VAR
  871. StrAdr1, StrAdr2: SYSTEM.ADDRESS;
  872. StrSize, DumType, SizeL, TheHandl, cnt: CARDINAL;
  873. ResultErr: CARDINAL;
  874. TmpCrLf: ARRAY [0..2] OF CHAR;
  875. BEGIN
  876. StrEdit.AssignStr( StringIO.CrLf, TmpCrLf );
  877. ResultErr := HandleIO.CreateFile( TheHandl, TheFile);
  878. IF StringIO.NoError # ResultErr THEN
  879. RETURN ResultErr;
  880. END;
  881. SizeL := GenLists.ListLength( TheList);
  882. FOR cnt := 1 TO SizeL DO
  883. GenLists.GetElmtAdr( TheList, cnt, StrAdr1, StrSize, DumType);
  884. StrSize := LowLevel.ScanEQ( StrSize, 0C, StrAdr1 );
  885. (* Reduce StrSize to number of bytes before the null. *)
  886. VStorage.DosAlloc( StrAdr2, StrSize + 2 );
  887. LowLevel.Move( StrAdr1, StrAdr2, StrSize );
  888. LowLevel.Move( SYSTEM.ADR(TmpCrLf),
  889. LowLevel.AddAddr(StrAdr2, StrSize), 2 );
  890. ResultErr := HandleIO.BlockWrite( TheHandl,
  891. StrAdr2, StrSize + 2 );
  892. VStorage.DosDealloc( StrAdr2, StrSize + 2 );
  893. IF StringIO.NoError # ResultErr THEN
  894. RETURN ResultErr;
  895. END;
  896. END;
  897. ResultErr := HandleIO.CloseHandle( TheHandl);
  898. RETURN ResultErr;
  899. END TextListToFile;
  900. PROCEDURE TypeCheck( TheList: GenLists.GenList; spot: CARDINAL ): CARDINAL;
  901. VAR
  902. DumAddr: SYSTEM.ADDRESS;
  903. TheSize, TypeCode: CARDINAL;
  904. BEGIN
  905. GenLists.GetElmtAdr( TheList, spot, DumAddr, TheSize, TypeCode );
  906. RETURN TypeCode;
  907. END TypeCheck;
  908. BEGIN
  909. Initialized := FALSE;
  910. Init();
  911. END ListUtils.