home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / a / dbindent.lbr / DBINDENT.BZS / DBINDENT.BAS
Encoding:
BASIC Source File  |  1993-10-26  |  9.8 KB  |  242 lines
  1. 10 '    DBINDENT.BAS Version 1.00 (c) Copyright 1985 by Merlin R. Null
  2. 20 '    To pretty print dBASE II command files saved in ASCII.
  3. 30 '    This program may not be sold separately or as part of any collection
  4. 40 '    of programs without the written permission of the author:
  5. 50 '    Merlin R. Null, P.O. Box 9422, N. Hollywood, CA 91609, (818)762-1429
  6. 60 DEFINT A-Z
  7. 70 WIDTH LPRINT 255
  8. 80 ON ERROR GOTO 1970    'Used mostly to detect incorrect filename
  9. 90 BL$=CHR$(7)
  10. 100 OPEN "I",#1,"CLS.DAT"
  11. 110 WHILE NOT EOF(1)
  12. 120   LINE INPUT #1, A$
  13. 130   A=VAL(A$)
  14. 140   CLS$=CLS$+CHR$(A)
  15. 150 WEND
  16. 160 CLOSE #1
  17. 170 PRINT CLS$
  18. 180 PRINT TAB(10)"DBINDENT Version 1.00   2-19-85"
  19. 190 PRINT
  20. 200 PRINT"To modify the indentation of dBASE II command files."
  21. 210 PRINT:PRINT
  22. 220 PRINT"Options:    P        Send output to Printer"
  23. 230 PRINT"        F        Send output to File"
  24. 240 PRINT"        N        No console output"
  25. 250 PRINT"        1-9        Value to indent (default=2)"
  26. 260 PRINT"        0        Remove all indenting"
  27. 270 PRINT:PRINT
  28. 280 PRINT"Examples:    B:FOO.SRC PN4    Printer output only, indent 4 spaces"
  29. 290 PRINT"        FOO.SRC F3    Output to file and console indent 3"
  30. 300 PRINT"        FOO.SRC        Console output only indent 2 spaces"
  31. 310 PRINT"        A:        Displays directory of A:"
  32. 320 PRINT"        ?        View the Help file"
  33. 330 PRINT"        <RET>        Redisplay this screen"
  34. 340 PRINT:PRINT        'return here after directory call or error
  35. 350 LINE INPUT"Filename.SRC/.CMD or Drive:? ";NF$
  36. 360 IF NF$="" THEN 170            'Redisplay start screen
  37. 370 NFLEN=0:OPTFLAG=0:INDFLAG=0:LINEPRINT=0:FILE=0:CONOFF=0:ERASEBAK=0
  38. 380 FULLNAME$=""
  39. 390 IF NF$="?" THEN OPEN "I",#1,"DBINDENT.HLP" ELSE 520
  40. 400   PRINT CLS$
  41. 410   FOR LINES=1 TO 20
  42. 420     IF EOF(1) THEN 470 ELSE LINE INPUT #1,HELP$
  43. 430     PRINT HELP$
  44. 440   NEXT LINES
  45. 450   PRINT
  46. 460   PRINT TAB(7)"<Press any key to continue reading help file>"
  47. 470   PRINT TAB(12)"Press <ESC> to return to DBINDENT ";
  48. 480   FINISHED$=INPUT$(1)
  49. 490   IF FINISHED$<>CHR$(27) THEN 400
  50. 500   CLOSE #1
  51. 510   GOTO 170
  52. 520 FOR I=1 TO LEN(NF$)        'Convert lower to upper case & detect options
  53. 530   BYTE$=MID$(NF$,I,1)
  54. 540   IF ASC(BYTE$)>96 AND ASC(BYTE$)<123 THEN BYTE$=CHR$(ASC(BYTE$)-32)
  55. 550   FULLNAME$=FULLNAME$+BYTE$
  56. 560   IF BYTE$=" " THEN OPTFLAG=-1            'Flag start of options
  57. 570   IF NOT OPTFLAG THEN 630
  58. 580   IF BYTE$="P" THEN LINEPRINT=-1            'Detect print option
  59. 590   IF BYTE$="F" THEN FILE=-1                'Detect file option
  60. 600   IF BYTE$="N" THEN CONOFF=-1            'Detect console off
  61. 610   IF INDFLAG THEN 630
  62. 620   IF ASC(BYTE$)>47 AND ASC(BYTE$)<58 THEN INDENT=ASC(BYTE$)-48:INDFLAG=-1
  63. 630   IF NFLEN THEN 650
  64. 640   IF BYTE$="." THEN NFLEN=I+3            'Find filename length
  65. 650 NEXT I
  66. 660 IF NOT INDFLAG THEN INDENT=2        'Set default indent value
  67. 670 IF CONOFF AND NOT LINEPRINT AND NOT FILE THEN PRINT BL$; ELSE 720
  68. 680   PRINT CLS$;STRING$(5,10)
  69. 690   PRINT"The N option may not be selected alone.  It is used with"
  70. 700   PRINT"the print and file options as FN or PN.  -  try again.";BL$
  71. 710   GOTO 340
  72. 720 IF NFLEN>3 THEN FULLNAME$=LEFT$(FULLNAME$,NFLEN)'Drop options from filename
  73. 730 IF MID$(FULLNAME$,2,1)=";" THEN MID$(FULLNAME$,2,1)=":" 'ZCPR like (A;)
  74. 740 IF LEN(FULLNAME$)=2 AND MID$(FULLNAME$,2,1)=":" THEN PRINT CLS$ ELSE 790
  75. 750   DIR$=FULLNAME$+"*.*"
  76. 760   PRINT"Directory of drive ";FULLNAME$
  77. 770   FILES DIR$
  78. 780   GOTO 340
  79. 790 IF RIGHT$(FULLNAME$,3)="COM" OR RIGHT$(FULLNAME$,3)="OBJ" THEN PRINT CLS$;
  80.  
  81.     BL$ ELSE 840
  82. 800   PRINT CLS$;STRING$(5,10)
  83. 810   PRINT"Please don't do that to me.  I only work on dBASE II command";BL$
  84. 820   PRINT"files.  ";CHR$(34);FULLNAME$;CHR$(34);" is not my kind of program."
  85.  
  86.       ;BL$
  87. 830   GOTO 340
  88. 840 IF RIGHT$(FULLNAME$,4)<>".SRC" AND RIGHT$(FULLNAME$,4)<>".CMD" THEN
  89.  
  90.     PRINT CLS$ ELSE 890
  91. 850   PRINT STRING$(5,10)
  92. 860   PRINT BL$;CHR$(34);LEFT$(FULLNAME$,15);CHR$(34);" must have a .SRC or";
  93. 870   PRINT" .CMD extension  -  try again"
  94. 880   GOTO 340
  95. 890 FILENAME$=LEFT$(FULLNAME$,NFLEN-3)
  96. 900 IF NOT FILE THEN 1050
  97. 910 TMPNAME$=FILENAME$+"TMP"
  98. 920 BAKNAME$=FILENAME$+"BAK"
  99. 930 OPEN "I",#1,BAKNAME$    'See if <filename>.BAK exists
  100. 940 CLOSE #1            'Close, if found.  Else error trap gets it
  101. 950 PRINT CLS$;STRING$(8,10)
  102. 960 PRINT TAB(20)"[]=========[]"
  103. 970 PRINT TAB(20)"[] WARNING []"
  104. 980 PRINT TAB(20)"[]=========[]"
  105. 990 PRINT
  106. 1000 PRINT TAB(14) BAKNAME$;" already exists!"
  107. 1010 PRINT:PRINT:PRINT"Do you wish to continue and overwrite ";BAKNAME$;
  108. 1020 INPUT OVERWRITE$
  109. 1030 IF LEFT$(OVERWRITE$,1)<>"Y" AND LEFT$(OVERWRITE$,1)<>"y" THEN 1630
  110. 1040 ERASEBAK=-1
  111. 1050 OPEN "I",#2,FULLNAME$
  112. 1060 IF FILE THEN OPEN "O",#3,TMPNAME$
  113. 1070 PRINT CLS$;TAB(20)"^S to pause  -  ^C to abort"
  114. 1080 PRINT
  115. 1090 WHILE NOT EOF(2)
  116. 1100   START=0:BLANK=0
  117. 1110   LINE INPUT #2,TXT$
  118. 1120   PRN$=""
  119. 1130   IF LEN(TXT$)=0 THEN 1380
  120. 1140   LINENUM=LINENUM+1
  121. 1150   TEMP$=TXT$
  122. 1160   FOR BYTE=1 TO LEN(TEMP$)
  123. 1170     CHAR=ASC(MID$(TEMP$,BYTE,1))
  124. 1180     IF CHAR>127 THEN 1740
  125. 1190     IF CHAR>96 AND CHAR<123 THEN MID$(TEMP$,BYTE,1)=CHR$(CHAR-32)
  126. 1200     IF BYTE-BLANK>3 THEN BYTE=LEN(TEMP$)
  127. 1210     IF START THEN 1230
  128. 1220     IF CHAR=32 OR CHAR=9 THEN BLANK=BLANK+1 ELSE START=BYTE
  129. 1230   NEXT BYTE
  130. 1240   IF MID$(TEMP$,BLANK+1,4)="ENDT" THEN TEXTFLAG=0
  131. 1250   IF TEXTFLAG THEN PRN$=TXT$:GOTO 1380
  132. 1260   IF MID$(TEMP$,BLANK+1,4)="TEXT" THEN TEXTFLAG=-1
  133. 1270   IF MID$(TEMP$,BLANK+1,4)="ENDI" THEN IFNUM=IFNUM-1
  134. 1280   IF MID$(TEMP$,BLANK+1,4)="ENDD" THEN DOWHILENUM=DOWHILENUM-1
  135. 1290   IF MID$(TEMP$,BLANK+1,4)="ENDC" THEN DOCASENUM=DOCASENUM-1
  136. 1300   IF MID$(TEMP$,BLANK+1,4)="ELSE" OR MID$(TEMP$,BLANK+1,4)="OTHE"
  137.  
  138.        THEN BACKUP=1 ELSE BACKUP=0
  139. 1310   INDLEVEL=IFNUM+DOWHILENUM+DOCASENUM-BACKUP
  140. 1320   IF INDLEVEL<0 THEN 1850
  141. 1330   PRN$=PRN$+STRING$(INDENT*INDLEVEL,32)
  142. 1340   IF MID$(TEMP$,BLANK+1,2)="IF" THEN IFNUM=IFNUM+1
  143. 1350   IF MID$(TEMP$,BLANK+1,4)="DO W" THEN DOWHILENUM=DOWHILENUM+1
  144. 1360   IF MID$(TEMP$,BLANK+1,4)="DO C" THEN DOCASENUM=DOCASENUM+1
  145. 1370   PRN$=PRN$+MID$(TXT$,BLANK+1)
  146. 1380   IF NOT CONOFF THEN PRINT PRN$
  147. 1390   IF LINEPRINT THEN LPRINT PRN$
  148. 1400   IF FILE THEN PRINT #3, PRN$
  149. 1410   QUIT$=INKEY$
  150. 1420   IF QUIT$<>"" THEN GOSUB 1680
  151. 1430 WEND
  152. 1440 CLOSE
  153. 1450 IF IFNUM=0 AND DOWHILENUM=0 AND DOCASENUM=0 THEN 1550
  154. 1460 PRINT BL$;"*** WARNING ***  This file has the following errors:";BL$
  155. 1470 IF IFNUM>0 THEN PRINT TAB(17) IFNUM;"- IF without ENDIF"
  156. 1480 IF DOWHILENUM>0 THEN PRINT TAB(17) DOWHILENUM;"- DO WHILE without ENDDO"
  157. 1490 IF DOCASENUM>0 THEN PRINT TAB(17) DOCASENUM;"- DO CASE without ENDCASE"
  158. 1500 IF IFNUM<0 THEN PRINT TAB(17) IFNUM;"- ENDIF without IF"
  159. 1510 IF DOWHILENUM<0 THEN PRINT TAB(17) DOWHILENUM;"- ENDDO without DO WHILE"
  160. 1520 IF DOCASENUM<0 THEN PRINT TAB(17) DOCASENUM;"- ENDCASE without DO CASE"
  161. 1530 IF FILE THEN KILL TMPNAME$:PRINT"No files changed."
  162. 1540 GOTO 1660
  163. 1550 IF NOT FILE THEN 1630
  164. 1560 PRINT
  165. 1570 IF ERASEBAK THEN KILL BAKNAME$ ELSE 1590
  166. 1580   PRINT"Erasing ";BAKNAME$
  167. 1590 PRINT"Changing ";FULLNAME$;" to ";BAKNAME$
  168. 1600 NAME FULLNAME$ AS BAKNAME$
  169. 1610 PRINT"Changing ";TMPNAME$;" to ";FULLNAME$
  170. 1620 NAME TMPNAME$ AS FULLNAME$
  171. 1630 PRINT
  172. 1640 INPUT"Are you finished";ANS$
  173. 1650 IF LEFT$(ANS$,1)<>"Y" AND LEFT$(ANS$,1)<>"y" THEN 170
  174. 1660 END
  175. 1670        'The Quit routine only works with BASCOM
  176. 1680 IF QUIT$=CHR$(3) THEN CLOSE ELSE 1720
  177. 1690   IF FILE THEN KILL TMPNAME$
  178. 1700   PRINT"*** ABORTING *** ^C entered from keyboard, no files changed."
  179. 1710   GOTO 1640
  180. 1720 IF QUIT$=CHR$(19) THEN WHILE INKEY$="":WEND    'If ^S then hold
  181. 1730 RETURN
  182. 1740 CLOSE
  183. 1750 PRINT BL$
  184. 1760 PRINT"*** ABORTING ***  This file contains bytes with the 8th bit set!";BL$
  185. 1770 PRINT"          If this file has the extension .CMD, check to"
  186. 1780 PRINT"          see if it is an encoded file.  Otherwise,"
  187. 1790 PRINT"          filter the file to set the 8th bit low."
  188. 1800 PRINT"          The error was on line";LINENUM;"of file ";FULLNAME$
  189. 1810 PRINT"          Which reads:"
  190. 1820 PRINT:PRINT TXT$
  191. 1830 IF FILE THEN KILL TMPNAME$
  192. 1840 GOTO 1630
  193. 1850 PRINT BL$
  194. 1860 PRINT"*** ABORTING ***  One too many end statements were found.";BL$
  195. 1870 IF IFNUM<0 THEN PRINT TAB(19)"ENDIF without IF"
  196. 1880 IF DOWHILENUM<0 THEN PRINT TAB(19)"ENDDO without DO WHILE"
  197. 1890 IF DOCASENUM<0 THEN PRINT TAB(19)"ENDCASE without DO CASE"
  198. 1900 PRINT"                  Error was on line";LINENUM;"of file ";FULLNAME$;
  199. 1910 PRINT" Which reads:"
  200. 1920 PRINT
  201. 1930 PRINT TXT$
  202. 1940 IF FILE THEN KILL TMPNAME$
  203. 1950 PRINT
  204. 1960 GOTO 1660
  205. 1970 IF ERR=53 AND ERL=930 THEN CLOSE #1 ELSE 1990
  206. 1980   RESUME 1050
  207. 1990 IF ERR=53 AND ERL=100 THEN CLOSE #1 ELSE 2230
  208. 2000   PRINT STRING$(20,10)
  209. 2010   PRINT BL$;"CLS.DAT not found."
  210. 2020   PRINT"Please enter your your clear screen sequence"
  211. 2030   PRINT"one byte at a time in Decimal numbers.  End your"
  212. 2040   PRINT"entries with a <RETURN> to generate CLS.DAT"
  213. 2050   PRINT
  214. 2060   FOR I=1 TO 9
  215. 2070     PRINT"Clear Screen character";I;
  216. 2080     LINE INPUT C$
  217. 2090     IF C$="" AND I>1 THEN 2180
  218. 2100     IF C$="" THEN 2070
  219. 2110     IF LEN(C$)>3 THEN 2070
  220. 2120     FOR J=1 TO LEN(C$)
  221. 2130       IF ASC(MID$(C$,J,1))<48 OR ASC(MID$(C$,J,1))>57 THEN PRINT BL$;
  222.  
  223.            "Whole decimal numbers only.":GOTO 2070
  224. 2140     NEXT J
  225. 2150     IF I>1 THEN CLR$=CLR$+CHR$(13)+CHR$(10)
  226. 2160     CLR$=CLR$+C$
  227. 2170   NEXT I
  228. 2180   PRINT"Writing CLS.DAT";
  229. 2190   OPEN "O",#1,"CLS.DAT"
  230. 2200   PRINT #1,CLR$
  231. 2210   CLOSE #1
  232. 2220   RESUME 100
  233. 2230 IF ERR=53 AND ERL=390 THEN CLOSE #1 ELSE 2270
  234. 2240   PRINT CLS$;STRING$(5,10)
  235. 2250   PRINT BL$;"DBINDENT.HLP not found on this disk."
  236. 2260   RESUME 340
  237. 2270 IF ERR=64 THEN CLOSE ELSE 2310
  238. 2280   PRINT CLS$;STRING$(5,10)
  239. 2290   PRINT BL$;CHR$(34);FULLNAME$;CHR$(34);" is a bad file name - try again."
  240. 2300   RESUME 340
  241. 2310 IF ERR=53 AND ERL=1050 THEN CLOSE #2 ELSE 2350
  242. 2320   PRINT CLS$;STRING$(5,10)
  243. 2330   PRINT BL$;CHR$(34);FULLNAME$;CHR$(34);" not found - try again."
  244. 2340   RESUME 340
  245. 2350 ON ERROR GOTO 0
  246. TRING$(5,10)
  247. 2330   PRINT BL$;CHR$(34);FU