| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521 |
- Listing:
- 1 IMPLEMENTATION MODULE GenEdt;
- 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
- 14 FROM DataTypes IMPORT DataElmtRec,IndexElmtRec;
- 15 FROM HandleIO IMPORT CreateFile,CloseHandle;
- 16 FROM StringIO IMPORT ErrorMessage,WriteStr,WriteEol,outp;
- 17 FROM StrConv IMPORT CardinalToStr,StrToCardinal;
- 18 FROM StrEdit IMPORT Append,CrunchBlanks,SetLength,CAPstr,LowerStr;
- 19 FROM PosUtils IMPORT Pos, Equal, Present;
- 20 FROM GenLists IMPORT GenList,GetElmtAdr,ListLength;
- 21 FROM Str IMPORT Copy;
- 22 (* generate code for database acess (modbase stuff ) *)
- 23
- 24 VAR
- 25 FH : CARDINAL; (* file handle for def file *)
- 26 Str : ARRAY[0..80] OF CHAR;
- ***** ^ duplicate identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 27 Len : CARDINAL;
- 28 LnCnt : CARDINAL;
- 29 B : BOOLEAN;
- 30
- 31 PROCEDURE GenEdtFile(FileName : ARRAY OF CHAR; FldList,IdxList : GenList);
- ***** ^ not supported yet
- 32 VAR
- 33 FN : ARRAY[0..18] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 34 IdxFld : ARRAY[0..7] OF CHAR;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 35 FH : CARDINAL;
- 36 Cnt : CARDINAL;
- 37 Size,Code : CARDINAL;
- 38 FldPnt : POINTER TO DataElmtRec;
- ***** ^ not supported yet
- 39 IdxPnt : POINTER TO IndexElmtRec;
- ***** ^ not supported yet
- 40 EM : ErrorMessage;
- 41
- 42 BEGIN
- 43 Copy(FN , FileName);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 44 Append(FN,'.Edt'); (* make edt file file name *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 45 (* FH := outp; *)
- 46
- 47 EM := CreateFile(FH,FN);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 48 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 49 (* gen the screen name *)
- 50
- 51
- 52 WriteEol(FH,'===================================================');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 53 WriteEol(FH,':TopMenu');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 54 WriteEol(FH,' FrameBelow : FileMenu');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 55 WriteEol(FH,'Fields :{ ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 56 WriteEol(FH,"(F) '' GoTo FileMenu");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 57 WriteEol(FH,"(E) '' GoTo EditMenu");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 58 WriteEol(FH,"(X) '' GoTo Exit");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 59 WriteEol(FH,"(H) '' GoTo Help");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 60 WriteEol(FH,'}');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 61 WriteEol(FH,'Window :{ ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 62 WriteEol(FH,'Position:( 1,1,80,3)');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 63 WriteEol(FH,'}');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 64 WriteEol(FH,'--------------------------------------------------');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 65 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 66 WriteEol(FH,' #File # #Edit # #eXit # #Help#');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 67 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 68
- 69 (* Generate the file pulldown menu *)
- 70
- 71
- 72 WriteEol(FH,'===================================================');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 73 WriteEol(FH,':FileMenu');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 74 WriteEol(FH,' ParentFrame : TopMenu');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 75 WriteEol(FH,' FrameLeft : EditMenu');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 76 WriteEol(FH,' FrameRight : EditMenu');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 77 WriteEol(FH,'Fields :{ ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 78
- 79 (* *)
- 80 (* Add a menu item for each indexed file *)
- 81 (* *)
- 82 LnCnt := 4;
- 83 FOR Cnt := 1 TO ListLength(IdxList) DO (* create index for each indexed item*)
- ***** ^ not supported yet
- ***** ^ not supported yet
- 84 GetElmtAdr(IdxList,Cnt,IdxPnt,Size,Code); (* get each field *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 85 INC(LnCnt);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 86 CrunchBlanks(IdxPnt^.EdtName);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 87 WriteStr(FH,' (');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 88 WriteStr(FH,IdxPnt^.HighLight);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 89 WriteStr(FH,") '' GoTo ");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 90 WriteEol(FH,IdxPnt^.FldName);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 91 END;
- 92 (* put in the standard menu items *)
- 93 WriteEol(FH," (N) '' GoTo Next");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 94 WriteEol(FH," (P) '' GoTo Prev");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 95 WriteEol(FH," (F) '' GoTo First");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 96 WriteEol(FH," (L) '' GoTo Last");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 97 WriteEol(FH," (A) '' GoTo Add");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 98 WriteEol(FH,' } ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 99 (* *)
- 100 (* Put the window statment in *)
- 101 (* *)
- 102 WriteEol(FH,'Window:{');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 103 CardinalToStr(LnCnt+6,2,Str); (* this is how long the window should be*)
- ***** ^ not supported yet
- ***** ^ not supported yet
- 104 WriteStr(FH ,' Position:( 2,3,25,');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 105 WriteStr(FH,Str);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 106 WriteEol(FH, ')');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 107 WriteEol(FH,'}');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 108 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 109 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 110 WriteEol(FH,'----------------------------------------------------');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 111 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 112 FOR Cnt := 1 TO ListLength(IdxList) DO (* create index for each indexed item*)
- ***** ^ not supported yet
- ***** ^ not supported yet
- 113 GetElmtAdr(IdxList,Cnt,IdxPnt,Size,Code); (* get each field *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 114 WriteStr(FH,' # search by ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 115 WriteStr(FH,IdxPnt^.EdtName);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 116 WriteEol(FH,' #');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 117 END;
- 118 (* add standard menu items *)
- 119 WriteEol(FH,' # Next # ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 120 WriteEol(FH,' # Prev # ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 121 WriteEol(FH,' # First # ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 122 WriteEol(FH,' # Last # ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 123 WriteEol(FH,' # Add # ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 124
- 125 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 126 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 127
- 128 (* *)
- 129 (* Generate the edit screen with *)
- 130 (* update and delete menu items *)
- 131 (* *)
- 132 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 133
- 134 WriteEol(FH,'====================================================');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 135 WriteEol(FH,':EditMenu');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 136 WriteEol(FH,' ParentFrame : TopMenu');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 137 WriteEol(FH,' FrameLeft : FileMenu');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 138 WriteEol(FH,' FrameRight : FileMenu');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 139 WriteEol(FH,'Fields:{');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 140 WriteEol(FH," (U) '' GoTo UpDate");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 141 WriteEol(FH," (D) '' GoTo Delete");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 142 WriteEol(FH,'}');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 143 WriteEol(FH,'Window:{');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 144 WriteEol(FH,' Position:(15,3,30,9)');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 145 WriteEol(FH,' }');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 146 WriteEol(FH,'------------------------------------------------------');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 147 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 148 WriteEol(FH,' # Update #');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 149 WriteEol(FH,' # Delete #');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 150 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 151
- 152
- 153
- 154 (* *)
- 155 (* Generate a screen with all of the database*)
- 156 (* fields for testing *)
- 157
- 158
- 159
- 160
- 161 WriteEol(FH,'===================================================');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 162 WriteStr(FH,':');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 163 WriteEol(FH,FileName);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 164 WriteEol(FH,'Fields :{ ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 165 (* *)
- 166 (* Add a screen field for each database field *)
- 167 (* *)
- 168 LnCnt := 4;
- 169 FOR Cnt := 1 TO ListLength(FldList) DO (* create index for each indexed item*)
- ***** ^ not supported yet
- ***** ^ not supported yet
- 170 GetElmtAdr(FldList,Cnt,FldPnt,Size,Code); (* get each field *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 171 CrunchBlanks(FldPnt^.Name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 172 CAPstr(FldPnt^.Name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 173 WriteStr(FH,"() '");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 174 CAPstr(FldPnt^.Name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 175 WriteStr(FH,FldPnt^.Name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 176 WriteStr(FH,"'");
- ***** ^ not supported yet
- ***** ^ not supported yet
- 177 IF FldPnt^.Type = 'C'
- ***** ^ not supported yet
- ***** ^ not supported yet
- 178 THEN WriteEol(FH,' String')
- ***** ^ not supported yet
- ***** ^ not supported yet
- 179 ELSIF FldPnt^.Type = 'N'
- ***** ^ not supported yet
- ***** ^ not supported yet
- 180 THEN
- 181 IF FldPnt^.Len > 0
- ***** ^ not supported yet
- ***** ^ not supported yet
- 182 THEN
- 183 WriteEol(FH,' Real [0..99999]')
- ***** ^ not supported yet
- ***** ^ not supported yet
- 184 ELSE
- 185 WriteEol(FH,' INTEGER [0..9999]');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 186 END;
- 187 ELSIF FldPnt^.Type = 'M' (* memo *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- 188 THEN WriteEol(FH, 'Editor; 2 lines');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 189 ELSIF FldPnt^.Type = 'D' (* date type *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- 190 THEN WriteEol(FH, ' Date');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 191 ELSE (* don't know what to do with choice fields Type 'L'*)
- 192 WriteEol(FH,' String');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 193 END; (* end of if elsif *)
- 194 END; (* end of for each field *)
- 195 WriteEol(FH,'}'); (* end of field section *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- 196
- 197
- 198 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 199 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 200 WriteEol(FH,'Window :{');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 201 WriteEol(FH,'Position:(1,4,80,24)');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 202 WriteEol(FH,'}');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 203
- 204 WriteEol(FH,'-----------------------------------------------------');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 205
- 206
- 207 (* now paint the screen with each field *)
- 208
- 209
- 210
- 211 WriteEol(FH,'');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 212 FOR Cnt := 1 TO ListLength(FldList) DO (* create index for each indexed item*)
- ***** ^ not supported yet
- ***** ^ not supported yet
- 213 GetElmtAdr(FldList,Cnt,FldPnt,Size,Code); (* get each field *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 214 IF FldPnt^.Type = 'D'
- ***** ^ not supported yet
- ***** ^ not supported yet
- 215 THEN FldPnt^.Len := 8;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 216 END;
- 217 WriteStr(FH,' ');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 218 WriteStr(FH, FldPnt^.Name);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 219 Str :=
- ***** ^ not supported yet
- 220 ' # ';
- ***** ^ not supported yet
- 221 SetLength(Str,FldPnt^.Len+4);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 222 WriteStr(FH,Str);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 223 WriteEol(FH,'#');
- ***** ^ not supported yet
- ***** ^ not supported yet
- 224 END;
- 225
- 226
- 227
- 228 EM := CloseHandle(FH);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 229
- 230 END GenEdtFile;
- ***** ^ not supported yet
- 231
- 232
- 233
- 234
- 235 END GenEdt.
- ***** ^ not supported yet
- 280 errors
|