'===========================================================================
' Subject: INDENT BASIC FILES                Date: 9/10/93 (00:00)        
' Author:  Logan Ashby                       Code: QB, PDS                
' Keys:    INDENT,BASIC,FILES              Packet: TEXT.ABC
'===========================================================================
 ' --------------------------------------------------------------
 '| ID.BAS                                                ID.EXE |
 ' --------------------------------------------------------------|
 '|  This program is designed to indent a BASIC source code file |
 '|      properly. (Properly according to my definition. ;-)     |
 '| Written 9/10/93 by Logan Ashby                               |
 '|     Released to the public domain.                           |
 ' --------------------------------------------------------------

 DEFINT A-Z
 ' Change to QBX.BI for PDS
 ' $INCLUDE: 'qb.bi'

 DECLARE SUB BrkAtTok (Line1$, Line2$, Token$)
 DECLARE FUNCTION FileExists% (FileName$)
 DECLARE FUNCTION GetFWord$ (Line$)
 DECLARE FUNCTION GetInFName$ (CmdLine$, BaseName$)
 DECLARE FUNCTION IsLabel% (Label$, CrntLine$)
 DECLARE FUNCTION SrchKey% (FirstWord$, KeyIndex%)
 DECLARE SUB Usage ()

 TYPE DOSFindT                       '| The DTA structure for the
	Reserved    AS STRING * 21      '|  DOS FindFirst/FindNext
	DFAttr      AS STRING * 1       '|  functions
	DosTime     AS INTEGER
	DosDate     AS INTEGER
	FileSize    AS LONG
	FileName    AS STRING * 13
 END TYPE

 CONST CMNTLDRLEN = 40
 CONST TABSIZE = 4
 CONST TBLSIZE = 21
 CONST INDENT = 1
 CONST NOCHG = 0
 CONST OUTDENT = -1
 CONST OUTDENT1 = -2

 CONST FALSE = 0
 CONST TRUE = -1

 COMMON SHARED DblQut$, SngQut$, UndScr$

 DIM SHARED KeyWTbl$(TBLSIZE)

 DblQut$ = CHR$(34)
 SngQut$ = CHR$(39)
 UndScr$ = CHR$(95)

 CmdLine$ = RTRIM$(COMMAND$)         '| Get the command line.
							  '| Ensure filespec is valid.
 InFName$ = GetInFName$(CmdLine$, BaseName$)

 IF (LEN(InFName$)) THEN
	OutFName$ = BaseName$ + ".tid"
 ELSE
	END
 END IF

 FOR i% = 1 TO TBLSIZE
	READ KeyWTbl$(i)
 NEXT i%
 InFile% = FREEFILE
 OPEN InFName$ FOR INPUT AS #InFile%
 OutFile% = FREEFILE
 OPEN OutFName$ FOR OUTPUT AS #OutFile%

 IndLvl% = 0
 LnCtr% = 1
 iLblCtr = 0
 DO
	LINE INPUT #InFile%, InpLine$   '| Get a line from input file
	LOCATE , 1
	PRINT SPACE$(79);
	LOCATE , 1
	PRINT "Reading Line #"; LnCtr%; '| Update onscreen line cntr

	IF (LEFT$(InpLine$, 1) = SngQut$) THEN
							  '| If the line is a comment
							  '|  that starts in column 1,
	    PRINT #OutFile%, InpLine$   '|  we'll pass it thru as is
	ELSE
							  '| Process comments, if any
	    CALL BrkAtTok(InpLine$, CmntLine$, "'")
	    IF (LEN(CmntLine$)) THEN
		   IF (LEFT$(CmntLine$, 1) = "|") THEN
			  CmntLine$ = "'" + CmntLine$
		   ELSE
			  CmntLine$ = "'| " + CmntLine$
		   END IF
	    END IF
	    IF (LEN(InpLine$) = 0) THEN '| If the line doesn't have
							  '|  any code...
		   IF (LEN(CmntLine$)) THEN
							  '| ... only comments....
			  CmntLine$ = SPACE$(CMNTLDRLEN) + CmntLine$
			  PRINT #OutFile%, CmntLine$
		   ELSE                    '| ... or a blank line.
			  PRINT #OutFile%, ""
		   END IF
	    ELSE
		   IF (IsLabel%(Label$, InpLine$)) THEN
			  IF (LEN(CmntLine$)) THEN
				 Label$ = Label$ + SPACE$(CMNTLDRLEN - LEN(Label$)) + CmntLine$
				 CmntLine$ = ""
			  END IF
			  PRINT #OutFile%, Label$
			  Label$ = ""
		   END IF
		   DO WHILE (LEN(InpLine$))
			  CrntLine$ = InpLine$
			  CALL BrkAtTok(CrntLine$, InpLine$, ":")
							  '| Get the first word on the
							  '|  line
			  FirstWord$ = GetFWord$(CrntLine$)
			  IF (LEN(FirstWord$)) THEN
				 '| If it's one of our keywords for indention,
				 '|  determine what we want to do. (indent,
				 '|  outdent, outdent just this line, or
				 '|  nothing.)
				 Action% = SrchKey%(FirstWord$, KeyIndex%)
			  ELSE
				 Action% = NOCHG
			  END IF

			  SELECT CASE (Action%)
							  '| Don't change the line,
			  CASE NOCHG          '|  except for indentation
							  '|  to the current level
				 LdgSpcs$ = SPACE$(IndLvl% * TABSIZE)

							  '| Print this line at the
			  CASE INDENT         '|  current indent level,
							  '|  and increment the level
				 LdgSpcs$ = SPACE$(IndLvl% * TABSIZE)
				 IF (KeyIndex% = 5) THEN
							  '| If it's a single line "IF"
							  '|  statement, don't change
							  '|  indent level.
					IF ((RIGHT$(CrntLine$, 4) = "THEN") OR (RIGHT$(CrntLine$, 1) = UndScr$)) THEN
					    IndLvl% = IndLvl% + 1
					ELSE
					    IF (LEN(InpLine$)) THEN
						   TmpInpLine$ = InpLine$
						   CALL BrkAtTok(CrntLine$, InpLine$, "THEN")
						   CrntLine$ = CrntLine$ + " THEN"
						   CALL BrkAtTok(InpLine$, ElseLine$, "ELSE")
						   IF (LEN(ElseLine$)) THEN
							  InpLine$ = InpLine$ + ": ELSE :" + ElseLine$
						   END IF
						   InpLine$ = InpLine$ + " : " + TmpInpLine$ + " : END IF"
						   IndLvl% = IndLvl% + 1
					    END IF
					END IF
				 ELSE
					IndLvl% = IndLvl% + 1
				 END IF

			  CASE OUTDENT        '| Decrement the ind. level
							  '|  and print this line
				 IF (IndLvl%) THEN IndLvl% = IndLvl% - 1
				 LdgSpcs$ = SPACE$(IndLvl% * TABSIZE)

							  '| Print this line at an
							  '|  indentation one level
							  '|  less than the current
			  CASE OUTDENT1       '|  one, but don't adjust
							  '|  the level.
				 LdgSpcs$ = SPACE$((IndLvl% - 1) * TABSIZE)

			  END SELECT
							  '| Add the correct # of
							  '|  spaces to line and...
			  CrntLine$ = LdgSpcs$ + CrntLine$
							  '| ...print it.
			  IF (LEN(CmntLine$)) THEN
				 IF (LEN(CrntLine$) >= CMNTLDRLEN) THEN
					PRINT #OutFile%, SPACE$(CMNTLDRLEN); CmntLine$
				 ELSE
					CrntLine$ = CrntLine$ + SPACE$(CMNTLDRLEN - LEN(CrntLine$)) + CmntLine$
				 END IF
				 CmntLine$ = ""
			  END IF
			  PRINT #OutFile%, CrntLine$
		   LOOP
	    END IF
	END IF
	LnCtr% = LnCtr% + 1

 LOOP UNTIL (EOF(InFile%))

 CLOSE #InFile%                      '| Close the input and
 CLOSE #OutFile%                     '|  output files

 OldFName$ = BaseName$ + ".bid"
 IF (FileExists%(OldFName$)) THEN KILL OldFName$
 NAME InFName$ AS OldFName$
 NAME OutFName$ AS InFName$

 END

 DATA BEGIN, DO, FOR, FUNCTION, IF, STATIC FUNCTION, STATIC SUB
 DATA SUB, WHILE, SELECT
 DATA CASE, CASE ELSE, ELSE, ELSEIF
 DATA END FUNCTION, END IF, END SUB, LOOP, NEXT, WEND, END SELECT

 ' -------------------------- BrkAtTok --------------------------
 '|  This subroutine breaks the input line at the first          |
 '|      occurence of the given token that is not embedded in a  |
 '|      quoted string.                                          |
 ' --------------------------------------------------------------
 SUB BrkAtTok (Line1$, Line2$, Token$)

	TokPtr% = INSTR(Line1$, Token$)
	IF (TokPtr%) THEN
	    QuotPtr% = INSTR(Line1$, DblQut$)
	    IF ((QuotPtr%) AND (QuotPtr% < TokPtr%)) THEN
		   Done% = FALSE
		   InQut% = TRUE

		   DO
			  QuotPtr% = INSTR(QuotPtr% + 1, Line1$, DblQut$)
			  IF ((QuotPtr% > TokPtr%) AND (NOT InQut%)) THEN
				 QuotPtr% = 0
				 Done% = TRUE
			  ELSEIF (QuotPtr% > TokPtr%) THEN
				 TokPtr% = INSTR(QuotPtr% + 1, Line1$, Token$)
				 IF (TokPtr% = 0) THEN
					Done% = TRUE
					QuotPtr% = 0
				 END IF
			  END IF
			  IF (QuotPtr%) THEN
				 InQut% = NOT InQut%
			  ELSE
				 Done% = TRUE
			  END IF
		   LOOP UNTIL Done%
		   IF (InQut% OR (TokPtr% = 0)) THEN
			  Line1$ = LTRIM$(RTRIM$(Line1$))
			  Line2$ = ""
		   ELSE
			  Line2$ = LTRIM$(RTRIM$(MID$(Line1$, TokPtr% + LEN(Token$))))
			  Line1$ = LTRIM$(RTRIM$(LEFT$(Line1$, TokPtr% - 1)))
		   END IF
	    ELSE
		   Line2$ = LTRIM$(RTRIM$(MID$(Line1$, TokPtr% + LEN(Token$))))
		   Line1$ = LTRIM$(RTRIM$(LEFT$(Line1$, TokPtr% - 1)))
	    END IF
	ELSE                            '| No tokens on this line
	    Line1$ = LTRIM$(RTRIM$(Line1$))
	    Line2$ = ""
	END IF

 END SUB

 ' ------------------------ FileExists% -------------------------
 '|  This function checks to see if a file of the given name     |
 '|      exists. It returns TRUE (-1) if it does, FALSE (0) if   |
 '|      not.                                                    |
 ' --------------------------------------------------------------
 FUNCTION FileExists% (FileName$)

	DIM RegsX AS RegTypeX
	DIM DTA AS DOSFindT
	DIM FindFileBuff AS STRING * 64 '| Buffer to hold file path


	Null$ = CHR$(0)
	RegsX.ax = &H2F00               '| Get the old DTA address
	CALL INTERRUPTX(&H21, RegsX, RegsX)

	OldDTASeg% = RegsX.es           '| Save it to restore later
	OldDTAOff% = RegsX.bx

	RegsX.ax = &H1A00               '| Set our DTA as the crnt
	RegsX.ds = VARSEG(DTA)          '|   one
	RegsX.dx = VARPTR(DTA)
	CALL INTERRUPTX(&H21, RegsX, RegsX)

							  '| Load our current filename
							  '|  into the buffer
	FindFileBuff = FileName$ + Null$
	RegsX.ax = &H4E00
	RegsX.cx = 39                   '| Attribute for 'normal'
	RegsX.ds = VARSEG(FindFileBuff) '|  files
	RegsX.dx = VARPTR(FindFileBuff)
							  '| Call DOS findfirst func.
	CALL INTERRUPTX(&H21, RegsX, RegsX)
	IF (RegsX.flags AND 1) THEN
	    FileExists% = FALSE         '| It's not there
	ELSE
	    FileExists% = TRUE          '| ... or maybe it is.
	END IF

	RegsX.ax = &H1A00               '| Restore the original DTA
	RegsX.ds = OldDTASeg%
	RegsX.dx = OldDTAOff%
	CALL INTERRUPTX(&H21, RegsX, RegsX)

 END FUNCTION

 ' ------------------------ GetFWord$ ---------------------------
 '|  This function gets the first word on the line.              |
 ' --------------------------------------------------------------
 FUNCTION GetFWord$ (Line$)

	TestStr$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ._"
	TmpLine$ = UCASE$(Line$)
	StrLen% = LEN(TmpLine$)

	Done% = FALSE
	CrntPtr% = 1
	DO
	    IF (INSTR(TestStr$, MID$(TmpLine$, CrntPtr%, 1)) = 0) THEN
		   Done% = TRUE
	    END IF
	    IF (NOT Done%) THEN CrntPtr% = CrntPtr% + 1
	LOOP UNTIL (Done% OR (CrntPtr% > StrLen%))
	Word1$ = LEFT$(TmpLine$, CrntPtr% - 1)
	IF ((Word1$ = "END") AND (LEN(TmpLine$) > 3)) THEN
	    TmpLine$ = LTRIM$(RTRIM$(MID$(TmpLine$, CrntPtr%)))
	    Word2$ = GetFWord$(TmpLine$)
	    IF ((Word2$ = "FUNCTION") OR (Word2$ = "IF") OR (Word2$ = "SUB") OR (Word2$ = "SELECT")) THEN
		   Word1$ = Word1$ + " " + Word2$
	    END IF
	ELSEIF ((Word1$ = "STATIC") AND (LEN(TmpLine$) > 6)) THEN
	    TmpLine$ = MID$(TmpLine$, CrntPtr%)
	    Word2$ = GetFWord$(TmpLine$)
	    IF ((Word2$ = "FUNCTION") OR (Word2$ = "SUB")) THEN
		   Word1$ = Word1$ + " " + Word2$
	    END IF
	END IF
	GetFWord$ = Word1$

 END FUNCTION

 ' ---------------------- GetInFName$ ---------------------------
 '|  This function validates the command line entry as a good    |
 '|      filename.                                               |
 ' --------------------------------------------------------------
 FUNCTION GetInFName$ (CmdLine$, BaseName$)

	IF (LEN(CmdLine$) = 0) THEN
	    CALL Usage
	    GetInFName$ = ""
	ELSE
	    IF (LEN(CmdLine$) > 4) THEN
		   DotPos% = INSTR(LEN(CmdLine$) - 4, CmdLine$, ".")
	    ELSE
		   DotPos% = INSTR(CmdLine$, ".")
	    END IF
	    IF (DotPos%) THEN
		   BaseName$ = LEFT$(CmdLine$, DotPos% - 1)
	    ELSE
		   BaseName$ = CmdLine$
	    END IF
	    IF (FileExists%(CmdLine$)) THEN
		   GetInFName$ = CmdLine$
	    ELSE
		   TryFName$ = BaseName$ + ".bas"
		   IF (FileExists%(TryFName$)) THEN
			  GetInFName$ = TryFName$
		   ELSE
			  CALL Usage
			  GetInFName$ = ""
		   END IF
	    END IF
	END IF

 END FUNCTION

 ' ----------------------- IsLabel% -----------------------------
 '|  This function determines whether or not the current line is |
 '|      a label.                                                |
 ' --------------------------------------------------------------
 FUNCTION IsLabel% (Label$, CrntLine$)

	ItIs% = FALSE
	TmpStr$ = UCASE$(CrntLine$)
	TestStr$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ01234567890._"
	FOR i% = 1 TO LEN(CrntLine$)
	    IF (INSTR(TestStr$, MID$(TmpStr$, i%, 1)) = 0) THEN
		   IF (MID$(TmpStr$, i%, 1) = ":") THEN
			  ItIs% = TRUE
			  Label$ = LEFT$(TmpStr$, i%)
			  IF (LEN(CrntLine$) > i%) THEN
				 CrntLine$ = LTRIM$(RTRIM$(MID$(CrntLine$, i% + 1)))
			  ELSE
				 CrntLine$ = ""
			  END IF
		   ELSE
			  ItIs% = FALSE
		   END IF
		   EXIT FOR
	    END IF
	NEXT i%
	IsLabel% = ItIs%

 END FUNCTION

 ' ----------------------- SrchKey% -----------------------------
 '|  This function searches the keyword table for a match.  If   |
 '|      it finds one, it determines what action it should take. |
 ' --------------------------------------------------------------
 FUNCTION SrchKey% (FirstWord$, KeyIndex%)

	Done% = FALSE
	KeyIndex% = 0
	DO
	    KeyIndex% = KeyIndex% + 1
	    IF (KeyWTbl$(KeyIndex%) = FirstWord$) THEN
		   Done% = TRUE
		   IF (KeyIndex% < 11) THEN
			  SrchKey% = INDENT
		   ELSEIF (KeyIndex% < 15) THEN
			  SrchKey% = OUTDENT1
		   ELSE
			  SrchKey% = OUTDENT
		   END IF
	    END IF
	LOOP UNTIL ((Done%) OR (KeyIndex% >= TBLSIZE))
	IF (NOT Done%) THEN
	    SrchKey% = NOCHG
	    KeyIndex% = 0
	END IF

 END FUNCTION

 ' -------------------------- Usage -----------------------------
 '|  This subroutine prints a 'usage' screen if the user doesn't |
 '|      enter the correct parameters on the commandline         |
 ' --------------------------------------------------------------
 SUB Usage

	CLS
	PRINT " -------------------------------------------- "
	PRINT "| Usage is: IND filename                     |"
	PRINT "|--------------------------------------------|"
	PRINT "|  Where filename is the name of the file    |"
	PRINT "|  on which you wish to perform indentation  |"
	PRINT "|  checking.                                 |"
	PRINT " -------------------------------------------- "
	BEEP

 END SUB