Listing: 1 IMPLEMENTATION MODULE Gen; 2 (* 3 * ModBase 4 * Release 3.0 5 * (c) Copyright 1986 - 1991 PMI 6 Copyright 1988 - 1991 John McMonagle 7 * P.O. Box 8402 8 * Green Bay Wi 53308 9 * All Rights Reserved 10 * by Ed Ross 11 *) 12 13 FROM GenLists IMPORT GenList,CopyList,DisposeList,ElmtNow,GetElmt, 14 GetElmtAdr,ListDelete,ListInsert,ListLength,NewList,StrCode, 15 ListReplace; 16 FROM ListUtils IMPORT TextFileToList; 17 FROM StrEdit IMPORT Append,SetLength,DeleteChar,DeleteRightJustified; 18 FROM StrConv IMPORT CardinalToStr; 19 FROM M2Strings IMPORT Length,Delete,Delete; ***** ^ duplicate identifier 20 FROM Str IMPORT Copy,Slice; 21 FROM PosUtils IMPORT Pos; 22 FROM StringIO IMPORT ErrorMessage,WriteStr,WriteEol; 23 FROM HandleIO IMPORT CreateFile; 24 FROM Prompts IMPORT Prompt; 25 FROM PosUtils IMPORT Present,Equal; ***** ^ duplicate identifier 26 FROM StrEdit IMPORT CAPstr,CrunchBlanks,ReplaceStr; ***** ^ duplicate identifier 27 FROM DataTypes IMPORT IndexElmtRec,IdxList,FldList,TableName, 28 DBFName,DataElmtRec,TableName; ***** ^ duplicate identifier 29 30 CONST 31 TableNm ='@TABLENAME@'; (* name of table without appendages *) ***** ^ not supported yet 32 33 IdxFldNm='@IDX@'; (* indexed fld name *) ***** ^ not supported yet 34 IdxName ='@IDXNAME@'; (* name of index (fld name with trunc to 8)*) ***** ^ not supported yet 35 FldName ='@FLDNAME@'; (* field name (indexed and non indexed *) ***** ^ not supported yet 36 IdxNbr ='@IDXNBR@'; (* index number *) ***** ^ not supported yet 37 IdxChar = '@IDXCHAR@'; (* accel key /Highlight key for menu *) ***** ^ not supported yet 38 39 40 ForEachFld = '>>FOR EACH FLD<<'; (* for each field start loop *) ***** ^ not supported yet 41 EndEachFld = '>>END FLD<<'; ***** ^ not supported yet 42 43 ForEachIdx = '>>FOR EACH IDX<<'; (* for every index in table*) ***** ^ not supported yet 44 EndEachIdx = '>>END IDX<<'; ***** ^ not supported yet 45 MakeRec = '>>MAKE RECORD<<'; (* create a record from data *) ***** ^ not supported yet 46 MakeDBF = '>>MAKE DATABASE<<'; ***** ^ not supported yet 47 MoveTo = '>>MOVE TO DB<<'; (* move data from record to db rec *) ***** ^ not supported yet 48 MoveFrom = '>>MOVE FROM DB<<'; ***** ^ not supported yet 49 OutFileName= '>>FILE NAME ='; ***** ^ not supported yet 50 IfIdx = '>>IF INDEX ='; (* either Real, Character, or *) ***** ^ not supported yet 51 (* or Numeric (cardinal ) *) 52 EndIfIdx = '>>END IF<<'; (* end of conditional*) ***** ^ not supported yet 53 Include = '>>INCLUDE FILE ='; (* include a file by name of *) ***** ^ not supported yet 54 VAR 55 56 FileList : GenList; 57 Handle : CARDINAL; 58 SubList : GenList; 59 Condition : BOOLEAN; (* if processing in a conditional statement *) 60 ChangingState : BOOLEAN; 61 ProcessIdxType : CHAR; 62 63 PROCEDURE WriteCard(H: CARDINAL; Card : CARDINAL); 64 VAR 65 Str : ARRAY[0..10] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 66 BEGIN 67 CardinalToStr(Card,3,Str); ***** ^ not supported yet ***** ^ not supported yet 68 WriteStr(H,Str); ***** ^ not supported yet ***** ^ not supported yet 69 70 END WriteCard; ***** ^ not supported yet 71 72 73 PROCEDURE MakeModRec(ItemList : GenList); 74 VAR Str : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 75 J : CARDINAL; 76 Code,Size: CARDINAL; 77 Item : POINTER TO DataElmtRec; ***** ^ not supported yet 78 BEGIN 79 WriteStr(Handle,TableName); ***** ^ not supported yet ***** ^ not supported yet 80 WriteEol(Handle,'Rec = RECORD'); ***** ^ not supported yet ***** ^ not supported yet 81 FOR J := 1 TO ListLength(ItemList) DO ***** ^ not supported yet ***** ^ not supported yet 82 GetElmtAdr(ItemList,J,Item,Code,Size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 83 WriteStr(Handle,' '); ***** ^ not supported yet ***** ^ not supported yet 84 WriteStr(Handle,Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 85 WriteStr(Handle,' : '); ***** ^ not supported yet ***** ^ not supported yet 86 WriteStr(Handle,Item^.RecType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 87 WriteStr(Handle,';'); (* write the comments *) ***** ^ not supported yet ***** ^ not supported yet 88 WriteStr(Handle,' (* '); ***** ^ not supported yet ***** ^ not supported yet 89 WriteStr(Handle,Item^.Desc); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 90 WriteEol(Handle,' *)'); ***** ^ not supported yet ***** ^ not supported yet 91 END; 92 WriteEol(Handle,'END;'); ***** ^ not supported yet ***** ^ not supported yet 93 94 END MakeModRec; ***** ^ not supported yet 95 96 PROCEDURE MakeMoveTo(ItemList : GenList); (* create move to record *) 97 (* generate the code to move data from a record to the database *) 98 VAR J : CARDINAL; 99 Item : POINTER TO DataElmtRec; ***** ^ not supported yet 100 Size,Code : CARDINAL; 101 102 BEGIN 103 WriteStr(Handle,'PROCEDURE Move'); ***** ^ not supported yet ***** ^ not supported yet 104 WriteStr(Handle,TableName); ***** ^ not supported yet ***** ^ not supported yet 105 WriteStr(Handle,'ToDBF(Rec : '); ***** ^ not supported yet ***** ^ not supported yet 106 WriteStr(Handle,TableName); ***** ^ not supported yet ***** ^ not supported yet 107 WriteEol(Handle,'Rec ); '); ***** ^ not supported yet ***** ^ not supported yet 108 WriteEol(Handle,'(* This code will move the data from the record to *)'); ***** ^ not supported yet ***** ^ not supported yet 109 WriteEol(Handle,'(* the data base *)'); ***** ^ not supported yet ***** ^ not supported yet 110 WriteEol(Handle,'BEGIN'); ***** ^ not supported yet ***** ^ not supported yet 111 WriteEol(Handle,' WITH Rec DO'); ***** ^ not supported yet ***** ^ not supported yet 112 FOR J := 1 TO ListLength(ItemList) DO ***** ^ not supported yet ***** ^ not supported yet 113 GetElmtAdr(ItemList,J,Item,Code,Size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 114 CASE Item^.Type OF ***** ^ not supported yet ***** ^ not supported yet 115 'C' : WriteStr(Handle,' Replace( '); ***** ^ not supported yet ***** ^ not supported yet 116 WriteStr(Handle,DBFName); ***** ^ not supported yet ***** ^ not supported yet 117 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 118 WriteCard(Handle,J); ***** ^ not supported yet ***** ^ not supported yet 119 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 120 WriteStr(Handle,Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 121 WriteStr(Handle,');'); ***** ^ not supported yet ***** ^ not supported yet 122 123 |'N' : WriteStr(Handle,' ReplaceN( '); ***** ^ not supported yet ***** ^ not supported yet 124 WriteStr(Handle,DBFName); ***** ^ not supported yet ***** ^ not supported yet 125 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 126 WriteCard(Handle,J); ***** ^ not supported yet ***** ^ not supported yet 127 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 128 IF Item^.Dec > 0 ***** ^ not supported yet ***** ^ not supported yet 129 THEN WriteStr(Handle,Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 130 ELSE WriteStr(Handle,'FLOAT('); ***** ^ not supported yet ***** ^ not supported yet 131 WriteStr(Handle,Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 132 WriteStr(Handle,')'); ***** ^ not supported yet ***** ^ not supported yet 133 END; 134 WriteStr(Handle,');'); ***** ^ not supported yet ***** ^ not supported yet 135 |'D' : WriteStr(Handle,' ReplaceD( '); ***** ^ not supported yet ***** ^ not supported yet 136 WriteStr(Handle,DBFName); ***** ^ not supported yet ***** ^ not supported yet 137 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 138 WriteCard(Handle,J); ***** ^ not supported yet ***** ^ not supported yet 139 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 140 WriteStr(Handle,Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 141 WriteStr(Handle,');'); ***** ^ not supported yet ***** ^ not supported yet 142 143 |'L' : WriteStr(Handle,' ReplaceL( '); ***** ^ not supported yet ***** ^ not supported yet 144 WriteStr(Handle,DBFName); ***** ^ not supported yet ***** ^ not supported yet 145 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 146 WriteCard(Handle,J); ***** ^ not supported yet ***** ^ not supported yet 147 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 148 WriteStr(Handle,Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 149 WriteStr(Handle,');'); ***** ^ not supported yet ***** ^ not supported yet 150 END; (* end of case of *) 151 WriteStr(Handle,' (* '); ***** ^ not supported yet ***** ^ not supported yet 152 WriteStr(Handle,Item^.Desc); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 153 WriteEol(Handle,' *)'); ***** ^ not supported yet ***** ^ not supported yet 154 END; (* end of for each field *) 155 WriteEol(Handle,'END; (* end of with REC *)'); ***** ^ not supported yet ***** ^ not supported yet 156 WriteStr(Handle,'END Move'); ***** ^ not supported yet ***** ^ not supported yet 157 WriteStr(Handle,TableName); ***** ^ not supported yet ***** ^ not supported yet 158 WriteEol(Handle,'ToDBF;'); ***** ^ not supported yet ***** ^ not supported yet 159 WriteEol(Handle,''); ***** ^ not supported yet ***** ^ not supported yet 160 WriteEol(Handle,''); ***** ^ not supported yet ***** ^ not supported yet 161 END MakeMoveTo; ***** ^ not supported yet 162 163 164 165 166 167 PROCEDURE MakeMoveFrom(ItemList : GenList); (* create move to record *) 168 (* generate the code to move data from a record to the database *) 169 VAR J : CARDINAL; 170 Item : POINTER TO DataElmtRec; ***** ^ not supported yet 171 Size,Code : CARDINAL; 172 173 BEGIN 174 WriteStr(Handle,'PROCEDURE Move'); ***** ^ not supported yet ***** ^ not supported yet 175 WriteStr(Handle,TableName); ***** ^ not supported yet ***** ^ not supported yet 176 WriteStr(Handle,'FromDBF(VAR Rec : '); ***** ^ not supported yet ***** ^ not supported yet 177 WriteStr(Handle,TableName); ***** ^ not supported yet ***** ^ not supported yet 178 WriteEol(Handle,'Rec ); '); ***** ^ not supported yet ***** ^ not supported yet 179 WriteEol(Handle,'(* This code will move the data from the Database to *)'); ***** ^ not supported yet ***** ^ not supported yet 180 WriteEol(Handle,'(* the record *)'); ***** ^ not supported yet ***** ^ not supported yet 181 WriteEol(Handle,'VAR B : BOOLEAN;'); ***** ^ not supported yet ***** ^ not supported yet 182 WriteEol(Handle,' R : Real8;'); ***** ^ not supported yet ***** ^ not supported yet 183 WriteEol(Handle,'BEGIN'); ***** ^ not supported yet ***** ^ not supported yet 184 WriteEol(Handle,' WITH Rec DO'); ***** ^ not supported yet ***** ^ not supported yet 185 FOR J := 1 TO ListLength(ItemList) DO ***** ^ not supported yet ***** ^ not supported yet 186 GetElmtAdr(ItemList,J,Item,Code,Size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 187 CASE Item^.Type OF ***** ^ not supported yet ***** ^ not supported yet 188 'C' : WriteStr(Handle,' GetField( '); ***** ^ not supported yet ***** ^ not supported yet 189 WriteStr(Handle,DBFName); ***** ^ not supported yet ***** ^ not supported yet 190 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 191 WriteCard(Handle,J); ***** ^ not supported yet ***** ^ not supported yet 192 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 193 WriteStr(Handle,Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 194 WriteStr(Handle,');'); ***** ^ not supported yet ***** ^ not supported yet 195 196 |'N' : WriteStr(Handle,' GetNumField( '); ***** ^ not supported yet ***** ^ not supported yet 197 WriteStr(Handle,DBFName); ***** ^ not supported yet ***** ^ not supported yet 198 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 199 WriteCard(Handle,J); ***** ^ not supported yet ***** ^ not supported yet 200 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 201 IF Item^.Dec > 0 ***** ^ not supported yet ***** ^ not supported yet 202 THEN WriteStr(Handle,Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 203 ELSE WriteEol(Handle,'R);'); ***** ^ not supported yet ***** ^ not supported yet 204 WriteStr(Handle,' '); ***** ^ not supported yet ***** ^ not supported yet 205 WriteStr(Handle,Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 206 WriteStr(Handle,':= TRUNC(R'); ***** ^ not supported yet ***** ^ not supported yet 207 END; 208 WriteStr(Handle,');'); ***** ^ not supported yet ***** ^ not supported yet 209 |'D' : WriteStr(Handle,' GetDateField( '); ***** ^ not supported yet ***** ^ not supported yet 210 WriteStr(Handle,DBFName); ***** ^ not supported yet ***** ^ not supported yet 211 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 212 WriteCard(Handle,J); ***** ^ not supported yet ***** ^ not supported yet 213 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 214 WriteStr(Handle,Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 215 WriteStr(Handle,');'); ***** ^ not supported yet ***** ^ not supported yet 216 217 |'L' : WriteStr(Handle,' GetLogicalField( '); ***** ^ not supported yet ***** ^ not supported yet 218 WriteStr(Handle,DBFName); ***** ^ not supported yet ***** ^ not supported yet 219 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 220 WriteCard(Handle,J); ***** ^ not supported yet ***** ^ not supported yet 221 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 222 WriteStr(Handle,Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 223 WriteStr(Handle,');'); ***** ^ not supported yet ***** ^ not supported yet 224 END; (* end of case of *) 225 WriteStr(Handle,' (* '); ***** ^ not supported yet ***** ^ not supported yet 226 WriteStr(Handle,Item^.Desc); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 227 WriteEol(Handle,' *)'); ***** ^ not supported yet ***** ^ not supported yet 228 END; (* end of for each field *) 229 WriteEol(Handle,'END; (* end of with REC^ *)'); ***** ^ not supported yet ***** ^ not supported yet 230 WriteStr(Handle,'END Move'); ***** ^ not supported yet ***** ^ not supported yet 231 WriteStr(Handle,TableName); ***** ^ not supported yet ***** ^ not supported yet 232 WriteEol(Handle,'FromDBF;'); ***** ^ not supported yet ***** ^ not supported yet 233 WriteEol(Handle,''); ***** ^ not supported yet ***** ^ not supported yet 234 WriteEol(Handle,''); ***** ^ not supported yet ***** ^ not supported yet 235 236 END MakeMoveFrom; ***** ^ not supported yet 237 238 PROCEDURE MakeDatabase( ItemList : GenList); 239 (* produce the code to build the data base *) 240 VAR 241 Str : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 242 TmpStr : ARRAY[0..15] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 243 Code, Size : CARDINAL; 244 Item : POINTER TO DataElmtRec; ***** ^ not supported yet 245 J : CARDINAL; 246 BEGIN 247 WriteEol(Handle,'PROCEDURE MakeDatabase();'); ***** ^ not supported yet ***** ^ not supported yet 248 WriteEol(Handle,'VAR '); ***** ^ not supported yet ***** ^ not supported yet 249 WriteEol(Handle,' Error : CARDINAL;'); ***** ^ not supported yet ***** ^ not supported yet 250 WriteEol(Handle,' Desc : POINTER TO ARRAY [1..200] OF DBFieldDescriptor;'); ***** ^ not supported yet ***** ^ not supported yet 251 WriteEol(Handle,'BEGIN'); ***** ^ not supported yet ***** ^ not supported yet 252 CardinalToStr(ListLength(ItemList),3,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 253 WriteStr(Handle,' ALLOCATE(Desc,'); ***** ^ not supported yet ***** ^ not supported yet 254 WriteStr(Handle,Str); ***** ^ not supported yet ***** ^ not supported yet 255 WriteEol(Handle,' * SIZE(DBFieldDescriptor));'); ***** ^ not supported yet ***** ^ not supported yet 256 WriteStr(Handle,' Fill(Desc, '); ***** ^ not supported yet ***** ^ not supported yet 257 WriteStr(Handle, Str); ***** ^ not supported yet ***** ^ not supported yet 258 WriteEol(Handle,' * SIZE(DBFieldDescriptor),0);'); ***** ^ not supported yet ***** ^ not supported yet 259 FOR J := 1 TO ListLength(ItemList) DO ***** ^ not supported yet ***** ^ not supported yet 260 GetElmtAdr(ItemList,J,Item,Code,Size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 261 WriteStr(Handle,' MakeDescriptor('); ***** ^ not supported yet ***** ^ not supported yet 262 CardinalToStr(J,3,Str); ***** ^ not supported yet ***** ^ not supported yet 263 264 TmpStr := ' Desc^['; ***** ^ not supported yet ***** ^ not supported yet 265 Append(TmpStr,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 266 Append(TmpStr,"], '"); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 267 WriteStr(Handle,TmpStr); ***** ^ not supported yet ***** ^ not supported yet 268 WriteStr(Handle,Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 269 WriteStr(Handle,"'," ); ***** ^ not supported yet ***** ^ not supported yet 270 271 WriteCard(Handle,Item^.Len); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 272 WriteStr(Handle,"," ); ***** ^ not supported yet ***** ^ not supported yet 273 274 WriteCard(Handle,Item^.Dec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 275 WriteStr(Handle,", '" ); ***** ^ not supported yet ***** ^ not supported yet 276 277 WriteStr(Handle,Item^.Type); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 278 WriteEol(Handle,"');"); ***** ^ not supported yet ***** ^ not supported yet 279 END; 280 WriteStr(Handle," InitDBF('"); ***** ^ not supported yet ***** ^ not supported yet 281 WriteStr(Handle,TableName); ***** ^ not supported yet ***** ^ not supported yet 282 WriteStr(Handle,".DBF',"); ***** ^ not supported yet ***** ^ not supported yet 283 WriteStr(Handle,TableName); ***** ^ not supported yet ***** ^ not supported yet 284 WriteEol(Handle,"DBF,0,FALSE,TRUE,FALSE,DefaultFixUp);"); ***** ^ not supported yet ***** ^ not supported yet 285 WriteEol(Handle," (* It would be a good to test error.*)"); ***** ^ not supported yet ***** ^ not supported yet 286 WriteStr(Handle," Error:=BuildDBF("); ***** ^ not supported yet ***** ^ not supported yet 287 WriteStr(Handle,"Desc^,"); ***** ^ not supported yet ***** ^ not supported yet 288 WriteStr(Handle,Str); ***** ^ not supported yet ***** ^ not supported yet 289 WriteStr(Handle,','); ***** ^ not supported yet ***** ^ not supported yet 290 WriteStr(Handle,TableName); ***** ^ not supported yet ***** ^ not supported yet 291 WriteEol(Handle,'DBF);'); ***** ^ not supported yet ***** ^ not supported yet 292 WriteStr(Handle,' CloseDBF('); ***** ^ not supported yet ***** ^ not supported yet 293 WriteStr(Handle,TableName); ***** ^ not supported yet ***** ^ not supported yet 294 WriteEol(Handle,'DBF);'); ***** ^ not supported yet ***** ^ not supported yet 295 WriteStr(Handle,' DEALLOCATE(Desc,'); ***** ^ not supported yet ***** ^ not supported yet 296 WriteStr(Handle,Str); ***** ^ not supported yet ***** ^ not supported yet 297 WriteEol(Handle,' * SIZE(DBFieldDescriptor));'); ***** ^ not supported yet ***** ^ not supported yet 298 WriteEol(Handle,'END MakeDatabase;'); ***** ^ not supported yet ***** ^ not supported yet 299 END MakeDatabase; ***** ^ not supported yet 300 301 302 PROCEDURE ReplaceName(SrchStr, ReplStr : ARRAY OF CHAR; VAR TheList : GenList); ***** ^ not supported yet 303 (* loop through the file and replace the strings *) 304 VAR 305 J : CARDINAL; 306 Str : ARRAY[0..300] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 307 Size,Code : CARDINAL; 308 BEGIN 309 FOR J := 1 TO ListLength(TheList) DO ***** ^ not supported yet ***** ^ not supported yet 310 GetElmt(TheList,J,Str,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 311 ReplaceStr(SrchStr,ReplStr,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 312 ListReplace(Str,StrCode,TheList,J); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 313 END; 314 END ReplaceName; ***** ^ not supported yet 315 316 PROCEDURE OKCondition(VAR Str:ARRAY OF CHAR ) : BOOLEAN; ***** ^ not supported yet 317 318 (* this routine will return true if the line should be included 319 otherwise it will return false - don't include the line 320 no -duh *) 321 VAR 322 IndexType : CHAR; 323 BEGIN 324 325 IF NOT (Present(IfIdx,Str) OR Present(EndIfIdx,Str)) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 326 (* check if this is a conditional stm*) 327 THEN RETURN Condition (* Nope - return current state *) 328 ELSIF Present(EndIfIdx,Str) (* check for end of condition *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 329 THEN 330 Copy(Str , ''); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 331 Condition := TRUE; 332 RETURN TRUE; 333 END; (* if we fell through this must be the 334 begining of a conditional statement*) 335 (* the value must be R - Real *) 336 (* N - Numeric Cardinal*) 337 (* C - Character *) 338 339 DeleteRightJustified ( Str, 0, Pos('=',Str)+1); (* get rid of the prefix *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 340 DeleteChar(' ',Str); (* whats left should be index type*) ***** ^ not supported yet ***** ^ not supported yet 341 IF Str[0] = ProcessIdxType ***** ^ not supported yet ***** ^ not supported yet 342 THEN Condition := TRUE 343 ELSE Condition := FALSE; 344 END; 345 Copy(Str , ''); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 346 RETURN Condition; 347 348 END OKCondition; ***** ^ not supported yet 349 350 351 352 PROCEDURE ProcessRepeat(VAR TheList : GenList; VAR Spot : CARDINAL; 353 StartMark,EndMark: ARRAY OF CHAR); FORWARD; ***** ^ not supported yet 354 355 PROCEDURE WriteList(VAR TheList : GenList); 356 (* Write the list to the file *) 357 (* Write until a ">>for each idx<>for each fld<<" is encountered*) 358 (* Extract the items that are for idx or flds; create a sublist and *) 359 (* call writelist (recursivly) *) 360 361 VAR 362 J : CARDINAL; 363 S : ARRAY[0..200] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 364 Code,Size : CARDINAL; 365 BEGIN 366 J := 1; 367 LOOP 368 IF J > ListLength(TheList) THEN ***** ^ not supported yet ***** ^ not supported yet 369 EXIT; (* I alter the J variable in a subroutine *) 370 END; (* so use a loop construct rather than for *) 371 GetElmt(TheList,J,S,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 372 IF OKCondition(S) (* not in a conditional gen area*) ***** ^ not supported yet ***** ^ not supported yet 373 THEN 374 IF Present(ForEachIdx,S) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 375 THEN ProcessRepeat(TheList,J,ForEachIdx,EndEachIdx) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 376 ELSIF Present(ForEachFld,S) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 377 THEN ProcessRepeat(TheList,J,ForEachIdx,EndEachIdx); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 378 ELSIF Present(MakeRec,S) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 379 THEN MakeModRec(FldList); ***** ^ not supported yet ***** ^ not supported yet 380 INC(J); ***** ^ undeclared identifier ***** ^ not supported yet 381 ELSIF Present(MoveTo,S) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 382 THEN MakeMoveTo(FldList); ***** ^ not supported yet ***** ^ not supported yet 383 INC(J); ***** ^ undeclared identifier ***** ^ not supported yet 384 ELSIF Present(MoveFrom,S) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 385 THEN MakeMoveFrom(FldList); ***** ^ not supported yet ***** ^ not supported yet 386 INC(J); ***** ^ undeclared identifier ***** ^ not supported yet 387 ELSIF Present(MakeDBF,S) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 388 THEN MakeDatabase(FldList); ***** ^ not supported yet ***** ^ not supported yet 389 INC(J); ***** ^ undeclared identifier ***** ^ not supported yet 390 391 ELSE 392 WriteEol(Handle,S); ***** ^ not supported yet ***** ^ not supported yet 393 INC(J); ***** ^ undeclared identifier ***** ^ not supported yet 394 END; 395 ELSE INC(J); (* else if in condition *) ***** ^ undeclared identifier ***** ^ not supported yet 396 END; (* end of if in condition *) 397 END; (* end of LOOP *) 398 END WriteList; ***** ^ not supported yet 399 400 PROCEDURE ProcessRepeat(VAR TheList : GenList; VAR Spot : CARDINAL; 401 StartMark,EndMark: ARRAY OF CHAR); ***** ^ not supported yet 402 (* write out the line containing the for each field *) 403 (* Make a sublist for the for each fld *) 404 (* make a copy of the sublist *) 405 (* for each fld replace the idx stuff *) 406 (* writelist(the sublist) *) 407 408 VAR 409 S: ARRAY [0..200] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 410 Size,Code : CARDINAL; 411 TmpStr : ARRAY[0..200] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 412 SubList, TmpList : GenList; 413 J : CARDINAL; 414 IdxRec : POINTER TO IndexElmtRec; ***** ^ not supported yet 415 416 BEGIN 417 GetElmt(TheList,Spot,S,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 418 Copy(TmpStr , S); (* for the first line *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 419 J := Pos(StartMark,TmpStr)+Length(StartMark); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 420 SetLength(TmpStr,Pos(StartMark,TmpStr)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 421 WriteStr(Handle,TmpStr); (* write out the remainder of the currentline*) ***** ^ not supported yet ***** ^ not supported yet 422 Delete(S,0,J); (* dump the front of str + the start mark *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 423 NewList(SubList); ***** ^ not supported yet ***** ^ not supported yet 424 LOOP (* create a sublist for the repeat field *) 425 INC(Spot); ***** ^ undeclared identifier ***** ^ not supported yet 426 IF Present(EndMark,S) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 427 THEN EXIT; (* last line processing *) 428 END; 429 ListInsert(S,StrCode,SubList,1000); (* insert a replace line *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 430 431 IF Spot > ListLength(TheList) ***** ^ not supported yet ***** ^ not supported yet 432 THEN EXIT; 433 END; 434 GetElmt(TheList,Spot,S,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 435 END; 436 Copy(TmpStr , S); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 437 (********************************************) 438 (* last line processing *) 439 (* if I need to have embedded loops put the *) 440 (* search for start of loop here and call *) 441 (* process repeating recursive call *) 442 (********************************************) 443 444 IF Present(EndMark,TmpStr) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 445 THEN 446 SetLength(TmpStr,Pos(EndMark,TmpStr)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 447 J := Pos(EndMark,S)+Length(EndMark); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 448 Delete(S,0,J); (* dump the front of str + the start mark *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 449 END; 450 (* DEC(Spot); 451 ListReplace(S,StrCode,TheList,Spot); Replace with write at end*) 452 IF Length(TmpStr) > 0 ***** ^ not supported yet ***** ^ not supported yet 453 THEN 454 ListInsert(TmpStr,StrCode,SubList,1000); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 455 END; 456 457 458 (* now for each index or fld copy the list, replace the idx or fld 459 and write list - NOTICE THIS IS A RECURSIVE CALL to witelist *) 460 461 FOR J := 1 TO ListLength(IdxList) DO ***** ^ not supported yet ***** ^ not supported yet 462 GetElmtAdr(IdxList,J,IdxRec,Size,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 463 ProcessIdxType := IdxRec^.IndexType; (* set for conditional gen*) ***** ^ not supported yet ***** ^ not supported yet 464 NewList(TmpList); ***** ^ not supported yet ***** ^ not supported yet 465 CopyList(SubList,TmpList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 466 ReplaceName(IdxFldNm,IdxRec^.FldName,TmpList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 467 ReplaceName(FldName,IdxRec^.FldName,TmpList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 468 ReplaceName(IdxName,IdxRec^.IdxName,TmpList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 469 ReplaceName(IdxChar,IdxRec^.HighLight,TmpList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 470 WriteList(TmpList); ***** ^ not supported yet ***** ^ not supported yet 471 DisposeList(TmpList); ***** ^ not supported yet ***** ^ not supported yet 472 WriteStr(Handle,S); (* fininsh the last line *) ***** ^ not supported yet ***** ^ not supported yet 473 END; 474 DisposeList(SubList); ***** ^ not supported yet ***** ^ not supported yet 475 END ProcessRepeat; ***** ^ not supported yet 476 477 478 479 480 481 482 483 484 485 486 487 488 PROCEDURE GenFile(TemplateName : ARRAY OF CHAR); ***** ^ not supported yet 489 VAR 490 FileName : ARRAY[0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 491 TmpStr : ARRAY [0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 492 ExtPart : ARRAY[0..3] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 493 EM : ErrorMessage; 494 FileList : GenList; 495 Code : CARDINAL; 496 BEGIN 497 NewList(FileList); ***** ^ not supported yet ***** ^ not supported yet 498 Condition := TRUE; (* ititialize the conditional generation stuff*) 499 ChangingState := FALSE; 500 EM := TextFileToList(TemplateName,FileList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 501 ReplaceName(TableNm,TableName,FileList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 502 503 (* If the file name is in the template, create a new file *) 504 GetElmt(FileList,1,FileName,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 505 IF Present(OutFileName,FileName) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 506 THEN 507 TmpStr := OutFileName; ***** ^ not supported yet ***** ^ not supported yet 508 Code := Length(TmpStr); ***** ^ not supported yet ***** ^ not supported yet 509 Delete(FileName,Pos(OutFileName,FileName),Code); (* dump the front of line*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 510 DeleteChar(' ',FileName); (* get rid of any excess blanks *) ***** ^ not supported yet ***** ^ not supported yet 511 IF Pos('.',FileName)> 8 (* if name to long 8 + period *) ***** ^ not supported yet ***** ^ not supported yet 512 THEN 513 514 Slice(ExtPart,FileName,Pos('.',FileName)+1,3); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 515 SetLength(FileName,8); (* set to max length *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 516 Append(FileName,'.'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 517 Append(FileName,ExtPart); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 518 END; 519 EM := CreateFile(Handle,FileName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 520 ListDelete(FileList,1,1); (* delete file name *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 521 END; (* if file is named *) 522 WriteList(FileList); ***** ^ not supported yet ***** ^ not supported yet 523 524 END GenFile; ***** ^ not supported yet 525 526 END Gen. ***** ^ not supported yet 694 errors