home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l180 / 2.ddi / QBFMT.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-02-07  |  10.4 KB  |  309 lines
  1.   ' ************************************************
  2.   ' **  Name:          QBFMT                      **
  3.   ' **  Type:          Program                    **
  4.   ' **  Module:        QBFMT.BAS                  **
  5.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  6.   ' ************************************************
  7.   '
  8.   ' Reformats a QuickBASIC program by indenting
  9.   ' lines according to the structure of the statements.  The
  10.   ' default amount is 4 spaces if no indention parameter
  11.   ' is given on the command line.
  12.   '
  13.   ' USAGE:  QBFMT filename [indention]
  14.   '         Command$ = filename [indention]
  15.   ' .MAK FILE:   QBFMT.BAS
  16.   '              PARSE.BAS
  17.   '              STRINGS.BAS
  18.   ' PARAMETERS:  filename(.BAS)   Name of QuickBASIC module to be formatted;
  19.   '                               the module must be saved in "Text" format
  20.   ' VARIABLES:   md$              Working copy of COMMAND$ contents
  21.   '              fileName$        Name of QuickBASIC module to be formatted
  22.   '              dpoint%          Position of the decimal point character
  23.   '                               in cmd$
  24.   '              ndent$           Part of cmd$ dealing with optional
  25.   '                               indention amount
  26.   '              indention%       Number of character columns per
  27.   '                               indention level
  28.   '              progline$        Each line of the file being processed
  29.   '              indentLevel%     Keeps track of current indention amount
  30.   '              nest$            Message placed in file if faulty structure
  31.   '                               detected
  32.   
  33.     DECLARE FUNCTION LtrimSet$ (a$, set$)
  34.     DECLARE FUNCTION RtrimSet$ (a$, set$)
  35.     DECLARE SUB Indent (a$, indention%, indentLevel%)
  36.     DECLARE SUB ParseWord (a$, sep$, word$)
  37.     DECLARE SUB SetCode (a$, keyWord$, code%)
  38.     DECLARE SUB SplitUp (a$, comment$, keyWord$)
  39.   
  40.   ' Decipher the user command line
  41.     cmd$ = COMMAND$
  42.     IF cmd$ = "" THEN
  43.         PRINT
  44.         PRINT "Usage:  QBFMT filename(.BAS) [indention]"
  45.         SYSTEM
  46.     ELSE
  47.         ParseWord cmd$, " ,", fileName$
  48.         dpoint% = INSTR(fileName$, ".")
  49.         IF dpoint% THEN
  50.             fileName$ = LEFT$(fileName$, dpoint% - 1)
  51.         END IF
  52.         ParseWord cmd$, " ,", ndent$
  53.         indention% = VAL(ndent$)
  54.         IF indention% < 1 THEN
  55.             indention% = 4
  56.         END IF
  57.     END IF
  58.   
  59.   ' Try to open the indicated files
  60.     PRINT
  61.     ON ERROR GOTO ErrorTrapOne
  62.     OPEN fileName$ + ".BAS" FOR INPUT AS #1
  63.     OPEN fileName$ + ".@$@" FOR OUTPUT AS #2
  64.     ON ERROR GOTO 0
  65.   
  66.   ' Process each line of the file
  67.     DO
  68.         LINE INPUT #1, progLine$
  69.         Indent progLine$, indention%, indentLevel%
  70.         PRINT progLine$
  71.         PRINT #2, progLine$
  72.         IF indentLevel% < 0 OR (EOF(1) AND indentLevel% <> 0) THEN
  73.             SOUND 555, 5
  74.             SOUND 333, 9
  75.             nest$ = "'<<<<<<<<<<<<<<<<<<<<< Nesting error detected!"
  76.             PRINT nest$
  77.             PRINT #2, nest$
  78.             indentLevel% = 0
  79.         END IF
  80.     LOOP UNTIL EOF(1)
  81.   
  82.   ' Close all files
  83.     CLOSE
  84.   
  85.   ' Delete any old .BAK file
  86.     ON ERROR GOTO ErrorTrapTwo
  87.     KILL fileName$ + ".BAK"
  88.     ON ERROR GOTO 0
  89.   
  90.   ' Rename the files
  91.     NAME fileName$ + ".BAS" AS fileName$ + ".BAK"
  92.     NAME fileName$ + ".@$@" AS fileName$ + ".BAS"
  93.   
  94.   ' We're done
  95.     END
  96.   
  97.   '----------- Error trapping routines
  98.   
  99. ErrorTrapOne:
  100.     PRINT "Error while opening files"
  101.     SYSTEM
  102.   
  103. ErrorTrapTwo:
  104.     RESUME NEXT
  105.   
  106.   ' ************************************************
  107.   ' **  Name:          Indent                     **
  108.   ' **  Type:          Subprogram                 **
  109.   ' **  Module:        QBFMT.BAS                  **
  110.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  111.   ' ************************************************
  112.   '
  113.   ' Determines the indention for each line.
  114.   '
  115.   ' EXAMPLE OF USE:  Indent a$, indention%, indentLevel%
  116.   ' PARAMETERS:      a$             Program line to be indented
  117.   '                  indention%     Spaces to add for each indention level
  118.   '                  indentLevel%   Level of indention
  119.   ' VARIABLES:       comment$       Part of program line that represents a
  120.   '                                 REMARK
  121.   '                  keyWord$       First word of the program line
  122.   '                  code%          Indention control code determined by
  123.   '                                 keyWord$
  124.   ' MODULE LEVEL
  125.   '   DECLARATIONS:  DECLARE SUB Indent (a$, indention%, indentLevel%)
  126.   '
  127.     SUB Indent (a$, indention%, indentLevel%) STATIC
  128.       
  129.       ' Break line into manageable parts
  130.         SplitUp a$, comment$, keyWord$
  131.       
  132.         IF keyWord$ <> "" THEN
  133.           
  134.           ' Set indention code according to type of keyword
  135.             SetCode a$, keyWord$, code%
  136.           
  137.           ' Build a string of spaces for the indicated indention
  138.             SELECT CASE code%
  139.             CASE -2
  140.                 a$ = SPACE$(indention% * indentLevel%) + a$
  141.             CASE -1
  142.                 a$ = SPACE$(indention% * indentLevel%) + a$
  143.                 indentLevel% = indentLevel% - 1
  144.             CASE 0
  145.                 a$ = SPACE$(indention% * (indentLevel% + 1)) + a$
  146.             CASE 1
  147.                 indentLevel% = indentLevel% + 1
  148.                 a$ = SPACE$(indention% * indentLevel%) + a$
  149.             CASE ELSE
  150.             END SELECT
  151.         ELSE
  152.             a$ = SPACE$(indention% * indentLevel% + 2)
  153.         END IF
  154.       
  155.       ' Round out the position of trailing comments
  156.         IF comment$ <> "" THEN
  157.             IF a$ <> SPACE$(LEN(a$)) AND a$ <> "" THEN
  158.                 a$ = a$ + SPACE$(16 - (LEN(a$) MOD 16))
  159.             END IF
  160.         END IF
  161.       
  162.       ' Tack the comment back onto the end of the line
  163.         a$ = a$ + comment$
  164.       
  165.     END SUB
  166.   
  167.   ' ************************************************
  168.   ' **  Name:          SetCode                    **
  169.   ' **  Type:          Subprogram                 **
  170.   ' **  Module:        QBFMT.BAS                  **
  171.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  172.   ' ************************************************
  173.   '
  174.   ' Determines a code number for the type of indention
  175.   ' implied by the various types of keywords that begin
  176.   ' each line of QuickBASIC programs.
  177.   '
  178.   ' EXAMPLE OF USE:   SetCode a$, keyWord$, code%
  179.   ' PARAMETERS:       a$         Program line to indent
  180.   '                   keyWord$   First word of the program line
  181.   '                   code%      Returned code indicating the action to be taken
  182.   ' VARIABLES:        (none)
  183.   ' MODULE LEVEL
  184.   '   DECLARATIONS:   DECLARE SUB SetCode (a$, keyWord$, code%)
  185.   '
  186.     SUB SetCode (a$, keyWord$, code%) STATIC
  187.         SELECT CASE keyWord$
  188.         CASE "DEF"
  189.             IF INSTR(a$, "=") THEN
  190.                 code% = 0
  191.             ELSE
  192.                 IF INSTR(a$, " SEG") = 0 THEN
  193.                     code% = 1
  194.                 END IF
  195.             END IF
  196.         CASE "ELSE"
  197.             code% = -2
  198.         CASE "ELSEIF"
  199.             code% = -2
  200.         CASE "CASE"
  201.             code% = -2
  202.         CASE "END"
  203.             IF a$ <> "END" THEN
  204.                 code% = -1
  205.             ELSE
  206.                 code% = 0
  207.             END IF
  208.         CASE "FOR"
  209.             code% = 1
  210.         CASE "DO"
  211.             code% = 1
  212.         CASE "SELECT"
  213.             code% = 1
  214.         CASE "IF"
  215.             IF RIGHT$(a$, 4) = "THEN" THEN
  216.                 code% = 1
  217.             ELSE
  218.                 code% = 0
  219.             END IF
  220.         CASE "NEXT"
  221.             code% = -1
  222.         CASE "LOOP"
  223.             code% = -1
  224.         CASE "SUB"
  225.             code% = 1
  226.         CASE "FUNCTION"
  227.             code% = 1
  228.         CASE "TYPE"
  229.             code% = 1
  230.         CASE "WHILE"
  231.             code% = 1
  232.         CASE "WEND"
  233.             code% = -1
  234.         CASE ELSE
  235.             code% = 0
  236.         END SELECT
  237.     END SUB
  238.   
  239.   ' ************************************************
  240.   ' **  Name:          SplitUp                    **
  241.   ' **  Type:          Subprogram                 **
  242.   ' **  Module:        QBFMT.BAS                  **
  243.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  244.   ' ************************************************
  245.   '
  246.   ' Splits the line into statement, comment, and keyword.
  247.   '
  248.   ' EXAMPLE OF USE:  SplitUp a$, comment$, keyWord$
  249.   ' PARAMETERS:      a$         Program line to be split up
  250.   '                  comment$   Part of line following "REM" or "'"
  251.   '                  keyWord$   First word of program line
  252.   ' VARIABLES:       set$       Characters to be trimmed, space and tab
  253.   '                  strFlag%   Indication of a quoted string
  254.   '                  k%         Index to start of REMARK
  255.   '                  i%         Looping index
  256.   '                  m%         Pointer to REMARK
  257.   '                  sptr%      Pointer to first space following the
  258.   '                             first word in a$
  259.   ' MODULE LEVEL
  260.   '   DECLARATIONS:  DECLARE SUB SplitUp (a$, comment$, keyWord$)
  261.   '
  262.     SUB SplitUp (a$, comment$, keyWord$) STATIC
  263.         set$ = " " + CHR$(9)
  264.         strFlag% = 0
  265.         k% = 0
  266.         FOR i% = LEN(a$) TO 1 STEP -1
  267.             IF MID$(a$, i%, 1) = CHR$(34) THEN
  268.                 IF strFlag% = 0 THEN
  269.                     strFlag% = 1
  270.                 ELSE
  271.                     strFlag% = 0
  272.                 END IF
  273.             END IF
  274.             IF MID$(a$, i%, 1) = "'" OR MID$(a$, i%, 3) = "REM" THEN
  275.                 IF strFlag% = 0 THEN
  276.                     k% = i%
  277.                 END IF
  278.             END IF
  279.         NEXT i%
  280.         IF k% > 0 THEN
  281.             m% = 0
  282.             FOR j% = k% - 1 TO 1 STEP -1
  283.                 IF INSTR(set$, MID$(a$, j%, 1)) = 0 THEN
  284.                     IF m% = 0 THEN m% = j%
  285.                 END IF
  286.             NEXT j%
  287.             IF m% THEN
  288.                 comment$ = MID$(a$, m% + 1)
  289.                 a$ = LEFT$(a$, m%)
  290.             ELSE
  291.                 comment$ = a$
  292.                 a$ = ""
  293.             END IF
  294.         ELSE
  295.             comment$ = ""
  296.         END IF
  297.         a$ = LtrimSet$(a$, set$)
  298.         a$ = RtrimSet$(a$, set$)
  299.         comment$ = LtrimSet$(comment$, set$)
  300.         comment$ = RtrimSet$(comment$, set$)
  301.         sptr% = INSTR(a$, " ")
  302.         IF sptr% THEN
  303.             keyWord$ = UCASE$(LEFT$(a$, sptr% - 1))
  304.         ELSE
  305.             keyWord$ = UCASE$(a$)
  306.         END IF
  307.     END SUB
  308.   
  309.