'===========================================================================
' Subject: SOURCE CODE FORMATTER FOR PB/CC   Date: 06-27-98 (00:00)       
' Author:  PowerBASIC, Inc.                  Code: PBCC                   
' Origin:  ftp.powerbasic.com              Packet: PBCC.ABC
'===========================================================================
'==============================================================================
'
'  Source code formatter for PB/CC
'  Copyright (c) 1998 by PowerBASIC, Inc.  All Rights Reserved.
'
'  Call from DOS prompt as:  PBSF filename.ext
'
'  PBSF renames your source code file to filename.BAK and reads that file
'  as if formats each line of code.  To restore the original source code,
'  just rename it back to its original filename.
'
'==============================================================================

%FALSE = 0
%TRUE  = NOT %FALSE

'-----------------------------------------------------------------------------

GLOBAL IndentStart AS LONG
GLOBAL IndentSize  AS LONG
GLOBAL KeywordCase AS LONG
GLOBAL Cmds        AS STRING

'-----------------------------------------------------------------------------

FUNCTION Exist(BYVAL Filenam AS STRING) AS LONG

  FUNCTION = LEN(DIR$(Filenam)) > 0

END FUNCTION

'-----------------------------------------------------------------------------
' MakeBAK - Rename a file with a .BAK extension and return the new filename
'
' Filename = Name of the file to rename.
'
' Returns:
'   Name of file with .BAK extension.
'
FUNCTION MakeBAK(BYVAL Filename AS STRING) AS STRING

  DIM Bak AS STRING
  DIM Dot AS LONG

  Bak = Filename

  '***  Add BAK extension  ***

  Dot = INSTR(Bak, ".")
  IF Dot = 0 THEN
    Bak = Bak + ".BAK"
  ELSE
    Bak = LEFT$(Bak, Dot) + "BAK"
  END IF

  '***  If .BAK file already exists, kill it  ***

  IF Exist(Bak) THEN
    KILL Bak
  END IF

  '***  Rename file  ***

  NAME Filename AS Bak

  '*** Return the new file name ***

  FUNCTION = Bak

END FUNCTION

'-----------------------------------------------------------------------------
' Parse the next word in a BASIC source code line
'
FUNCTION BasParse( Source AS STRING ) AS STRING

  LOCAL Char AS LONG
  LOCAL x    AS LONG
  LOCAL Temp AS STRING

  Char = ASC(Source)

  SELECT CASE Char
    CASE -1
      FUNCTION = ""
      Source = ""
      EXIT FUNCTION

    CASE 9, 32  'white space
      FOR x = 1 TO LEN(Source)
        Char = ASC(Source, x)
        IF Char <> 9 AND Char <> 32 THEN
          FUNCTION = LEFT$(Source, x)
          Source = MID$(Source, x+1)
          EXIT FUNCTION
        END IF
      NEXT

    CASE 39, 40, 41, 42, 43, 44, 45, 47, 58, 59, 60, 61, 62, 92, 94
      FUNCTION = CHR$(Char)
      IF LEN(Source) > 1 THEN
        Source = LTRIM$(MID$(Source, 2))
      ELSE
        Source = ""
      END IF
      EXIT FUNCTION

    CASE = 34
      FOR x = 2 TO LEN(Source)
        IF MID$(Source, x, 1) = CHR$(34) THEN
          EXIT FOR
        END IF
      NEXT x
      IF x >= LEN(Source) THEN
        FUNCTION = RTRIM$(Source)
        Source = ""
        EXIT FUNCTION
      ELSE
        FUNCTION = RTRIM$(LEFT$(Source, x))
        Source = LTRIM$(MID$(Source, x+1))
        EXIT FUNCTION
      END IF

  END SELECT

  Temp = EXTRACT$(Source, ANY CHR$(32,34,39,40,41,42,43,44,45,47,58,59,60,61,62,92,94))
  FUNCTION = Temp

  IF LEN(Temp) = LEN(Source) THEN
    Source = ""
  ELSE
    Source = LTRIM$(MID$(Source, LEN(Temp) + 1))
  END IF

END FUNCTION

'-----------------------------------------------------------------------------

