Formatter

 'Copyright 2011, Clyde Wilson 
 'Version 1.2 
 
 'Please run this code and change it if necessary. 
 'Let me know of any requests or changes and I'll 
 'incorporate them in the next version. 
 
 'Formatter runs in Liberty Basic or Just Basic 
 'I like to use the formatter when tokenized and executed from the run menu! 
 'In the Setup menu, choose Preferences and check Reload File On Activate 
 'to get the quickest feedback! 
 'The above is not necessary, just more fun... 
 'Be sure to save your code before running formatter 
 'otherwise you will lose any unsaved changes. 
 'Formatter indents code blocks and continuation lines and inserts blank lines 
 'around subs and functions. Blank lines inserted by the user are maintained. 
 
 
 nomainwin 
 dim strtBlock$(100) 
 dim endBlock$(100) 
 dim alignLeft$(100) 
 dim info$(10, 10) 'for file check 
 
 tabSize = 4 
 insLines = 1 'For Debug, set to 1 if blank lines are to be inserted 
 remExcess = 0 'For Debug, set to 1 if excess blank lines are to be removed 
 blankLine=1 
 
 on error goto [error] 
 gosub [fillArrays] 
 gosub [openFiles] 
 
 [loop] 
 do 
 if eof(#text) <> 0 then [quit] 
 line input #text, item$ 
 wrkLine$ = trim$(item$) 
 if remExcess = 0 then exit do 
 loop while len(wrkLine$) = 0 ' or (wrkLine$="'") (wrkLine$="'") 'to remove single quote lines. 
 firstWord$ = lower$( word$( wrkLine$, 1 )) 
 gosub [chkExepts] 
 gosub [chkKeys] 
 gosub [wrtLine] 
 goto [loop] 
 
 [quit] 
 close #text 
 close #newText 
 
 [contErr] 
 kill fName$ + " " - bkp.bas" bkp.bas" 
 name fName$ + ".bas" ".bas" as fName$ + " " - bkp.bas" bkp.bas" 
 name "formatterTempFile" "formatterTempFile" as fName$ + ".bas" ".bas" 
 notice "Finished" "Finished" 
 end 
 
 [error] 
 if Err = 0 then 
 open fName$ + " " - bkp.bas" bkp.bas" for output as #temp 
 close #temp 
 goto [contErr] 
 else 
 noteStg$ = "You "You have received error #"; #"; Err 
 notice "Error" "Error" + chr$(13) + noteStg$ + chr$(13) + Err$ + chr$(13) + fName$ 
 close #newText 
 kill "formatterTempFile" "formatterTempFile" 
 end 
 end if 
 
 [fillArrays] 
 counter = 1 
 do until choice$ = "end" "end" 
 read choice$ 
 if choice$ <> "end" "end" then 
 strtBlock$(counter) = choice$ 
 aryCtr = aryCtr + 1 
 counter = counter + 1 
 end if 
 loop 
 counter = 1 
 choice$ = "" "" 
 do until choice$ = "end" "end" 
 read choice$ 
 if choice$ <> "end" "end" then 
 endBlock$(counter) = choice$ 
 ary2Ctr = ary2Ctr + 1 
 counter = counter + 1 
 end if 
 loop 
 counter = 1 
 choice$ = "" "" 
 do until choice$ = "end" "end" 
 read choice$ 
 if choice$ <> "end" "end" then 
 alignLeft$(counter) = choice$ 
 ary3Ctr = ary3Ctr + 1 
 counter = counter + 1 
 end if 
 loop 
 return 
 
 [openFiles] 
 confirm "Have "Have you saved your current work?" work?" ; ans$ 
 if ans$="no" ans$="no" then 
 notice "Please "Please save your current work before proceding" proceding" 
 end 
 end if 
 files DefaultDir$, "formatterTempFile", "formatterTempFile", info$() 
 If val(info$(0, 0)) > 0 then 'the file exists 
 notice "Please "Please rename or delete formatterTempFile" formatterTempFile" 
 end 
 else 
 open "formatterTempFile" "formatterTempFile" for output as #newText 
 end if 
 prompt "Please "Please type a filename (without the extension)"; extension)"; fName$ 
 if fName$="" fName$="" then 
 notice "Program "Program Not Run - Please enter a filename" filename" 
 close #newText 
 kill "formatterTempFile" end end if if lower$(fName$)="untitled" "formatterTempFile" 
 end 
 end if 
 if lower$(fName$)="untitled" then 
 notice "Program "Program must be saved under another name before continuing" continuing" 
 close #newText 
 kill "formatterTempFile" "formatterTempFile" 
 end 
 end if 
 open fName$ + ".bas" ".bas" for input as #text 
 notice "Your "Your original file will be found at ";fName$ + " ";fName$ + " - bkp.bas" bkp.bas" 
 numTabs = 1 
 return 
 
 [chkExepts] 'Check exceptional cases 
 indentOk = 1 
 somethingHere = 0 
 wrkLineL$ = lower$( wrkLine$ ) 
 secondWord$ = word$( wrkLineL$, 2 ) 
 if firstWord$ = "end" "end" then firstWord$ = firstWord$ + " " " " + secondWord$ 
 if firstWord$ = "if" "if" then 
 thenPos = instr( wrkLineL$, " then ") " then ") 
 if thenPos <> 0 then 
 thenPos = thenPos + 6 
 for counter = thenPos to len( wrkLineL$ ) 
 if mid$( wrkLineL$, counter, 1 ) <> " " " " then 
 somethingHere = 1 
 exit for 
 end if 
 next 
 end if 
 if somethingHere then 
 if mid$(wrkLineL$, counter, 1) ="'" ="'" then 
 indentOk = 1 
 else 
 indentOk = 0 
 end if 
 end if 
 end if 
 return 
 
 [chkKeys] 
 indent = 0 
 outdent = 0 
 saveTabs = 0 
 for counter = 1 to aryCtr 
 if strtBlock$( counter ) = firstWord$ then 
 indent = 1 
 end if 
 next 
 for counter = 1 to ary2Ctr 
 if endBlock$( counter ) = firstWord$ then outdent = 1 
 next 
 for counter = 1 to ary3Ctr 
 if alignLeft$(counter) = firstWord$ then 
 if numTabs > 1 then saveTabs = numTabs - 1 
 numTabs = 0 
 indent = 1 
 end if 
 next 
 if insLines and needBlanks and blankLine=0 then 
 if len( wrkLine$)<>0 then print #newText, "" "" 
 needBlanks=0 
 blankLine=1 
 end if 
 needBlanks=0 
 if instr( firstWord$, "[" "[" ) = 1 then 
 if numTabs > 1 then saveTabs = numTabs - 1 
 numTabs = 0 
 indent = 1 
 if insLines and blankLine=0 then 
 print #newText, "" "" 
 blankLine=1 
 end if 
 end if 
 if firstWord$="sub" firstWord$="sub" or firstWord$="function" firstWord$="function" then 
 if insLines and blankLine=0 then 
 print #newText, "" "" 
 blankLine=1 
 end if 
 end if 
 if insLines and (firstWord$="end sub" (firstWord$="end sub" or firstWord$="end function") firstWord$="end function") then needBlanks=1 
 return 
 
 [wrtLine] 
 if indent then 
 if firstWord$ = "case" "case" then 
 if notFirstCase then 
 numTabs = numTabs - 1 
 else 
 notFirstCase = 1 
 end if 
 end if 
 gosub [prtWithTabs] 
 if saveTabs > 0 then numTabs = saveTabs 
 if indentOk then numTabs = numTabs + 1 
 return 
 end if 
 if outdent then 
 numTabs = numTabs - 1 
 gosub [prtWithTabs] 
 if firstWord$ = "end select" "end select" then 
 numTabs = numTabs - 1 
 notFirstCase = 0 
 end if 
 if firstWord$ = "else" "else" then numTabs = numTabs + 1 
 return 
 end if 
 gosub [prtWithTabs] 
 gosub [checkCont] 
 return 
 
 [prtWithTabs] 
 ' if insLines=0 or len( wrkLine$)<>0 or remExcess=0 or blankLine=0 then 
 for counter = 1 to numTabs 
 print #newText, space$(tabSize); 
 next 
 print #newText, wrkLine$ 
 ' end if 
 gosub [checkBlank] 
 return 
 
 [checkCont] 
 indentOk = 1 
 somethingHere = 0 
 if instr(wrkLineL$, "_") "_") then 
 endPos = instr( wrkLineL$, "_") "_") 
 endPos = endPos + 1 
 for counter = endPos to len( wrkLineL$ ) 
 if mid$( wrkLineL$, counter, 1 ) <> " " " " then 
 somethingHere = 1 
 exit for 
 end if 
 next 
 if somethingHere then 
 if mid$(wrkLineL$, counter, 1) ="'" ="'" then 
 indentOk = 1 
 else 
 indentOk = 0 
 end if 
 end if 
 end if 
 if instr(wrkLineL$, "_") "_") then 
 if indentOk then 
 if firstCont = 0 then 
 firstCont = 1 
 numTabs = numTabs + 1 
 end if 
 end if 
 else 
 if firstCont then 
 numTabs = numTabs - 1 
 firstCont = 0 
 end if 
 end if 
 return 
 
 [checkBlank] 
 if insLines and len( wrkLine$) = 0 then 
 blankLine=1 
 else 
 blankLine=0 
 end if 
 return 
 
 'Data to start a block 
 data "case" data "do" data "for" data "function" data "if" data "select" data "sub" data "while" data "end" "case" 
 data "do" 
 data "for" 
 data "function" 
 data "if" 
 data "select" 
 data "sub" 
 data "while" 
 data "end" 
 
 'Data to end a block 
 data "else" data "end function" data "end if" data "end select" data "end sub" data "loop" data "next" data "wend" data "end" "else" 
 data "end function" 
 data "end if" 
 data "end select" 
 data "end sub" 
 data "loop" 
 data "next" 
 data "wend" 
 data "end" 
 
 'Data to align to left edge 
 data "end function" data "end sub" data "function" data "sub" data "end" "end function" 
 data "end sub" 
 data "function" 
 data "sub" 
 data "end"