GENEDT.LST 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521
  1. Listing:
  2. 1 IMPLEMENTATION MODULE GenEdt;
  3. 2 (*
  4. 3 * ModBase
  5. 4 * Release 3.0
  6. 5 * (c) Copyright 1986 - 1991 PMI
  7. 6 Copyright 1988 - 1991 John McMonagle
  8. 7 * P.O. Box 8402
  9. 8 * Green Bay Wi 53308
  10. 9 * All Rights Reserved
  11. 10 * by Ed Ross
  12. 11 *)
  13. 12
  14. 13
  15. 14 FROM DataTypes IMPORT DataElmtRec,IndexElmtRec;
  16. 15 FROM HandleIO IMPORT CreateFile,CloseHandle;
  17. 16 FROM StringIO IMPORT ErrorMessage,WriteStr,WriteEol,outp;
  18. 17 FROM StrConv IMPORT CardinalToStr,StrToCardinal;
  19. 18 FROM StrEdit IMPORT Append,CrunchBlanks,SetLength,CAPstr,LowerStr;
  20. 19 FROM PosUtils IMPORT Pos, Equal, Present;
  21. 20 FROM GenLists IMPORT GenList,GetElmtAdr,ListLength;
  22. 21 FROM Str IMPORT Copy;
  23. 22 (* generate code for database acess (modbase stuff ) *)
  24. 23
  25. 24 VAR
  26. 25 FH : CARDINAL; (* file handle for def file *)
  27. 26 Str : ARRAY[0..80] OF CHAR;
  28. ***** ^ duplicate identifier
  29. ***** ^ not supported yet
  30. ***** ^ not supported yet
  31. 27 Len : CARDINAL;
  32. 28 LnCnt : CARDINAL;
  33. 29 B : BOOLEAN;
  34. 30
  35. 31 PROCEDURE GenEdtFile(FileName : ARRAY OF CHAR; FldList,IdxList : GenList);
  36. ***** ^ not supported yet
  37. 32 VAR
  38. 33 FN : ARRAY[0..18] OF CHAR;
  39. ***** ^ not supported yet
  40. ***** ^ not supported yet
  41. 34 IdxFld : ARRAY[0..7] OF CHAR;
  42. ***** ^ not supported yet
  43. ***** ^ not supported yet
  44. 35 FH : CARDINAL;
  45. 36 Cnt : CARDINAL;
  46. 37 Size,Code : CARDINAL;
  47. 38 FldPnt : POINTER TO DataElmtRec;
  48. ***** ^ not supported yet
  49. 39 IdxPnt : POINTER TO IndexElmtRec;
  50. ***** ^ not supported yet
  51. 40 EM : ErrorMessage;
  52. 41
  53. 42 BEGIN
  54. 43 Copy(FN , FileName);
  55. ***** ^ not supported yet
  56. ***** ^ not supported yet
  57. ***** ^ not supported yet
  58. 44 Append(FN,'.Edt'); (* make edt file file name *)
  59. ***** ^ not supported yet
  60. ***** ^ not supported yet
  61. ***** ^ not supported yet
  62. 45 (* FH := outp; *)
  63. 46
  64. 47 EM := CreateFile(FH,FN);
  65. ***** ^ not supported yet
  66. ***** ^ not supported yet
  67. ***** ^ not supported yet
  68. 48 WriteEol(FH,'');
  69. ***** ^ not supported yet
  70. ***** ^ not supported yet
  71. 49 (* gen the screen name *)
  72. 50
  73. 51
  74. 52 WriteEol(FH,'===================================================');
  75. ***** ^ not supported yet
  76. ***** ^ not supported yet
  77. 53 WriteEol(FH,':TopMenu');
  78. ***** ^ not supported yet
  79. ***** ^ not supported yet
  80. 54 WriteEol(FH,' FrameBelow : FileMenu');
  81. ***** ^ not supported yet
  82. ***** ^ not supported yet
  83. 55 WriteEol(FH,'Fields :{ ');
  84. ***** ^ not supported yet
  85. ***** ^ not supported yet
  86. 56 WriteEol(FH,"(F) '' GoTo FileMenu");
  87. ***** ^ not supported yet
  88. ***** ^ not supported yet
  89. 57 WriteEol(FH,"(E) '' GoTo EditMenu");
  90. ***** ^ not supported yet
  91. ***** ^ not supported yet
  92. 58 WriteEol(FH,"(X) '' GoTo Exit");
  93. ***** ^ not supported yet
  94. ***** ^ not supported yet
  95. 59 WriteEol(FH,"(H) '' GoTo Help");
  96. ***** ^ not supported yet
  97. ***** ^ not supported yet
  98. 60 WriteEol(FH,'}');
  99. ***** ^ not supported yet
  100. ***** ^ not supported yet
  101. 61 WriteEol(FH,'Window :{ ');
  102. ***** ^ not supported yet
  103. ***** ^ not supported yet
  104. 62 WriteEol(FH,'Position:( 1,1,80,3)');
  105. ***** ^ not supported yet
  106. ***** ^ not supported yet
  107. 63 WriteEol(FH,'}');
  108. ***** ^ not supported yet
  109. ***** ^ not supported yet
  110. 64 WriteEol(FH,'--------------------------------------------------');
  111. ***** ^ not supported yet
  112. ***** ^ not supported yet
  113. 65 WriteEol(FH,'');
  114. ***** ^ not supported yet
  115. ***** ^ not supported yet
  116. 66 WriteEol(FH,' #File # #Edit # #eXit # #Help#');
  117. ***** ^ not supported yet
  118. ***** ^ not supported yet
  119. 67 WriteEol(FH,'');
  120. ***** ^ not supported yet
  121. ***** ^ not supported yet
  122. 68
  123. 69 (* Generate the file pulldown menu *)
  124. 70
  125. 71
  126. 72 WriteEol(FH,'===================================================');
  127. ***** ^ not supported yet
  128. ***** ^ not supported yet
  129. 73 WriteEol(FH,':FileMenu');
  130. ***** ^ not supported yet
  131. ***** ^ not supported yet
  132. 74 WriteEol(FH,' ParentFrame : TopMenu');
  133. ***** ^ not supported yet
  134. ***** ^ not supported yet
  135. 75 WriteEol(FH,' FrameLeft : EditMenu');
  136. ***** ^ not supported yet
  137. ***** ^ not supported yet
  138. 76 WriteEol(FH,' FrameRight : EditMenu');
  139. ***** ^ not supported yet
  140. ***** ^ not supported yet
  141. 77 WriteEol(FH,'Fields :{ ');
  142. ***** ^ not supported yet
  143. ***** ^ not supported yet
  144. 78
  145. 79 (* *)
  146. 80 (* Add a menu item for each indexed file *)
  147. 81 (* *)
  148. 82 LnCnt := 4;
  149. 83 FOR Cnt := 1 TO ListLength(IdxList) DO (* create index for each indexed item*)
  150. ***** ^ not supported yet
  151. ***** ^ not supported yet
  152. 84 GetElmtAdr(IdxList,Cnt,IdxPnt,Size,Code); (* get each field *)
  153. ***** ^ not supported yet
  154. ***** ^ not supported yet
  155. ***** ^ not supported yet
  156. ***** ^ not supported yet
  157. 85 INC(LnCnt);
  158. ***** ^ undeclared identifier
  159. ***** ^ not supported yet
  160. 86 CrunchBlanks(IdxPnt^.EdtName);
  161. ***** ^ not supported yet
  162. ***** ^ not supported yet
  163. ***** ^ not supported yet
  164. 87 WriteStr(FH,' (');
  165. ***** ^ not supported yet
  166. ***** ^ not supported yet
  167. 88 WriteStr(FH,IdxPnt^.HighLight);
  168. ***** ^ not supported yet
  169. ***** ^ not supported yet
  170. ***** ^ not supported yet
  171. 89 WriteStr(FH,") '' GoTo ");
  172. ***** ^ not supported yet
  173. ***** ^ not supported yet
  174. 90 WriteEol(FH,IdxPnt^.FldName);
  175. ***** ^ not supported yet
  176. ***** ^ not supported yet
  177. ***** ^ not supported yet
  178. 91 END;
  179. 92 (* put in the standard menu items *)
  180. 93 WriteEol(FH," (N) '' GoTo Next");
  181. ***** ^ not supported yet
  182. ***** ^ not supported yet
  183. 94 WriteEol(FH," (P) '' GoTo Prev");
  184. ***** ^ not supported yet
  185. ***** ^ not supported yet
  186. 95 WriteEol(FH," (F) '' GoTo First");
  187. ***** ^ not supported yet
  188. ***** ^ not supported yet
  189. 96 WriteEol(FH," (L) '' GoTo Last");
  190. ***** ^ not supported yet
  191. ***** ^ not supported yet
  192. 97 WriteEol(FH," (A) '' GoTo Add");
  193. ***** ^ not supported yet
  194. ***** ^ not supported yet
  195. 98 WriteEol(FH,' } ');
  196. ***** ^ not supported yet
  197. ***** ^ not supported yet
  198. 99 (* *)
  199. 100 (* Put the window statment in *)
  200. 101 (* *)
  201. 102 WriteEol(FH,'Window:{');
  202. ***** ^ not supported yet
  203. ***** ^ not supported yet
  204. 103 CardinalToStr(LnCnt+6,2,Str); (* this is how long the window should be*)
  205. ***** ^ not supported yet
  206. ***** ^ not supported yet
  207. 104 WriteStr(FH ,' Position:( 2,3,25,');
  208. ***** ^ not supported yet
  209. ***** ^ not supported yet
  210. 105 WriteStr(FH,Str);
  211. ***** ^ not supported yet
  212. ***** ^ not supported yet
  213. 106 WriteEol(FH, ')');
  214. ***** ^ not supported yet
  215. ***** ^ not supported yet
  216. 107 WriteEol(FH,'}');
  217. ***** ^ not supported yet
  218. ***** ^ not supported yet
  219. 108 WriteEol(FH,'');
  220. ***** ^ not supported yet
  221. ***** ^ not supported yet
  222. 109 WriteEol(FH,'');
  223. ***** ^ not supported yet
  224. ***** ^ not supported yet
  225. 110 WriteEol(FH,'----------------------------------------------------');
  226. ***** ^ not supported yet
  227. ***** ^ not supported yet
  228. 111 WriteEol(FH,'');
  229. ***** ^ not supported yet
  230. ***** ^ not supported yet
  231. 112 FOR Cnt := 1 TO ListLength(IdxList) DO (* create index for each indexed item*)
  232. ***** ^ not supported yet
  233. ***** ^ not supported yet
  234. 113 GetElmtAdr(IdxList,Cnt,IdxPnt,Size,Code); (* get each field *)
  235. ***** ^ not supported yet
  236. ***** ^ not supported yet
  237. ***** ^ not supported yet
  238. ***** ^ not supported yet
  239. 114 WriteStr(FH,' # search by ');
  240. ***** ^ not supported yet
  241. ***** ^ not supported yet
  242. 115 WriteStr(FH,IdxPnt^.EdtName);
  243. ***** ^ not supported yet
  244. ***** ^ not supported yet
  245. ***** ^ not supported yet
  246. 116 WriteEol(FH,' #');
  247. ***** ^ not supported yet
  248. ***** ^ not supported yet
  249. 117 END;
  250. 118 (* add standard menu items *)
  251. 119 WriteEol(FH,' # Next # ');
  252. ***** ^ not supported yet
  253. ***** ^ not supported yet
  254. 120 WriteEol(FH,' # Prev # ');
  255. ***** ^ not supported yet
  256. ***** ^ not supported yet
  257. 121 WriteEol(FH,' # First # ');
  258. ***** ^ not supported yet
  259. ***** ^ not supported yet
  260. 122 WriteEol(FH,' # Last # ');
  261. ***** ^ not supported yet
  262. ***** ^ not supported yet
  263. 123 WriteEol(FH,' # Add # ');
  264. ***** ^ not supported yet
  265. ***** ^ not supported yet
  266. 124
  267. 125 WriteEol(FH,'');
  268. ***** ^ not supported yet
  269. ***** ^ not supported yet
  270. 126 WriteEol(FH,'');
  271. ***** ^ not supported yet
  272. ***** ^ not supported yet
  273. 127
  274. 128 (* *)
  275. 129 (* Generate the edit screen with *)
  276. 130 (* update and delete menu items *)
  277. 131 (* *)
  278. 132 WriteEol(FH,'');
  279. ***** ^ not supported yet
  280. ***** ^ not supported yet
  281. 133
  282. 134 WriteEol(FH,'====================================================');
  283. ***** ^ not supported yet
  284. ***** ^ not supported yet
  285. 135 WriteEol(FH,':EditMenu');
  286. ***** ^ not supported yet
  287. ***** ^ not supported yet
  288. 136 WriteEol(FH,' ParentFrame : TopMenu');
  289. ***** ^ not supported yet
  290. ***** ^ not supported yet
  291. 137 WriteEol(FH,' FrameLeft : FileMenu');
  292. ***** ^ not supported yet
  293. ***** ^ not supported yet
  294. 138 WriteEol(FH,' FrameRight : FileMenu');
  295. ***** ^ not supported yet
  296. ***** ^ not supported yet
  297. 139 WriteEol(FH,'Fields:{');
  298. ***** ^ not supported yet
  299. ***** ^ not supported yet
  300. 140 WriteEol(FH," (U) '' GoTo UpDate");
  301. ***** ^ not supported yet
  302. ***** ^ not supported yet
  303. 141 WriteEol(FH," (D) '' GoTo Delete");
  304. ***** ^ not supported yet
  305. ***** ^ not supported yet
  306. 142 WriteEol(FH,'}');
  307. ***** ^ not supported yet
  308. ***** ^ not supported yet
  309. 143 WriteEol(FH,'Window:{');
  310. ***** ^ not supported yet
  311. ***** ^ not supported yet
  312. 144 WriteEol(FH,' Position:(15,3,30,9)');
  313. ***** ^ not supported yet
  314. ***** ^ not supported yet
  315. 145 WriteEol(FH,' }');
  316. ***** ^ not supported yet
  317. ***** ^ not supported yet
  318. 146 WriteEol(FH,'------------------------------------------------------');
  319. ***** ^ not supported yet
  320. ***** ^ not supported yet
  321. 147 WriteEol(FH,'');
  322. ***** ^ not supported yet
  323. ***** ^ not supported yet
  324. 148 WriteEol(FH,' # Update #');
  325. ***** ^ not supported yet
  326. ***** ^ not supported yet
  327. 149 WriteEol(FH,' # Delete #');
  328. ***** ^ not supported yet
  329. ***** ^ not supported yet
  330. 150 WriteEol(FH,'');
  331. ***** ^ not supported yet
  332. ***** ^ not supported yet
  333. 151
  334. 152
  335. 153
  336. 154 (* *)
  337. 155 (* Generate a screen with all of the database*)
  338. 156 (* fields for testing *)
  339. 157
  340. 158
  341. 159
  342. 160
  343. 161 WriteEol(FH,'===================================================');
  344. ***** ^ not supported yet
  345. ***** ^ not supported yet
  346. 162 WriteStr(FH,':');
  347. ***** ^ not supported yet
  348. ***** ^ not supported yet
  349. 163 WriteEol(FH,FileName);
  350. ***** ^ not supported yet
  351. ***** ^ not supported yet
  352. 164 WriteEol(FH,'Fields :{ ');
  353. ***** ^ not supported yet
  354. ***** ^ not supported yet
  355. 165 (* *)
  356. 166 (* Add a screen field for each database field *)
  357. 167 (* *)
  358. 168 LnCnt := 4;
  359. 169 FOR Cnt := 1 TO ListLength(FldList) DO (* create index for each indexed item*)
  360. ***** ^ not supported yet
  361. ***** ^ not supported yet
  362. 170 GetElmtAdr(FldList,Cnt,FldPnt,Size,Code); (* get each field *)
  363. ***** ^ not supported yet
  364. ***** ^ not supported yet
  365. ***** ^ not supported yet
  366. ***** ^ not supported yet
  367. 171 CrunchBlanks(FldPnt^.Name);
  368. ***** ^ not supported yet
  369. ***** ^ not supported yet
  370. ***** ^ not supported yet
  371. 172 CAPstr(FldPnt^.Name);
  372. ***** ^ not supported yet
  373. ***** ^ not supported yet
  374. ***** ^ not supported yet
  375. 173 WriteStr(FH,"() '");
  376. ***** ^ not supported yet
  377. ***** ^ not supported yet
  378. 174 CAPstr(FldPnt^.Name);
  379. ***** ^ not supported yet
  380. ***** ^ not supported yet
  381. ***** ^ not supported yet
  382. 175 WriteStr(FH,FldPnt^.Name);
  383. ***** ^ not supported yet
  384. ***** ^ not supported yet
  385. ***** ^ not supported yet
  386. 176 WriteStr(FH,"'");
  387. ***** ^ not supported yet
  388. ***** ^ not supported yet
  389. 177 IF FldPnt^.Type = 'C'
  390. ***** ^ not supported yet
  391. ***** ^ not supported yet
  392. 178 THEN WriteEol(FH,' String')
  393. ***** ^ not supported yet
  394. ***** ^ not supported yet
  395. 179 ELSIF FldPnt^.Type = 'N'
  396. ***** ^ not supported yet
  397. ***** ^ not supported yet
  398. 180 THEN
  399. 181 IF FldPnt^.Len > 0
  400. ***** ^ not supported yet
  401. ***** ^ not supported yet
  402. 182 THEN
  403. 183 WriteEol(FH,' Real [0..99999]')
  404. ***** ^ not supported yet
  405. ***** ^ not supported yet
  406. 184 ELSE
  407. 185 WriteEol(FH,' INTEGER [0..9999]');
  408. ***** ^ not supported yet
  409. ***** ^ not supported yet
  410. 186 END;
  411. 187 ELSIF FldPnt^.Type = 'M' (* memo *)
  412. ***** ^ not supported yet
  413. ***** ^ not supported yet
  414. 188 THEN WriteEol(FH, 'Editor; 2 lines');
  415. ***** ^ not supported yet
  416. ***** ^ not supported yet
  417. 189 ELSIF FldPnt^.Type = 'D' (* date type *)
  418. ***** ^ not supported yet
  419. ***** ^ not supported yet
  420. 190 THEN WriteEol(FH, ' Date');
  421. ***** ^ not supported yet
  422. ***** ^ not supported yet
  423. 191 ELSE (* don't know what to do with choice fields Type 'L'*)
  424. 192 WriteEol(FH,' String');
  425. ***** ^ not supported yet
  426. ***** ^ not supported yet
  427. 193 END; (* end of if elsif *)
  428. 194 END; (* end of for each field *)
  429. 195 WriteEol(FH,'}'); (* end of field section *)
  430. ***** ^ not supported yet
  431. ***** ^ not supported yet
  432. 196
  433. 197
  434. 198 WriteEol(FH,'');
  435. ***** ^ not supported yet
  436. ***** ^ not supported yet
  437. 199 WriteEol(FH,'');
  438. ***** ^ not supported yet
  439. ***** ^ not supported yet
  440. 200 WriteEol(FH,'Window :{');
  441. ***** ^ not supported yet
  442. ***** ^ not supported yet
  443. 201 WriteEol(FH,'Position:(1,4,80,24)');
  444. ***** ^ not supported yet
  445. ***** ^ not supported yet
  446. 202 WriteEol(FH,'}');
  447. ***** ^ not supported yet
  448. ***** ^ not supported yet
  449. 203
  450. 204 WriteEol(FH,'-----------------------------------------------------');
  451. ***** ^ not supported yet
  452. ***** ^ not supported yet
  453. 205
  454. 206
  455. 207 (* now paint the screen with each field *)
  456. 208
  457. 209
  458. 210
  459. 211 WriteEol(FH,'');
  460. ***** ^ not supported yet
  461. ***** ^ not supported yet
  462. 212 FOR Cnt := 1 TO ListLength(FldList) DO (* create index for each indexed item*)
  463. ***** ^ not supported yet
  464. ***** ^ not supported yet
  465. 213 GetElmtAdr(FldList,Cnt,FldPnt,Size,Code); (* get each field *)
  466. ***** ^ not supported yet
  467. ***** ^ not supported yet
  468. ***** ^ not supported yet
  469. ***** ^ not supported yet
  470. 214 IF FldPnt^.Type = 'D'
  471. ***** ^ not supported yet
  472. ***** ^ not supported yet
  473. 215 THEN FldPnt^.Len := 8;
  474. ***** ^ not supported yet
  475. ***** ^ not supported yet
  476. 216 END;
  477. 217 WriteStr(FH,' ');
  478. ***** ^ not supported yet
  479. ***** ^ not supported yet
  480. 218 WriteStr(FH, FldPnt^.Name);
  481. ***** ^ not supported yet
  482. ***** ^ not supported yet
  483. ***** ^ not supported yet
  484. 219 Str :=
  485. ***** ^ not supported yet
  486. 220 ' # ';
  487. ***** ^ not supported yet
  488. 221 SetLength(Str,FldPnt^.Len+4);
  489. ***** ^ not supported yet
  490. ***** ^ not supported yet
  491. ***** ^ not supported yet
  492. ***** ^ not supported yet
  493. ***** ^ not supported yet
  494. 222 WriteStr(FH,Str);
  495. ***** ^ not supported yet
  496. ***** ^ not supported yet
  497. 223 WriteEol(FH,'#');
  498. ***** ^ not supported yet
  499. ***** ^ not supported yet
  500. 224 END;
  501. 225
  502. 226
  503. 227
  504. 228 EM := CloseHandle(FH);
  505. ***** ^ not supported yet
  506. ***** ^ not supported yet
  507. ***** ^ not supported yet
  508. 229
  509. 230 END GenEdtFile;
  510. ***** ^ not supported yet
  511. 231
  512. 232
  513. 233
  514. 234
  515. 235 END GenEdt.
  516. ***** ^ not supported yet
  517. 280 errors