FUNCTION FormatLine(BYVAL Source AS STRING) AS STRING

  LOCAL Original    AS STRING
  LOCAL Work        AS STRING
  LOCAL TempStart   AS LONG
  LOCAL KeyWord     AS STRING
  LOCAL Tmp         AS LONG
  LOCAL Temp        AS STRING
  LOCAL NewLine     AS STRING
  LOCAL TempLine    AS STRING
  LOCAL LastKeyWord AS STRING

  STATIC InComment AS LONG

  Original = TRIM$(Source, ANY CHR$(9,32))
  Work     = UCASE$(Original)
  TempStart = -1

  IF LEN(Work) = 0 THEN
    EXIT FUNCTION
  END IF

  KeyWord = UCASE$(EXTRACT$(Work, ANY " ,="))

  IF InComment = %TRUE THEN
    FUNCTION = Source
    EXIT FUNCTION

  ELSEIF UCASE$(LEFT$(Work, 5)) = "$IF 0" THEN
    InComment = %TRUE
    TempStart = 0
    GOTO ExtendLine

  ELSEIF KeyWord = "$ENDIF" THEN
    InComment = %FALSE
    TempStart = 0
    GOTO ExtendLine

  ELSEIF (ASC(Work) = 39) OR (UCASE$(LEFT$(Work, 3)) = "REM") THEN
    FUNCTION  = Source
    EXIT FUNCTION

  ELSEIF (ASC(Work) = 33) OR (UCASE$(LEFT$(Work, 3)) = "ASM") THEN
    FUNCTION  = Source                     'don't mess with ASM lines
    EXIT FUNCTION

  ELSEIF KeyWord = "DATA" THEN             'don't mess with DATA statements
    FUNCTION  = Source
    EXIT FUNCTION

  ELSEIF (ASC(Work) = 36) THEN             'meta-statement
    TempStart = 0
    GOTO ExtendLine

  END IF

  IF KeyWord = "IF" THEN
    Tmp = INSTR(UCASE$(Work), "THEN")
    IF (Tmp + 3) = LEN(Work) THEN
      TempStart = IndentStart
      IndentStart = IndentStart + IndentSize
      GOTO ExtendLine
    END IF
    Temp = LTRIM$(MID$(Work, Tmp+4))
    IF ASC(Temp) = 39 THEN
      TempStart = IndentStart
      IndentStart = IndentStart + IndentSize
      GOTO ExtendLine
    END IF
    GOTO ExtendLine
  END IF

  IF (KeyWord = "ELSE") OR (KeyWord = "ELSEIF") THEN
    Tmp = IndentStart - IndentSize
    IF Tmp< 0 THEN
      Tmp = 0
    END IF
    TempStart = Tmp
    GOTO ExtendLine
  END IF

  IF KeyWord = "END" THEN
    Temp = UCASE$(Work)
    IF (INSTR(Temp, "IF") = 5) OR (INSTR(Temp, "TYPE") = 5) THEN
      IndentStart = IndentStart - IndentSize
      GOTO ExtendLine
    ELSEIF INSTR(Temp, "SUB") = 5 THEN
      IndentStart = 0
    ELSEIF INSTR(Temp, "FUNCTION") = 5 THEN
      IndentStart = 0
    ELSEIF INSTR(Temp, "SELECT") = 5 THEN
      IndentStart = IndentStart - IndentSize
      IndentStart = IndentStart - IndentSize
      GOTO ExtendLine
    END IF
  END IF

  IF KeyWord = "SUB" THEN
    TempStart = 0
    IndentStart = IndentSize
    GOTO ExtendLine
  END IF

  IF (KeyWord = "FUNCTION") AND (INSTR(Work, "=") = 0) THEN
    TempStart = 0
    IndentStart = IndentSize
    GOTO ExtendLine
  END IF

  IF KeyWord = "TYPE" THEN
    TempStart = IndentStart
    IndentStart = IndentStart + IndentSize
    GOTO ExtendLine
  END IF

  IF KeyWord = "SELECT" THEN
    TempStart = IndentStart
    IndentStart = IndentStart + IndentSize
    IndentStart = IndentStart + IndentSize
    GOTO ExtendLine
  END IF

  IF KeyWord = "CASE" THEN
    Tmp = IndentStart - IndentSize
    IF Tmp< 0 THEN
      Tmp = 0
    END IF
    TempStart = Tmp
    GOTO ExtendLine
  END IF

  IF KeyWord = "FOR" THEN
    IF INSTR(Work, "NEXT") = 0 THEN
      TempStart = IndentStart
      IndentStart = IndentStart + IndentSize
      GOTO ExtendLine
    END IF

  ELSEIF KeyWord = "NEXT" THEN
    IndentStart = IndentStart - IndentSize
    GOTO ExtendLine

  END IF

  IF KeyWord = "WHILE" THEN
    IF INSTR(Work, "WEND") = 0 THEN
      TempStart = IndentStart
      IndentStart = IndentStart + IndentSize
      GOTO ExtendLine
    END IF

  ELSEIF KeyWord = "WEND" THEN
    IndentStart = IndentStart - IndentSize
    GOTO ExtendLine

  END IF

  IF KeyWord = "DO" THEN
    IF INSTR(Work, "LOOP") = 0 THEN
      TempStart = IndentStart
      IndentStart = IndentStart + IndentSize
      GOTO ExtendLine
    END IF

  ELSEIF KeyWord = "LOOP" THEN
    IndentStart = IndentStart - IndentSize
    GOTO ExtendLine

  END IF

