Hallo all,
upper case keywords in a PB source file make a program better
readable, that's why PB Inc. added the utility PBSF.BAS to the
PB3.1 and PB3.2 distribution.
But this tool very unfortionately changes too much the
individual writing style of a programmer (by e.g. performing
brutal indentation, imbedding spaces etc.).
The following program only changes the key words but does NOT
change the length of the lines:
-=-=-=-=-=-=-=-=-=-=-=-=-=- cut -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'KW2UCASE.BAS - Key Words to Upper Case
'Changes PB Keywords to upper case notation, does NOT change indentation,
'does NOT add spaces! The individual style of source writing is retained.
'Derived from the PB3.2 distribution utility PBSF.BAS (does not need the
B!)
' Call from DOS as: KW2UCASE filename.ext
' KW2UCASE renames your source code file to filename.BAK, then reads that
' file and formats each line of code. To restore the original source code,
' just rename it back to it's original filename.
'public domain by:
' Andras Hoeffken 2:2480/13.34 @ fidonet, 130:1322/302 @ basnet/Germany
' email: ah@confusion.rmc.de
'Munich, 25 July 1996
$CPU 8086 ' program works on any CPU
$COMPILE EXE ' compile to an EXE
$STRING 32 ' set largest string size at 32k
$STACK 4096 ' use a 4k stack
$DYNAMIC ' all arrays will be dynamic by default
$OPTION CNTLBREAK OFF ' don't allow Ctrl-Break to exit program
$LIB ALL OFF ' turn off all unused libraries
$ERROR ALL ON ' turn on all error checking
DEFINT A-Z ' default all variables to integers for maximum
' speed and minimum size
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
SHARED KeywordCase, Cmds$
KeywordCase = 1 ' 1 = convert keywords to upper case
' 2 = convert keywords to lower case
Cmds$ = ""
' PowerBASIC 3.x metastatements:
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 SEGMENT"
Cmds$ = Cmds$ + " SOUND STACK STATIC STRING"
' PowerBASIC 3.x supported BASIC commands:
Cmds$ = Cmds$ + " ABS ABSOLUTE ACCESS ALIAS ALL AND ANY APPEND ARRAY"
Cmds$ = Cmds$ + " AS ASC ASCEND ASCII ASM AT ATN ATTRIB BASE BCD BEEP BIN$"
Cmds$ = Cmds$ + " BINARY BIT BITS BLOAD BSAVE BYTE BYVAL CALL CASE"
Cmds$ = Cmds$ + " CBCD CBYT CCUR CDBL CDWD CEIL"
Cmds$ = Cmds$ + " CEXT CFIX CHAIN CHDIR CHDRIVE CHR$"
Cmds$ = Cmds$ + " CINT CIRCLE CLEAR CLNG CLOSE CLS CODEPTR"
Cmds$ = Cmds$ + " CODESEG COLLATE COLOR COM COMMAND$ COMMON"
Cmds$ = Cmds$ + " COS CQUD CSNG CSRLIN"
Cmds$ = Cmds$ + " CURDIR$ CVB CVBYT CVD"
Cmds$ = Cmds$ + " CVDWD CVE CVF CVI CVL CVMD"
Cmds$ = Cmds$ + " CVMS CVQ CVS CVWRD CWRD"
Cmds$ = Cmds$ + " DATA DATE$ DECLARE DECR DEF DEFBCD DEFBYT DEFCUR DEFDBL"
Cmds$ = Cmds$ + " DEFDWD DEFEXT DEFFIX DEFFLX DEFINT DEFLNG DEFQUD DEFSNG"
Cmds$ = Cmds$ + " DEFSTR DEFWRD DELAY DELETE DESCEND"
Cmds$ = Cmds$ + " DIM DIR$ DO DOUBLE DRAW DWORD DYNAMIC ELSE ELSEIF EMS END"
Cmds$ = Cmds$ + " ENDMEM ENVIRON ENVIRON$ EOF EQV ERADR"
Cmds$ = Cmds$ + " ERASE ERDEV ERDEV$ ERL ERR ERROR ERRTEST EVENT EXE EXECUTE"
Cmds$ = Cmds$ + " EXIT EXP EXP10 EXP2 EXTERNAL EXTRACT"
Cmds$ = Cmds$ + " FAR FIELD FILEATTR FILES FIX"
Cmds$ = Cmds$ + " FIXDIGITS FLEXCHR$ FLUSH FN FOR FRAC FRE FREEFILE FROM"
Cmds$ = Cmds$ + " FUNCTION GET GET$ GO GOSUB GOTO HEX"
Cmds$ = Cmds$ + " IF IMP IN INCR INKEY$ INLINE INP INPUT INPUT$"
Cmds$ = Cmds$ + " INSERT INSTAT INSTR INT INTEGER INTERRUPT"
Cmds$ = Cmds$ + " IOCTL$ IS ISFALSE ISTRUE ITERATE KEY"
Cmds$ = Cmds$ + " KILL LCASE$ LEFT LEFT$ LEN"
Cmds$ = Cmds$ + " LET LINE LOC LOCAL LOCATE LOCK LOF"
Cmds$ = Cmds$ + " LOG LOG10 LOG2 LONG LOOP LPOS"
Cmds$ = Cmds$ + " LPRINT LSET LTRIM$ MAP MAX"
Cmds$ = Cmds$ + " MEMPACK MEMSET MID$"
Cmds$ = Cmds$ + " MIN MKB$ MKBYT$ MKD$"
Cmds$ = Cmds$ + " MKDIR MKDWD$ MKE$ MKF$ MKI$"
Cmds$ = Cmds$ + " MKL$ MKMD$ MKMS$ MKQ$"
Cmds$ = Cmds$ + " MKS$ MKWRD$ MOD"
Cmds$ = Cmds$ + " MTIMER MULTIPLEX NAME NEXT NOT OCT$ OFF"
Cmds$ = Cmds$ + " ON OPEN OPTION OR OUT PAINT PALETTE"
Cmds$ = Cmds$ + " PEEK PEEK$ PEEKI PEEKL PEN"
Cmds$ = Cmds$ + " PLAY PMAP POINT POKE POKE$ POKEI"
Cmds$ = Cmds$ + " POKEL POPUP POS PRESET PRINT PRIVATE PSET PTR PUBLIC"
Cmds$ = Cmds$ + " PUT QUIET RANDOM RANDOMIZE READ REDIM REG REM"
Cmds$ = Cmds$ + " REMOVE REPEAT REPLACE RESET RESTORE"
Cmds$ = Cmds$ + " RESUME RETURN RIGHT RIGHT$ RMDIR RND"
Cmds$ = Cmds$ + " ROTATE ROUND RSET RTRIM$ RUN "
Cmds$ = Cmds$ + " SAVE SCAN SCREEN SEEK"
Cmds$ = Cmds$ + " SEG SELECT SETMEM SGN SHARED"
Cmds$ = Cmds$ + " SHELL SHIFT SIN SINGLE SLEEP SORT SOUND"
Cmds$ = Cmds$ + " SPACE SPC SQR"
Cmds$ = Cmds$ + " STATIC STEP STICK STOP STR$ STRIG"
Cmds$ = Cmds$ + " STRING STRING$ STRPTR STRSEG"
Cmds$ = Cmds$ + " STUFF SUB SWAP SYSTEM TAB TAGARRAY TALLY TAN"
Cmds$ = Cmds$ + " THEN TIME$ TIMER TO TROFF TRON TYPE UBOUND"
Cmds$ = Cmds$ + " UCASE UCASE$ UEVENT UNION UNIT UNLOCK UNTIL"
Cmds$ = Cmds$ + " USING USING$ USR VAL VARPTR VARPTR"
Cmds$ = Cmds$ + " VARSEG VERIFY VIEW WAIT"
Cmds$ = Cmds$ + " WEND WHILE WIDTH WINDOW WITH WORD WRITE XOR"
' PowerBASIC 3.x special variables
Cmds$ = Cmds$ + " PBVBINBASE PBVCPU PBVCURSOR1 PBVCURSOR2 PBVCURSORVIS"
Cmds$ = Cmds$ + " PBVDEFSEG PBVERR PBVFIXDIGITS PBVFLEXCHR PBVHOST
PBVMINUSONE"
Cmds$ = Cmds$ + " PBVNPX PBVONE PBVREVISION PBVREVLTR PBVSCRNAPAGE
PBVSCRNBUFF"
Cmds$ = Cmds$ + " PBVSCRNCARD PBVSCRNCOLS PBVSCRNMODE PBVSCRNPXLATTR"
Cmds$ = Cmds$ + " PBVSCRNROWS PBVSCRNTXTATTR PBVSCRNVPAGE PBVSWITCH"
Cmds$ = Cmds$ + " PBVUSERAREA PBVUSINGCHRS PBVVTXTX1 PBVVTXTX2 PBVVTXTY1"
Cmds$ = Cmds$ + " PBVVTXTY2 PBVZERO"
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
ON ERROR GOTO ErrorHandler
CLS
PRINT "Changing PowerBASIC Keywords to Upper Case Notation"
PRINT
OutFile$ = UCASE$(COMMAND$)
'*** Check for filename on command line ***
IF LEN(OutFile$) = 0 THEN
PRINT "Usage: KW2UCASE filename.ext"
END 1
END IF
'*** Assume a .BAS extension ***
IF INSTR(OutFile$, ".") = 0 THEN
OutFile$ = OutFile$ + ".BAS"
END IF
'*** Backup original file ***
Infile$ = LEFT$(Outfile$, LEN(outfile$)-1)+"K" 'xxx.BAK
ON ERROR RESUME NEXT 'if there is not yet a .BAK
KILL infile$ 'delete old Backup file
ON ERROR GOTO ErrorHandler
NAME outfile$ AS infile$ 'new Backup file
'*** Open file and process it ***
OPEN "I", 1, InFile$
OPEN "O", 2, OutFile$
Length& = LOF(1)
WHILE NOT EOF(1)
LINE INPUT# 1, Tmp$
BytesRead& = BytesRead& + LEN(Tmp$) + 2
Percent = (BytesRead& * 100) \ Length&
LOCATE ,1
PRINT STR$(Percent);"% Done";
Tmp1$=Tmp$ 'remember old line
Tmp$ = FormatLine$(Tmp$) 'new line with upper case keywords
IF LEN(tmp1$)LEN(tmp$) THEN
BEEP: CLOSE 1
CLOSE 2
PRINT:PRINT "ERROR: Line length 'old - new' is unequal"
WHILE inkey$="":WEND
GOTO fini
END IF
PRINT# 2, Tmp$
WEND
CLOSE 2
CLOSE 1
PRINT
END
ErrorHandler:
BEEP
ErCode = ERR
Address = ERADR
RESUME DisplayCode
DisplayCode:
PRINT ""
PRINT "Error"; ErCode; " at "; Address;" ";
SELECT CASE ErCode
CASE 53: PRINT "File not found"
CASE 58: PRINT "File already exists"
CASE 75: PRINT "Wrong Pathname"
CASE ELSE: PRINT
END SELECT
PRINT " Free Memory:"; FRE(-1)
PRINT " Free String:"; FRE(-7)
PRINT " Free Stack :"; FRE(-2)
fini:
PRINT
PRINT "Your original source code is in ";Infile$
END 1
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
FUNCTION FormatLine$(BYVAL Source$)
STATIC InComment
Work$ = Source$
IF LEN(Work$) = 0 THEN
EXIT FUNCTION
END IF
NewLine$ = ""
TempLine$ = Work$
WHILE LEN(TempLine$)
KeyWord$ = BasParse$( TempLine$ )
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
IF KeyWord$ = "'" THEN
NewLine$ = NewLine$ + KeyWord$ + TempLine$
EXIT DO
ELSE
NewLine$ = NewLine$ + KeyWord$
END IF
WEND
FormatLine$ = RTRIM$(NewLine$)
END FUNCTION
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Parse the next word in a BASIC source code line
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
FUNCTION BasParse$( Source$ )
Char = ASCII(Source$)
SELECT CASE Char
CASE = -1 '?
BasParse$ = ""
Source$ = ""
EXIT FUNCTION
CASE 32,36,39,40,41,42,43,44,45,47,58,59,60,61,62,92,94,95
BasParse$ = CHR$(Char) 'step over all delimiters except "
IF LEN(Source$) > 1 THEN
Source$ = MID$(Source$, 2) '(remove 1 byte)
ELSE
Source$ = ""
END IF
EXIT FUNCTION
CASE = 34 '"
FOR X = 2 TO LEN(Source$) 'look for 2nd "
IF MID$(Source$, X, 1) = CHR$(34) THEN
EXIT FOR
END IF
NEXT X
IF X >= LEN(Source$) THEN 'if not found
BasParse$ = RTRIM$(Source$) ' overtake rest of the line
Source$ = ""
EXIT FUNCTION
ELSE
BasParse$ = RTRIM$(LEFT$(Source$, X))
Source$ = MID$(Source$, X+1) 'overtake the string
EXIT FUNCTION
END IF
END SELECT
'take out next word up to the delimiter
Tmp$ = EXTRACT$(Source$,_
ANY CHR$(32,34,36,39,40,41,42,43,44,45,47,58,59,60,61,62,92,94,95))
BasParse$ = Tmp$
IF LEN(Tmp$) = LEN(Source$) THEN
Source$ = ""
ELSE
Source$ = MID$(Source$, LEN(Tmp$) + 1)
END IF
END FUNCTION
-=-=-=-=-=-=-=-=-=-=-=-=-=- cut -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Have fun
Andras
--- CrossPoint v3.11 R
---------------
* Origin: Fido Point of Disillusion (2:2480/13.34)
|