[comp.binaries.ibm.pc] Tabulation program for dBASE files - Plain ASCII format

dougie@its63b.ed.ac.uk (Dougie Nisbet) (04/21/88)

Following the recent discussion about Tabulation programs for
dBASE II/III command files, I've decided to post the basic program
which I use. I wrote it about a year ago, and it has served me well.

It has a few options. If you want, it will 

   - Remove Blank Lines
   - Remove Comment Lines
   - Allow you to provide the amount for tabulation.
   - Output the tabulated version to a temporary file, optionally 
     overwriting the original.

You can read the code, or try it out, to see the options and defaults.
I've always meant to modify it so that it would operate on a complete
directory of dBASE programs, but never quite got round to it. I don't 
know if, in fact, it is possible.

I haven't ARC'd this code since it is so short, (and I don't know how to),
but instead saved the code in ASCII format.

Fair warning about this program - It is 

               D - E - A - D        S - L - O - W

--------------------------- Beginning of Listing ---------------------------

10 REM ==================================================
20 REM Tabulation program for dBASE II/III command files
30 REM Dougie Nisbet, University of Edinburgh, Scotland
40 REM ==================================================
50 REM
60 KEY OFF
70 T=0
80 ' List program directory if required - default is no directory
90 INPUT "Program directory  (Y/N) ";R$
100 IF INSTR(" Yy",R$) > 1 THEN CLS : FILES "*.PRG"
110 INPUT "Enter Filename ";F$
120 ' Check if default filename extension
130 IF F$="" THEN 110
140 IF INSTR(F$,".")=0 THEN:F$=F$+".PRG"
150 ' Establish Tabulation, default is 3 spaces
160 INPUT "Enter no. of spaces for tabulation ";TB
170 IF TB=0  THEN TB$="   " ELSE TB$=SPACE$(TB)
180 ' Does user want comment lines removed - default is no
190 INPUT "Remove Comment Lines? (Y/N) ";RC$
200 IF RC$="" THEN RC$="N"
210 IF INSTR("YyNn",RC$)=0 THEN 190
220 IF RC$="y" THEN RC$="Y"
230 IF RC$="n" THEN RC$="N"
240 ' Does user want blank lines removed - default is no
250 INPUT "Remove Blank Lines? (Y/N) ";RB$
260 IF RB$="" THEN RB$="N" ELSE IF RB$="y" THEN RB$="Y"
270 PRINT: PRINT SPC(20) "** ";F$;" **":PRINT
280 OPEN "I",#1,F$
290 G$=LEFT$(F$,LEN(F$)-4)+".TMP"
300 OPEN "O",#2,G$
310 WHILE NOT EOF(1)
320   LINE INPUT#1,X$
330 ' Strip command line of Tabs and spaces
340   XT$=X$
350   X2$=LEFT$(X$,1):IF X2$=" " OR X2$=CHR$(9) THEN X$=RIGHT$(X$,LEN(X$)-1):GOTO 350
360   X2$=RIGHT$(X$,1):IF X2$=" " OR X2$=CHR$(9) THEN X$=LEFT$(X$,LEN(X$)-1):GOTO 360
370 ' Scan Lines for non-printable characters
380   TS$=""
390   FOR LP=1 TO LEN(X$)
400	 LP1=ASC(MID$(X$,LP,1))
410	 IF LP1<32 OR LP1>126 THEN TS$=TS$+"<*>" ELSE TS$=TS$+MID$(X$,LP,1)
420   NEXT LP
430   X$=TS$
440 ' Check if Blank lines to be removed
450   IF X2$="" AND RB$="Y" THEN 730
460 ' Check for comment lines
470   IF LEFT$(X$,1)="*" AND RC$="Y" THEN 730
480   IF LEFT$(X$,1)="*" THEN 720
490 ' ADD ON NECESSARY TABULATION FROM LAST PASS THRU'
500   IF TB1$="Y" THEN T=T+1:TB1$="N"
510   IF TB2$="Y" THEN T=T+1:TB2$="N"
520 ' CHANGE LEADING CHARACTERS TO UPPER CASE TEMPORARILY
530   X2$=""
540   FOR LP = 1 TO LEN(X$)
550	LP1=ASC(MID$(X$,LP,1))
560	IF LP1>96 AND LP1<123 AND LP1<>32 THEN X2$=X2$+CHR$(LP1-32) ELSE X2$=X2$+MID$(X$,LP,1)
570   NEXT LP
580 ' CHECK FOR KEYWORDS IN COMMAND STRING - PLUS TABULATION
590   IF LEFT$(X2$,2)="IF" THEN TB1$="Y":GOTO 690" THEN 4295
600   IF LEFT$(X2$,7)="DO CASE" THEN TB1$="Y":TB2$="Y":GOTO 690
610   IF LEFT$(X2$,8)="DO WHILE" THEN TB1$="Y":GOTO 690
620 ' CHECK FOR KEYWORDS IN COMMAND STRING  - MINUS TABULATION
630   IF LEFT$(X2$,4)="ELSE" THEN T=T-1:TB1$="Y":GOTO 690
640   IF LEFT$(X2$,7)="ENDCASE" THEN T=T-2:GOTO 690
650   IF LEFT$(X2$,4)="CASE" THEN T=T-1:TB1$="Y":GOTO 690
660   IF LEFT$(X2$,9)="OTHERWISE" THEN T=T-1:TB1$="Y":GOTO 690
670   IF LEFT$(X2$,5)="ENDIF" THEN T=T-1:GOTO 690
680   IF LEFT$(X2$,5)="ENDDO" THEN T=T-1:GOTO 690
690   FOR LP=1 TO T
700	X$=TB$+X$
710   NEXT LP
720   PRINT X$:PRINT #2,X$
730 WEND
740 CLOSE
750 PRINT:PRINT
760 PRINT "The tabulated version of the program has been saved in ";G$
770 PRINT "Do you want to overwrite ";F$;" with ";G$;
780 INPUT R$
790 IF R$="N" OR R$="n" THEN 830 ELSE IF R$<>"Y" AND R$<>"y" THEN 750
800 KILL F$:NAME G$ AS F$
810 PRINT:PRINT G$;" has been renamed to ";F$
820 PRINT G$;" has been deleted ":PRINT
830 INPUT "Any more programs to be tabulated ";R$
840 IF R$="Y" OR R$="y" THEN RUN ELSE IF R$<>"N" AND R$<>"n" THEN 830
850 SYSTEM
------------------------------ End of Listing ---------------------------