ExtendLine:
  IF TempStart = -1 THEN
    NewLine = SPACE$(IndentStart)
  ELSE
    NewLine = SPACE$(TempStart)
  END IF

  TempLine = Original
  WHILE LEN(TempLine)
    KeyWord = BasParse( TempLine )

    IF KeyWordCase > 0 THEN
      IF INSTR(UCASE$(Cmds), UCASE$(" "+KeyWord+" ")) > 0 THEN
        IF     KeyWordCase = 1 THEN               ' upper case
          KeyWord = UCASE$(KeyWord)
        ELSEIF KeyWordCase = 2 THEN               ' lower case
          KeyWord = LCASE$(KeyWord)
        END IF
      END IF
    END IF

    IF KeyWord = "'" THEN
      NewLine$ = NewLine$ + KeyWord + TempLine$
      EXIT DO
    ELSEIF (KeyWord = ",") OR (KeyWord = ";") OR (KeyWord = ":") THEN
      NewLine$ = RTRIM$(NewLine$) + KeyWord + " "
    ELSEIF KeyWord = "-" THEN
      IF LastKeyWord = "(" THEN
        NewLine$ = NewLine$ + KeyWord + BasParse$( TempLine$ ) + " "
      ELSEIF (INSTR("+=/\<>*^-", LastKeyWord)) AND (INSTR(TempLine$, ANY "0123456789") < 0) THEN
        NewLine$ = NewLine$ + KeyWord + BasParse$( TempLine$ ) + " "
      ELSE
        NewLine$ = NewLine$ + KeyWord + " "
      END IF
    ELSEIF KeyWord = "(" THEN
      IF (INSTR("-+/\*^<>=", LastKeyWord)>0) OR (INSTR("ELSEIFANDXORMOD", LastKeyWord)>0) THEN
        NewLine$ = NewLine$ + KeyWord + " "
      ELSE
        NewLine$ = RTRIM$(NewLine$) + KeyWord + " "
      END IF
    ELSEIF KeyWord = ")" THEN
      IF INSTR("()", LastKeyWord) THEN
        NewLine$ = RTRIM$(NewLine$) + KeyWord + " "
      ELSEIF ASC(TempLine$) = 46 THEN
        NewLine$ = NewLine$ + KeyWord
      ELSE
        NewLine$ = NewLine$ + KeyWord + " "
      END IF
    ELSE
      NewLine$ = NewLine$ + KeyWord + " "
    END IF
    LastKeyWord = UCASE$(KeyWord)
  WEND

  FormatLine$ = RTRIM$(NewLine$)

END FUNCTION

'-----------------------------------------------------------------------------

