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