'=========================================================================== ' Subject: PB SOURCE CODE BEAUTIFIER Date: 12/94 (00:00) ' Author: Alexander Podkolzin Code: PB ' Origin: app@sbank.e-burg.su Packet: PB.ABC '=========================================================================== ' First of all, excuse me for my English. This program is a greate deal an ' exercise in English language, not in BASIC. It's a pity, but English for ' me is "dead" language, as Latin for instance. Just image: I'v never talked ' with any alive English speaking person... ' I'v been using this program from the beginning of 1995, sucáessfully :) ' Last revision: December,1994. '--------------------------------------------------------------------------- ' PowerBASIC 3.0C ' Demonstrates some features of the best BASIC of the 20th century. ' Author: Alexander Podkolzin, ' app@nw.sbank.e-burg.su ' Choose an author as you choose a friend! ' USERS! THERE IS NO ANY WARRANTY FOR YOU, ' USE IT ON YOUR OWN RISK ! ' This program is "FREEWARE" ' Fortune favours the brave ! ' Any suggestions are welcomed! '--------------------------------------------------------------------------- $lib all off $optimize speed $compile exe '--------------------------------------------------------------------------- ' This program does not change your initial code. It creates a new file ' to look through (with extension ".app") and has to be run with filename ' you want to modify with any combination of following keys ' ( default is "/b/c/d" ): ' ' /b..............beautifying (attempt of) ' /c....................uppercase keywords ' /d..................delete empty strings ' /l....................lowercase keywords ' /m...........minimize blanks in comments ' /n.....................strip all indents ' /s....................strip all comments. ' ' You can incert all these keys into the first line of your program. In ' this case first line has to contain "$PBB", followed by those keys ' and "'" in the first position, e.g.: "' $PBB /b/c/d". ' ' P.S......Well, you know, not only programming but simple writing ' also is a great deal of art. So do not hope that the ' program will make all job for you. Only 80%! If you want ' a thing well done, do it yourself. ' ' P.P.S... Beauty is in the eye of the beer holder... ' ' P.P.P.S..Remember: Every last error in my program really is the last, ' but one. :) '--------------------------------------------------------------------------- ' This BEAUTIFIER: (Of course my own programming style caused its features) ' ' - does not change your initial file; ' - does not change strings inside block $IF 0 ... $ENDIF; ' - does not separates long statements with "_", as nobody can foresee ' all possible cases, even Me :-) . I denyed separation as it's ' a 5% of work, but to program it I have to do 3 times more code! ' - does not devide strings such as "IF ... THEN ... : ... : ..." ' - does (about comments): ' = if nitial comment begins from 1st position it remains there, ' in all other cases comment is to be placed from position ' of comment (%commentpos); ' = if comment can't be placed from %commentpos (statement is ' longer), then it's to be placed from his statement`s position; ' ' Demands to initial code: ( Yes, there are many things depending ' on your style ) ' ' 1. The number of quotational marks in a string have to be even. ' 2. Syntax of initial text has to submit to PowerBASIC rules, as some ' BASICs have different key words (for example "END IF" and "ENDIF"). ' 3. ...? ' ' Play with the program and find what key (combination) you prefer. ' You can enhance the program easyly, as it's written in clear manner. ' For more readability of the code I separate logical conditions in basic ' places. ' Perhaps,there is a some kind of superfluousness in the program, sorry. ' I wish you an excelent beautifying with this program! '--------------------------------------------------------------------------- defint a-z '--------------------------------------------------------------------------- ' Tastes differ... %indent = 2 ' unconditional indent %delta = 3 ' indent for structured statements %indntincr = 2 ' indent increment %maxlen = 77 ' maximum length of line %maxelem = 10 ' maximum number of string constants in a line %commentpos = 41 ' from this position comment begins, ' if a string is longer then %commentpos, ' comment is being placed before the string %FALSE = 0 %TRUE = NOT %FALSE SkipBeforeLabel = %TRUE ' if you need blank lines before label '--------------------------------------------------------------------------- if command$="" then print "Using: /b/c/d/l/m/n/s" print "/b - beautifying," print "/c - uppercase keywords," print "/d - delete empty strings," print "/l - lowercase keywords," print "/m - shorten blanks in comments," print "/n - strip indents," print "/s - strip comments." end end if if %delta<>0 then ' It is a good horse that never stumbles. del$ = space$(%delta) else del$ = "" end if if %indntincr<>0 then indinc$ = space$(%indntincr) else indinc$ = "" end if if %indent<>0 then ind$ = space$( %indent) ind0$=ind$ else ind$ = "" end if '--------------------------------------------------------------------------- delempty = %FALSE ' Tell that to the marines... needupper = %FALSE needlower = %FALSE minblanks = %FALSE needbeauty = %FALSE stripindents = %FALSE stripcomments = %FALSE task$=combme$(lcase$(command$)) n=instr(task$,".") if n<>0 then filename$ = left$(task$,n-1) extension$ = mid$(task$,n,4) else filename$ = task$ extension$ = ".bas" end if if len(filename$)=0 then print "Bad filename!" end end if if extension$ = ".app" then print "Extension .APP is not allowed!" ' so Let well alone... end end if '--------------------------------------------------------------------------- ' Why doesn't DOS ever say "EXCELLENT command or filename!" '--------------------------------------------------------------------------- if instr(task$,"/") = 0 then ' default combination of keys sourcefile = freefile open filename$+extension$ for input as sourcefile line input #sourcefile,s$ s$=lcase$(s$) close sourcefile if instr(s$,"$pbb ")<>0 and instr(s$,"/")<>0 then task$=task$+mid$(s$,instr(s$,"/")) else task$=task$+"/b/c/d" end if end if if instr(task$,"/b") then ' beauty indents task$=remove$(task$,"/b") needbeauty = %TRUE end if if instr(task$,"/c") then ' uppercase reserved words task$=remove$(task$,"/c") needupper = %TRUE end if if instr(task$,"/l") then ' lowercase reserved words task$=remove$(task$,"/l") needlower = %TRUE end if if instr(task$,"/d") then ' delete empty strings task$=remove$(task$,"/d") delempty = %TRUE end if if instr(task$,"/m") then ' minimize blanks in comments task$=remove$(task$,"/m") minblanks = %TRUE end if if instr(task$,"/n") then ' remove all indents task$=remove$(task$,"/n") stripindents = %TRUE end if if instr(task$,"/s") then ' remove all comments task$=remove$(task$,"/s") stripcomments= %TRUE end if '--------------------------------------------------------------------------- ' Here we are preparing the ' The more haste, the less speed... ' string of reserved words. ' ' String, because INSTR is ' ' faster then ARRAY SCAN. ' Buy a Pentium so you can reboot faster... ' dim mi%(%maxelem,2) while s$<>"Goodbye!" read s$ reswd$=reswd$+s$ wend '--------------------------------------------------------------------------- ' Come on! Well begun is half done... t#=timer ' We shell see how the cat jump... sourcefile = freefile open filename$+extension$ for input as sourcefile destfile = freefile open filename$+".app" for output as destfile nline=0 s$="' Date of the last formatting = " + DATE$ + " " + TIME$ PRINT #destfile,s$ DO ' begin of the main loop if eof(sourcefile) then exit loop line input #sourcefile,s$ incr nline if s$ = "" then ' do we need empty strings ? if delempty then iterate ' No? we don't. else gosub printme ' Yes, of course. end if end if z$=lcase$(left$(ltrim$(s$),6)) if instr(z$, "$if 0")<>0 then skipblock = %TRUE gosub printme iterate end if if instr(z$,"$endif")<>0 then skipblock = %FALSE gosub printme iterate end if if skipblock then ' All lines inside of $IF 0 ... $ENDIF gosub printme ' we have not to change... (My opinion). iterate end if ' And skip ASM-statements: if left$(z$,1)="!" or left$(z$,4)="asm " then gosub printme iterate end if if needbeauty or stripindents then oldindent$="" else oldindent$=leadingblanks$(s$) end if s$=removerubbish$(s$) '--------------------------------------------------------------------------- call separate(s$,lin$,comment$,cp) ' To pick the plums out of the pudding if minblanks then comment$=combme$(comment$) end if if ltrim$(lin$)="" then nostmnt = %TRUE else nostmnt = %FALSE end if '--------------------------------------------------------------------------- if nquo%(lin$,mi%()) then ' makes info about string constants. beep print "Error (ODD QUOTE). Correct this error in line #"; nline print "and restart program. Write down the line # and press a key." z$=input$(1) end if '--------------------------------------------------------------------------- ' We have to fill all blanks with any special simbol for not to harm the ' string constants for i=1 to %maxelem if mi%(i,1)=0 then exit for for k=mi%(i,1) to mi%(i,2) if mid$(lin$,k,1)=" " then mid$(lin$,k,1)=chr$(5) end if next k next i '--------------------------------------------------------------------------- lin$=combme$(lin$) ' It's a string cpy$=lin$ ' It's its copy statement$="" '--------------------------------------------------------------------------- ' In this loop we sculpture ' What's done cannot be undone... ' a string word by word ' do while lin$<>"" st$=getword$(lin$,del$) z$=st$ z$=ucase$(z$) if needupper and isinlist(reswd$," "+z$+" ") then st$=ucase$(st$) if needlower and isinlist(reswd$," "+z$+" ") then st$=lcase$(st$) statement$=statement$+st$+del$ loop '--------------------------------------------------------------------------- statement$ = combme$(statement$) replace chr$(5) with " " in statement$ ' to restore our blanks zorro$ = lcase$(statement$) '-------------------------------------------------------------------------- ' Here we are checking the `ends` of sructured statements; ' `ends` before `begins`, as shift for begin has to be one string later. ' For more readability of the program I separate conditions: ' a = ( left$(zorro$, 6) = "end if" ) b = ( left$(zorro$, 4) = "wend" ) c = ( left$(zorro$,10) = "end select" ) d = ( left$(zorro$, 4) = "loop" ) e = ( left$(zorro$, 4) = "next" ) f = ( left$(zorro$, 8) = "end type" ) g = ( left$(zorro$,12) = "end function" ) h = ( left$(zorro$, 7) = "end sub" ) if a OR b OR c OR d OR e OR f OR g OR h then needshift=%FALSE if c then if len(addshift$)>%delta then addshift$=space$(len(addshift$)-%delta) end if end if if len(addshift$)>%delta then addshift$ = space$(len(addshift$) - %delta) else addshift$="" end if end if '-------------------------------------------------------------------------- fullshift$=oldindent$+ind$+addshift$ if not needbeauty then statement$ = oldindent$+statement$ else statement$ = fullshift$+statement$ end if if stripcomments then comment$ = "" statement$=oldindent$+statement$ end if z$=ltrim$(statement$) if stripindents then statement$ = z$ ' -------------------------------------------------------------------------- ' And now exceptions: The exception proves the rule... ' a = (not stripindents) and needbeauty b = (left$(lcase$(z$),4) = "else") c = (left$(lcase$(z$),4) = "case") if (a and b) or (c) and (not stripindents) then statement$ = right$(rtrim$(statement$),len(statement$)-%delta-1) end if '-------------------------------------------------------------------------- ' Well, at last we'v reached our goal ! GOSUB printstring '-------------------------------------------------------------------------- fullshift$="" '-------------------------------------------------------------------------- ' Here we are checking the `begins` of structured statements a = (left$(zorro$, 3) = "if ") and (right$(zorro$,5)="then ") b = (left$(zorro$, 6) = "while ") and (instr(zorro$,"wend")=0) c = (left$(zorro$,12) = "select case ") d = (left$(zorro$, 3) = "do ") and (instr(zorro$,"loop")=0) e = (left$(zorro$, 4) = "for ") and (instr(zorro$,"next")=0) f = (left$(zorro$, 5) = "type ") g = (left$(zorro$, 9) = "function ") h = (left$(zorro$, 4) = "sub " ) i = (left$(zorro$, 3) = "if ") and (right$(zorro$,2)="_ ") if a OR b OR c OR d OR e OR f OR g OR h OR i then needshift=%TRUE addshift$=space$(len(addshift$) + %delta) if c then addshift$=addshift$+space$(%delta) end if end if '-------------------------------------------------------------------------- LOOP ' end of the main loop close sourcefile close destfile print print print "Your COMMAND$ was: ";command$ print "Total lines = "; nline print "Total time = "; using$("####.###",timer-t#);" s." print "THANK YOU, Bye-Bye !" ' '-------------------------------------------------------------------------- ' Empty vessels make the greatest... ' sound 524,0.5 : delay 0.10 ' C sound 660,0.5 : delay 0.10 ' E sound 784,0.5 : delay 0.10 ' G sound 660,0.5 : delay 0.20 ' E sound 524,0.2 : delay 0.10 ' C sound 494,0.5 : delay 0.20 ' H sound 880,0.5 : delay 0.10 ' A sound 880,1.0 : delay 1.00 ' A '-------------------------------------------------------------------------- END ' Bye-Bye ! Out of sight, out of mind... '-------------------------------------------------------------------------- printstring: statement$ = rtrim$(statement$) cpy$=rtrim$(cpy$) '--------------------------------------------------------------------------- a = ( right$(cpy$,1) = ":" ) b = ( instr(cpy$, any " ()<>=\;+-,/*"+chr$(34) ) = 0) if a and b then ' In my humble opinion, labels statement$=ltrim$(statement$) ' should be at the left margin. if SkipBeforeLabel then s$="" gosub printme end if end if '--------------------------------------------------------------------------- comment$ = ltrim$(rtrim$(comment$)) if nostmnt then if cp=1 then s$=comment$ else s$=space$(cp)+comment$ end if if s$<>"" and not stripcomments then gosub printme end if return end if '--------------------------------------------------------------------------- n = len(statement$) if n < %commentpos then ' statement$ is not too long if comment$<>"" then d$=space$(%commentpos-n-1) else d$="" end if s$=statement$+d$+comment$ gosub printme else ' statement$ is too long if comment$<>"" then d$=leadingblanks$(statement$) s$=d$+ltrim$(comment$) gosub printme end if s$=statement$ gosub printme end if return '--------------------------------------------------------------------------- printme: PRINT s$ PRINT #destfile,s$ return '-------------------------------------------------------------------------- FUNCTION isquoted%(ss$,n%,c$) ' checks whether Nth simbol is quoted by c$ s$ = left$(ss$,n%-1) isquoted% = (TALLY(s$,c$) mod 2) * (instr(n%+1,ss$,c$)<>0) END FUNCTION '-------------------------------------------------------------------------- FUNCTION removerubbish$(s$) for i%=1 to len(s$) k%=asc(mid$(s$,i%,1)) if k%<32 then mid$(s$,i%,1)=" " end if next i% removerubbish$=s$ END FUNCTION '-------------------------------------------------------------------------- FUNCTION nquo%(s$,mi%()) ' Function creates info about string constants in s$. ' mi%(i,1).....................contains begin position, ' mi%(i,2)..contains end position of I-string constant. ' Returns: ' 1..........if there are ODD number of '"' in string, ' 0..........if there are EVEN number of '"' in string. for k%=1 to %MAXELEM ' Cleaning mi%(k%,1)=0 mi%(k%,2)=0 next k% n% =len(s$) ' Little pitchers have long ears nquo%=0 if n%=0 then exit function c$=chr$(34) nq%=instr(s$,c$) ' Position of the quotational mark if nq%=0 then exit function k% = 1 nk% = 0 l% = 1 for i%=nq% to n% ' Here we are if mid$(s$,i%,1)=c$ then ' making our array k%=k% xor 1 mi%(l%,k%+1)=i% incr l%,k% incr nk% end if next i% nquo% = nk% mod 2 END FUNCTION '-------------------------------------------------------------------------- FUNCTION getword$(ss$,del$) ' Parser. Returns regular word - unit of text s$ = extract$(ss$, any " =()<>\;:+-,/*") getword$=s$ ss$ = ltrim$(ss$, s$) del$ = left$(ss$,1) ss$ = ltrim$(ss$) if left$(ss$,1)=del$ then ss$ = mid$(ss$,2,len(ss$)-1) END FUNCTION '-------------------------------------------------------------------------- FUNCTION IsInList%(RW$,s$) if instr(1,RW$,s$)<>0 then isinlist%= %TRUE else isinlist%= %FALSE end if END FUNCTION '-------------------------------------------------------------------------- FUNCTION LeadingBlanks$(ss$) s$=ltrim$(ss$) n%=len(ss$)-len(s$) if n%=0 then leadingblanks$="" else leadingblanks$=space$(n%) end if END FUNCTION '-------------------------------------------------------------------------- FUNCTION CombMe$(ss$) ss$=ltrim$(rtrim$(ss$)) do replace " " with " " in ss$ loop while instr(ss$," ") combme$=ss$+" " END FUNCTION '-------------------------------------------------------------------------- SUB Separate(s$,lin$,comment$,cp%) ' separates line and comment c$=chr$(39) ' cp% - comment position lin$ =s$ comment$="" cp%=0 z$=ucase$(s$)+" " m%=instr(z$,"REM ") if m%<>0 then mid$(s$,m%,4)=chr$(39,32,32,32) k%=instr(s$,c$) if k%<>0 then if isquoted(s$,k%,chr$(34))=0 then lin$ =rtrim$(left$(s$,k%-1)) comment$=right$(s$,len(s$)-k%+1) cp%=k% exit sub else exit sub end if end if END SUB '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ' ATTENTION! ' Every reserved word has to finish with " " (blank). ' The last word of the list has to be "Goodby!". ' If you want your own reserved words, which will be printed with caps or ' lowers, include them into this list! '___________________________________________________________________________ DATA "$ALIAS $CODE $COM $COM1 $COM2 $COMPILE $CPU $DEBUG $DIM $DYNAMIC " DATA "$ELSE $ENDIF $ERROR $EVENT $FLOAT $HUGE $IF $INCLUDE $INLINE $LIB " DATA "$LINK $OPTIMIZE $OPTION $SEGMENT $SOUND $STACK $STATIC $STRING ABS " DATA "ABSOLUTE ACCESS ALL AND ANY APPEND ARRAY AS ASC ASCEND ASCII ASM AT " DATA "ATN ATTRIB BASE BEEP BIN$ BINARY BIT BITS BLOAD BSAVE BYCOPY BYVAL " DATA "CALL CASE CBCD CBYT CDBL CDWD CEIL CEXT CFIX CLNG CHAIN CHDIR CHDRIVE " DATA "CHR$ CINT CIRCLE CLEAR CLNG CLOSE CLS CNTLBREAK COLLATE COLOR COM " DATA "COMMAND$ COMMON COS CQUD CSNG CSRLIN CURDIR$ CVB CVD CVE CVF CVI CVL " DATA "CVMD CVMS CVQ CVS CWRD DATA DATE$ DECLARE DECR DEF DEFBCD DEFDBL " DATA "DEFEXT DEFFIX DEFFLX DEFINT DEFLNG DEFQUD DEFSNG DEFSTR DELAY DELETE " DATA "DESCEND DIM DIR$ DO DRAW DYNAMIC ELSE ELSEIF EMS END ENDMEM ENVIRON " DATA "ENVIRON$ EOF EQV ERADR ERASE ERDEV ERDEV$ ERL ERR ERROR ERRTEST EXE " DATA "EXECUTE EXIT EXP EXP10 EXP2 EXTERNAL EXTRACT$ FAR FIELD FILEATTR " DATA "FILES FIX FIXDIGITS FLEXCHR$ FLUSH FN FOR FRAC FRE FREEFILE FROM " DATA "FUNCTION GET GETSTRLOC GET$ GOSUB GOTO HEX$ IF IMP IN INCR INKEY$ " DATA "INP INPUT INPUT$ INSERT INSTAT INSTR INT INTERRUPT IOCTL IOCTL$ " DATA "ISFALSE ISTRUE ITERATE KEY KILL LBOUND LCASE$ LEFT LEFT$ LEN LET " DATA "LINE LIST LOC LOCAL LOCATE LOCK LOF LOG LOG10 LOG2 LOOP LPOS LPRINT " DATA "LSET LTRIM$ MAP MAX MAX$ MAX% MEMPACK MEMSET MID$ MIN MIN$ MIN% MKDIR " DATA "MKB$ MKD$ MKDWD$ MKE$ MKF$ MKI$ MKL$ MKMD$ MKMS$ MKQ$ MKS$ MKWRD$ MOD " DATA "MTIMER MULTIPLEX NAME NEXT NOT OCT$ OFF ON OPEN OPTION OR OUT OUTPUT " DATA "PAINT PALETTE PEEK PEEK$ PEEKI PEEKL PEN PLAY PMAP POINT POKE POKE$ " DATA "POKEI POKEL POPUP POS PRESET PRINT PSET PUBLIC PUT PUT$ QUIET RANDOM " DATA "RANDOMIZE READ REDIM REG REM REMOVE$ REPEAT$ REPLACE RESET RESTORE " DATA "RESUME RETURN RIGHT RIGHT$ RMDIR RND ROTATE ROUND RSET RTRIM$ RUN " DATA "SAVE SCAN SCREEN SEEK SEG SELECT SETMEM SGN SHARED SHELL SHIFT " DATA "SIGNED SIN SLEEP SORT SOUND SPACE$ SPC SQR STATIC STEP STICK STOP TR$ " DATA "STRIG STRING$ STRPTR STRSEG STUFF SUB SWAP SYSTEM TAB TAGARRAY TALLY " DATA "TAN TEXT THEN TIME$ TIMER TO TROFF TRON TYPE UBOUND UCASE UCASE$ " DATA "UEVENT UNION UNLOCK UNTIL USING USING$ VAL VARPTR VARPTR$ VARSEG " DATA "VERIFY VIEW WAIT WEND WHILE WIDTH WINDOW WITH WRITE XOR " DATA "KYBD: SCRN: CONS: LPT1: LPT2: LPT3: COM1: COM2: COM3: COM4: " DATA "BYTE WORD INTEGER LONG DOUBLE STRING " DATA "Goodbye!" ' End of The Key Words List. '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ' Sorry, my English would even a cat laugh... ' See P.P.P.S.! '___________________________________________________________________________