FUNCTION PbMain() AS LONG

  LOCAL Temp      AS STRING
  LOCAL Percent   AS LONG
  LOCAL ErCode    AS LONG
  LOCAL InFile    AS STRING
  LOCAL OutFile   AS STRING
  LOCAL Length    AS LONG
  LOCAL BytesRead AS LONG

' PowerBASIC metastatements

  Cmds = ""
  Cmds = Cmds + " $ALIAS $CODE $COM $COM1 $COM2 $COMPILE $CPU $DEBUG $DIM"
  Cmds = Cmds + " $DYNAMIC $ELSE $ENDIF $ERROR $EVENT $FLOAT $HUGE $IF"
  Cmds = Cmds + " $INCLUDE $INLINE $LIB $LINK $LIST $OPTIMIZE $OPTION $REGISTER $SEGMENT"
  Cmds = Cmds + " $SOUND $STACK $STATIC $STRING"

' PowerBASIC supported statements and functions

  Cmds = Cmds + " ABS ABSOLUTE ACCESS ALIAS ALL AND ANY APPEND ARRAY AS ASC ASCEND ASCII ASCIIZ ASM AT ATN ATTRIB"
  Cmds = Cmds + " BASE BCD BEEP BIN$ BINARY BIT BITS BLOAD BSAVE BYTE BYVAL BUTTONS"
  Cmds = Cmds + " CALL CASE CBCD CBYT CCUR CDBL CDWD CEIL CEXT CFIX CHAIN CHDIR CHDRIVE CHR$ CINT CIRCLE CLEAR CLNG CLOSE CLS CODEPTR CODESEG COLLATE COLOR COM COMMAND$ COMMON CONSIN CONSOUT"
  Cmds = Cmds + " COS CQUD CSNG CSRLIN CURDIR$ CURSOR CURSORX CURSORY CVB CVBYT CVD CVDWD CVE CVF CVI CVL CVMD CVMS CVQ CVS CVWRD CWRD"
  Cmds = Cmds + " DATA DATE$ DECLARE DECR DEF DEFBCD DEFBYT DEFCUR DEFDBL DEFDWD DEFEXT DEFFIX DEFFLX DEFINT DEFLNG DEFQUD DEFSNG DEFSTR DEFWRD DELAY DELETE DESCEND DIM DIR$ DO DOUBLE DOWN DRAW DWORD DYNAMIC"
  Cmds = Cmds + " ELSE ELSEIF EMS END ENDMEM ENVIRON ENVIRON$ EOF EQV ERADR"
  Cmds = Cmds + " ERASE ERRCLEAR ERDEV ERDEV$ ERL ERR ERROR ERRTEST EVENT EXE EXECUTE"
  Cmds = Cmds + " EXIT EXP EXP10 EXP2 EXPORT EXTERNAL EXTRACT$"
  Cmds = Cmds + " FAR FIELD FILEATTR FILES FIX FIXDIGITS FLEXCHR$ FLUSH FORMAT$ FORMFEED FN FOR FRAC FRE FREEFILE FROM FUNCTION"
  Cmds = Cmds + " GET GET$ GETSTDERR GETSTDIN GETSTDOUT GLOBAL GO GOSUB GOTO"
  Cmds = Cmds + " HEX"
  Cmds = Cmds + " IF IMP IN INCR INKEY$ INLINE INP INPUT INPUT$ INSERT INSHIFT INSTAT INSTR INT INTEGER INTERRUPT IOCTL$ IS ISFALSE ISTRUE ITERATE"
  Cmds = Cmds + " KEY KILL"
  Cmds = Cmds + " LCASE$ LEFT LEFT$ LEN LET LINE LOC LOCAL LOCATE LOCK LOF LOG LOG10 LOG2 LONG LOOP LPOS LPRINT LSET LTRIM$"
  Cmds = Cmds + " MAKDWD MAKLNG MAKPTR MAP MAX MEMPACK MEMSET MID$ MIN MKB$ MKBYT$ MKD$ MKDIR MKDWD$ MKE$ MKF$ MKI$ MKL$ MKMD$ MKMS$ MKQ$ MKS$ MKWRD$ MOD MOUSE MOUSEBUTTONS MOUSESTAT MOUSEX MOUSEY MTIMER MULTIPLEX"
  Cmds = Cmds + " NAME NEXT NOT"
  Cmds = Cmds + " OCT$ OFF ON OPEN OPTION OR OUT"
  Cmds = Cmds + " PAGE PAINT PALETTE PARSE$ PARSECOUNT PCOPY PEEK PEEK$ PEEKI PEEKL PEN PLAY PMAP POINT POKE POKE$ POKEI POKEL POPUP POS PRESET PRINT PRIVATE PSET PTR PUBLIC PUT"
  Cmds = Cmds + " QUIET"
  Cmds = Cmds + " RANDOM RANDOMIZE READ REDIM REG REM REMOVE REPEAT REPLACE RESET RESTORE RESUME RETURN RIGHT RIGHT$ RMDIR RND ROTATE ROUND RSET RTRIM$ RUN"
  Cmds = Cmds + " SAVE SCAN SCREEN SCREENATTR SCREENX SCREENY SCROLL SEEK SEG SELECT SETMEM SGN SHARED SHELL SHIFT SIN SINGLE SLEEP SORT SOUND SPACE$ SPC SQR STATIC STDERR STDIN STDOUT STEP STICK STOP STR$ STDEOF STRIG"
  Cmds = Cmds + " STRING STRING$ STRPTR STRSEG STUFF SUB SWAP SYSTEM"
  Cmds = Cmds + " TAB TAGARRAY TALLY TAN THEN TIME$ TIMER TO TRIM$ TROFF TRON TYPE"
  Cmds = Cmds + " UBOUND UCASE UCASE$ UEVENT UNION UNIT UNLOCK UNTIL UP USING USING$ USR"
  Cmds = Cmds + " VAL VARPTR VARPTR VARSEG VERIFY VIEW VIRTUAL"
  Cmds = Cmds + " WAIT WAITKEY$ WAITSTAT WEND WHILE WIDTH WINDOW WITH WORD WRITE"
  Cmds = Cmds + " XOR"

  IndentStart = 0           'starting column for indenting
  IndentSize  = 2           'number of spaces to indent
  KeywordCase = 0           'don't change keyword case
              ' 1           'convert keywords to upper case
              ' 2           'convert keywords to lower case

  ON ERROR GOTO ErrorHandler

  CURSOR OFF

  PRINT "PB/CC Source Code Formatter v1.00"
  PRINT "Copyright (c) 1998 PowerBASIC, Inc.  All Rights Reserved."
  PRINT

  OutFile  = UCASE$(COMMAND$)

