Topspeed_JPI/TS-V3/MODBASE/GEN.LST

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<<or >>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