'***  Check for filename on command line  ***
  IF LEN(OutFile) = 0 THEN
    PRINT "Usage:  PBSF filename.ext"
    EXIT FUNCTION
  END IF

'***  Assume a .BAS extension  ***
  IF INSTR(OutFile, ".") = 0 THEN
    OutFile = OutFile + ".BAS"
  END IF

'***  Make sure it exists  ***
  IF NOT Exist(OutFile) THEN
    PRINT "File Not Found."
    BEEP
    EXIT FUNCTION
  END IF

'***  Backup original file  ***
  Infile = MakeBAK(Outfile)

'***  Open file and process it  ***
  OPEN InFile FOR INPUT AS #1
    OPEN OutFile FOR OUTPUT AS #2
      Length = LOF(1)
      WHILE NOT EOF(1)
        LINE INPUT# 1, Temp
        BytesRead = BytesRead + LEN(Temp) + 2
        Percent = (BytesRead * 100) \ Length
        LOCATE ,1
        PRINT FORMAT$(Percent);"% Done";
        Temp = FormatLine(Temp)
        PRINT# 2, Temp
      WEND
    CLOSE 2
  CLOSE 1

  PRINT
  CURSOR ON
  EXIT FUNCTION

ErrorHandler:
  BEEP

  ErCode  = ERR

  RESUME DisplayCode

DisplayCode:

  PRINT ""
  PRINT "Error"; ErCode
  PRINT ""
  PRINT "Your original source code is in "; Infile ; "."
  CURSOR ON

END FUNCTION