888 lines
38 KiB
Plaintext
888 lines
38 KiB
Plaintext
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* uniVerse basic FORMAT.BASIC subroutine (PIopen)
|
||
|
|
*
|
||
|
|
* Module %M% Version %I% Date %H%
|
||
|
|
*
|
||
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
|
* The copyright notice above does not evidence any actual or intended
|
||
|
|
* publication of such source code.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenance log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description.........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 06/09/94 13973 RM Add handling of ISOLATION to BEGIN TRANSACTIONS
|
||
|
|
* 03/11/93 11188 PVW Fixed handling of BEGIN/END TRANSACTIONS
|
||
|
|
* 03/11/93 11136 PVW Changed assigning of INDEX.CHARS so that it works
|
||
|
|
* correctly. we do not support '' to escape '.
|
||
|
|
* 02/01/93 10966 PVW Allow SQL NULL as element in multivalued data.
|
||
|
|
* 11/12/92 10214 PVW Port PIopen editor to uniVerse.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
$OPTIONS INFORMATION
|
||
|
|
|
||
|
|
SUBROUTINE FORMAT.BASIC(PROGRAM,NO.OF.LINES,MAT FORMAT.OPTIONS)
|
||
|
|
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE FORMAT.OPTS.H
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE VERBINSERT.H
|
||
|
|
|
||
|
|
X = 0 ;* Display length returned from DISLEN
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Initialize the formatter. **
|
||
|
|
***************************************************************************
|
||
|
|
EQUATE TAB TO CHAR(9) ;* Tab character (treated as space)
|
||
|
|
DYN.REF = TRUE ;* Assume < is a dynamic array reference
|
||
|
|
END.OF.PROGRAM = FALSE ;* End of source program reached
|
||
|
|
INDENT.LEVEL = 0 ;* Level indentation for current line.
|
||
|
|
LINE.NO = 0 ;* Line number in original source
|
||
|
|
LIST.CONTINUED = FALSE ;* Comma separated list continues
|
||
|
|
NEXT.INDENT.LEVEL = 0 ;* Level of indentation for next line.
|
||
|
|
NO.OF.LINES = 0 ;* Number of lines in formatted program.
|
||
|
|
LAST.LINE = '' ;* The previous line output
|
||
|
|
UNFORMATTED.PROGRAM = PROGRAM ;* The original program
|
||
|
|
PROGRAM = '' ;* The formatted program
|
||
|
|
IDENTIFIER.CHARACTERS = '' ;* Valid identifier characters
|
||
|
|
IDENTIFIER.CHARACTERS := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
||
|
|
IDENTIFIER.CHARACTERS := 'abcdefghijklmnopqrstuvwxyz'
|
||
|
|
IDENTIFIER.CHARACTERS := '0123456789'
|
||
|
|
IDENTIFIER.CHARACTERS := '.$%'
|
||
|
|
NUMERIC.LABEL.CHARACTERS = '0123456789.' ;* Valid numeric label characters
|
||
|
|
STRING.DELIMITERS = '''"\' ;* Recognised string delimiters
|
||
|
|
VAR.IND = '=+-:(<[' ;* Check of FOR and LOOP as variables
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Format the program. **
|
||
|
|
***************************************************************************
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Leave the first line unchanged if it is a comment. **
|
||
|
|
***************************************************************************
|
||
|
|
GOSUB GET.LINE:
|
||
|
|
IF LINE[1,1] = '*' THEN
|
||
|
|
FORMATTED.LINE = LINE
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
GOSUB GET.LINE:
|
||
|
|
END
|
||
|
|
|
||
|
|
LOOP
|
||
|
|
UNTIL(END.OF.PROGRAM) DO
|
||
|
|
*************************************************************************
|
||
|
|
** Display an asterisk every 10 lines processed. **
|
||
|
|
*************************************************************************
|
||
|
|
IF NOT(FORMAT.BRIEF) AND (MOD(LINE.NO,10) = 0) THEN
|
||
|
|
CRT '*':
|
||
|
|
END
|
||
|
|
|
||
|
|
*************************************************************************
|
||
|
|
** Process the line. **
|
||
|
|
*************************************************************************
|
||
|
|
GOSUB PROCESS.LINE:
|
||
|
|
|
||
|
|
*************************************************************************
|
||
|
|
** Format the line. **
|
||
|
|
*************************************************************************
|
||
|
|
FORMAT.THE.LINE:
|
||
|
|
|
||
|
|
IDENTATION = FORMAT.MARGIN + (FORMAT.INDENT * INDENT.LEVEL)
|
||
|
|
IF (LABEL = '') THEN
|
||
|
|
FORMATTED.LINE = STR(' ',IDENTATION):LINE
|
||
|
|
END ELSE
|
||
|
|
FORMATTED.LINE = LABEL:STR(' ',IDENTATION - LEN(LABEL)):LINE
|
||
|
|
END
|
||
|
|
IF COMMENT THEN
|
||
|
|
X = LEN(FORMATTED.LINE)
|
||
|
|
IF X < 40
|
||
|
|
THEN FORMATTED.LINE := SPACE(40-X): COMMENT
|
||
|
|
ELSE FORMATTED.LINE := SPACE(INT((X+10)/10)*10-X): COMMENT
|
||
|
|
END
|
||
|
|
INDENT.LEVEL = NEXT.INDENT.LEVEL
|
||
|
|
|
||
|
|
*************************************************************************
|
||
|
|
** Add the formatted line to the formatted program. **
|
||
|
|
*************************************************************************
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
|
||
|
|
NEXT.LINE:
|
||
|
|
GOSUB GET.LINE:
|
||
|
|
REPEAT
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Move the cursor to the beginning of the next line. **
|
||
|
|
***************************************************************************
|
||
|
|
IF NOT(FORMAT.BRIEF) THEN CRT
|
||
|
|
|
||
|
|
GO EXIT.FORMAT.BASIC:
|
||
|
|
|
||
|
|
*******************************************************************************
|
||
|
|
** Get a line of the program. **
|
||
|
|
*******************************************************************************
|
||
|
|
GET.LINE:
|
||
|
|
|
||
|
|
LINE = ''
|
||
|
|
LOOP
|
||
|
|
REMOVE LINE.SEGMENT FROM UNFORMATTED.PROGRAM SETTING LINE.SEGMENT.MARK
|
||
|
|
UNTIL(LINE.SEGMENT.MARK = 2 OR LINE.SEGMENT.MARK = 0) DO
|
||
|
|
IF ISNULL(LINE.SEGMENT) THEN LINE.SEGMENT = @NULL.STR
|
||
|
|
LINE := LINE.SEGMENT:CHAR(256 - LINE.SEGMENT.MARK)
|
||
|
|
REPEAT
|
||
|
|
IF ISNULL(LINE.SEGMENT) THEN LINE.SEGMENT = @NULL.STR
|
||
|
|
LINE := LINE.SEGMENT
|
||
|
|
IF (LINE.SEGMENT.MARK = 0 AND LINE = '') THEN
|
||
|
|
END.OF.PROGRAM = TRUE
|
||
|
|
END ELSE
|
||
|
|
LINE.NO += 1
|
||
|
|
END
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
*******************************************************************************
|
||
|
|
** Process a source line checking whitespace, labels, and control keywords. **
|
||
|
|
*******************************************************************************
|
||
|
|
PROCESS.LINE:
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Initialize the line trim routine. **
|
||
|
|
***************************************************************************
|
||
|
|
CHARACTER.POS = 1 ;* Character position being processed in line.
|
||
|
|
LABEL = '' ;* Statement label.
|
||
|
|
COMMENT = '' ;* Trailing comment.
|
||
|
|
LEADING.SPACES = FALSE ;* Were there leading spaces in this line.
|
||
|
|
***************************************************************************
|
||
|
|
** Remove trailing spaces **
|
||
|
|
***************************************************************************
|
||
|
|
POS = LEN(LINE)
|
||
|
|
LOOP
|
||
|
|
UNTIL POS <= 0 OR LINE[POS,1] # ' ' DO
|
||
|
|
POS -= 1
|
||
|
|
REPEAT
|
||
|
|
LINE = LINE[1,POS]
|
||
|
|
LINE.LENGTH = LEN(LINE) ;* Length of original line.
|
||
|
|
***************************************************************************
|
||
|
|
** Remove leading spaces **
|
||
|
|
***************************************************************************
|
||
|
|
POS = 1
|
||
|
|
LOOP
|
||
|
|
UNTIL LINE[POS,1] # ' '
|
||
|
|
POS += 1
|
||
|
|
REPEAT
|
||
|
|
ORIGINAL.LINE = LINE[POS,99999]
|
||
|
|
LINE = '' ;* Null the original, we'll build it as we go.
|
||
|
|
IF NOT(LIST.CONTINUED) THEN
|
||
|
|
INSIDE.EXPR = FALSE ;* Is the character inside a nested expression.
|
||
|
|
|
||
|
|
*************************************************************************
|
||
|
|
** Remove statement label if one is present. **
|
||
|
|
*************************************************************************
|
||
|
|
LABEL.POS = 1
|
||
|
|
BEGIN CASE
|
||
|
|
***********************************************************************
|
||
|
|
** Line begins with a numeric label. **
|
||
|
|
***********************************************************************
|
||
|
|
CASE (ORIGINAL.LINE MATCHES '1N0X')
|
||
|
|
LABEL.POS = 1
|
||
|
|
LOOP
|
||
|
|
CHARACTER = ORIGINAL.LINE[LABEL.POS,1]
|
||
|
|
WHILE(CHARACTER # '' AND INDEX(NUMERIC.LABEL.CHARACTERS,CHARACTER,1)) DO
|
||
|
|
LABEL.POS += 1
|
||
|
|
LABEL := CHARACTER
|
||
|
|
REPEAT
|
||
|
|
LOOP
|
||
|
|
CHARACTER = ORIGINAL.LINE[LABEL.POS,1]
|
||
|
|
WHILE (CHARACTER = ' ' OR CHARACTER = TAB) DO
|
||
|
|
LABEL.POS += 1
|
||
|
|
REPEAT
|
||
|
|
IF CHARACTER = ':' THEN
|
||
|
|
LABEL.POS += 1
|
||
|
|
END
|
||
|
|
LABEL := ':'
|
||
|
|
ORIGINAL.LINE = ORIGINAL.LINE[LABEL.POS,999999]
|
||
|
|
*********************************************************************
|
||
|
|
** Remove leading spaces **
|
||
|
|
*********************************************************************
|
||
|
|
POS = 1
|
||
|
|
LOOP
|
||
|
|
UNTIL ORIGINAL.LINE[POS,1] # ' '
|
||
|
|
POS += 1
|
||
|
|
REPEAT
|
||
|
|
ORIGINAL.LINE = ORIGINAL.LINE[POS,99999]
|
||
|
|
|
||
|
|
***********************************************************************
|
||
|
|
** Line may begin with an Alphanumeric label. **
|
||
|
|
***********************************************************************
|
||
|
|
CASE (ORIGINAL.LINE MATCHES '1A0X')
|
||
|
|
LABEL.POS = 1
|
||
|
|
LOOP
|
||
|
|
CHARACTER = ORIGINAL.LINE[LABEL.POS,1]
|
||
|
|
WHILE(CHARACTER # '' AND INDEX(IDENTIFIER.CHARACTERS,CHARACTER,1)) DO
|
||
|
|
LABEL.POS += 1
|
||
|
|
LABEL := CHARACTER
|
||
|
|
REPEAT
|
||
|
|
LOOP
|
||
|
|
CHARACTER = ORIGINAL.LINE[LABEL.POS,1]
|
||
|
|
WHILE (CHARACTER = ' ' OR CHARACTER = TAB) DO
|
||
|
|
LABEL.POS += 1
|
||
|
|
REPEAT
|
||
|
|
IF (CHARACTER = ':' AND ORIGINAL.LINE[LABEL.POS + 1,1] # '=') THEN
|
||
|
|
LABEL.POS += 1
|
||
|
|
LABEL := ':'
|
||
|
|
END ELSE
|
||
|
|
LABEL.POS = 1
|
||
|
|
LABEL = ''
|
||
|
|
END
|
||
|
|
ORIGINAL.LINE = ORIGINAL.LINE[LABEL.POS,999999]
|
||
|
|
*********************************************************************
|
||
|
|
** Remove leading spaces **
|
||
|
|
*********************************************************************
|
||
|
|
POS = 1
|
||
|
|
LOOP
|
||
|
|
UNTIL ORIGINAL.LINE[POS,1] # ' '
|
||
|
|
POS += 1
|
||
|
|
REPEAT
|
||
|
|
ORIGINAL.LINE = ORIGINAL.LINE[POS,99999]
|
||
|
|
|
||
|
|
END CASE
|
||
|
|
|
||
|
|
*************************************************************************
|
||
|
|
** If the labels option is set, put label on line by itself. **
|
||
|
|
*************************************************************************
|
||
|
|
IF (LABEL # '' AND FORMAT.LABELS) THEN
|
||
|
|
IF (LAST.LINE[1,1] # '*' AND LAST.LINE # '') THEN
|
||
|
|
FORMATTED.LINE = '' ;* Insert null line before label
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
END
|
||
|
|
FORMATTED.LINE = LABEL
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
LABEL = ''
|
||
|
|
IF ORIGINAL.LINE = '' THEN
|
||
|
|
RETURN TO NEXT.LINE:
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Were there leading spaces? **
|
||
|
|
***************************************************************************
|
||
|
|
IF (LINE.LENGTH # LEN(ORIGINAL.LINE) + LABEL.POS - 1) THEN
|
||
|
|
LEADING.SPACES = TRUE
|
||
|
|
END
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Check for special cases. **
|
||
|
|
***************************************************************************
|
||
|
|
BEGIN CASE
|
||
|
|
*************************************************************************
|
||
|
|
** Blank lines in the program. **
|
||
|
|
*************************************************************************
|
||
|
|
CASE ORIGINAL.LINE = ''
|
||
|
|
FORMATTED.LINE = LABEL
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
RETURN TO NEXT.LINE:
|
||
|
|
|
||
|
|
*************************************************************************
|
||
|
|
** Line is a comment beginning with '*' **
|
||
|
|
** These comments are treated specially when FORMAT.COMMENT is TRUE **
|
||
|
|
*************************************************************************
|
||
|
|
CASE ORIGINAL.LINE[1,1] = '*'
|
||
|
|
IF FORMAT.COMMENT THEN
|
||
|
|
IF (LEADING.SPACES) THEN
|
||
|
|
FORMATTED.LINE = LABEL:ORIGINAL.LINE
|
||
|
|
GOSUB ADD.FORMATTED.LINE
|
||
|
|
RETURN TO NEXT.LINE:
|
||
|
|
END
|
||
|
|
IF ORIGINAL.LINE = '*' THEN
|
||
|
|
FORMATTED.LINE = LABEL
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
RETURN TO NEXT.LINE:
|
||
|
|
END
|
||
|
|
L = 2
|
||
|
|
LOOP WHILE ORIGINAL.LINE[L,1] # '' AND INDEX('*- ',ORIGINAL.LINE[L,1],1) DO L+= 1 REPEAT
|
||
|
|
IF LAST.LINE[1,1] = '*' THEN
|
||
|
|
FORMATTED.LINE = LABEL:'* ':ORIGINAL.LINE[L,9999]
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
RETURN TO NEXT.LINE:
|
||
|
|
END
|
||
|
|
IF LAST.LINE[1,1] = ' ' THEN
|
||
|
|
FORMATTED.LINE = ''
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
END
|
||
|
|
IF L = LEN(ORIGINAL.LINE) THEN
|
||
|
|
FORMATTED.LINE = LABEL:'!'
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
RETURN TO NEXT.LINE
|
||
|
|
END
|
||
|
|
FORMATTED.LINE = LABEL:'*---- ':ORIGINAL.LINE[L,9999]
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
RETURN TO NEXT.LINE:
|
||
|
|
END ELSE
|
||
|
|
IF (LEADING.SPACES) THEN
|
||
|
|
LINE = ORIGINAL.LINE
|
||
|
|
RETURN TO FORMAT.THE.LINE:
|
||
|
|
END ELSE
|
||
|
|
FORMATTED.LINE = LABEL:ORIGINAL.LINE
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
RETURN TO NEXT.LINE:
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
*************************************************************************
|
||
|
|
** Line is a comment beginning with ! **
|
||
|
|
*************************************************************************
|
||
|
|
CASE ORIGINAL.LINE[1,1] = '!'
|
||
|
|
IF (LEADING.SPACES) THEN
|
||
|
|
LINE = ORIGINAL.LINE
|
||
|
|
RETURN TO FORMAT.THE.LINE:
|
||
|
|
END ELSE
|
||
|
|
FORMATTED.LINE = LABEL:ORIGINAL.LINE
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
RETURN TO NEXT.LINE:
|
||
|
|
END
|
||
|
|
|
||
|
|
*************************************************************************
|
||
|
|
** Line is a comment of the form REM comment text... **
|
||
|
|
** There should be a check here for the use of REM as a variable **
|
||
|
|
*************************************************************************
|
||
|
|
CASE (OCONV(ORIGINAL.LINE[1,4],FORMAT.CASE) = 'REM ' OR OCONV(ORIGINAL.LINE,FORMAT.CASE) = 'REM')
|
||
|
|
IF (LEADING.SPACES) THEN
|
||
|
|
LINE = ORIGINAL.LINE
|
||
|
|
RETURN TO FORMAT.THE.LINE:
|
||
|
|
END ELSE
|
||
|
|
FORMATTED.LINE = LABEL:ORIGINAL.LINE
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
RETURN TO NEXT.LINE:
|
||
|
|
END
|
||
|
|
|
||
|
|
*************************************************************************
|
||
|
|
** Line is a $ directive (don't trim embedded or trailing blanks) **
|
||
|
|
*************************************************************************
|
||
|
|
CASE ORIGINAL.LINE[1,1] = '$'
|
||
|
|
FORMATTED.LINE = LABEL:ORIGINAL.LINE
|
||
|
|
GOSUB ADD.FORMATTED.LINE:
|
||
|
|
RETURN TO NEXT.LINE:
|
||
|
|
|
||
|
|
END CASE
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Trim the embedded spaces. **
|
||
|
|
***************************************************************************
|
||
|
|
WHITESPACE.FLAG = FALSE
|
||
|
|
STATEMENT = ''
|
||
|
|
CHARACTER = ''
|
||
|
|
PREVIOUS.CHARACTER = ''
|
||
|
|
CHARACTER.POS = 0
|
||
|
|
FIRST.STATEMENT.ON.LINE = TRUE
|
||
|
|
***************************************************************************
|
||
|
|
** Check if special characters are to be surrounded with spaces. **
|
||
|
|
***************************************************************************
|
||
|
|
IF FORMAT.SURROUND THEN
|
||
|
|
INDEX.CHARS = TAB:" ;()[]'":'"\=:+-#><'
|
||
|
|
END ELSE
|
||
|
|
INDEX.CHARS = TAB:" ;()[]'":'"\'
|
||
|
|
END
|
||
|
|
NEXT.CHARACTER:
|
||
|
|
CHARACTER.POS += 1
|
||
|
|
CHARACTER = ORIGINAL.LINE[CHARACTER.POS,1]
|
||
|
|
IF CHARACTER = '' THEN
|
||
|
|
GOTO END.OF.LINE:
|
||
|
|
END
|
||
|
|
***************************************************************************
|
||
|
|
** Check for special cases. **
|
||
|
|
***************************************************************************
|
||
|
|
ON INDEX(INDEX.CHARS,CHARACTER,1) + 1 GOTO OTHER.LABEL:,
|
||
|
|
WHITESPACE.LABEL:,
|
||
|
|
WHITESPACE.LABEL:,
|
||
|
|
SEMI.LABEL:,
|
||
|
|
OPEN.LABEL:,
|
||
|
|
CLOSE.LABEL:,
|
||
|
|
OPEN.LABEL:,
|
||
|
|
CLOSE.LABEL:,
|
||
|
|
QUOTE.LABEL:,
|
||
|
|
QUOTE.LABEL:,
|
||
|
|
QUOTE.LABEL:,
|
||
|
|
EQ.LABEL:,
|
||
|
|
COLON.LABEL:,
|
||
|
|
PLUS.LABEL:,
|
||
|
|
MINUS.LABEL:,
|
||
|
|
NE.LABEL:,
|
||
|
|
GT.LABEL:,
|
||
|
|
LT.LABEL:
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Add CHARACTER to the current statement. **
|
||
|
|
***************************************************************************
|
||
|
|
OTHER.LABEL:
|
||
|
|
ADD.CHARACTER:
|
||
|
|
IF WHITESPACE.FLAG THEN
|
||
|
|
STATEMENT := ' '
|
||
|
|
WHITESPACE.FLAG = FALSE
|
||
|
|
END
|
||
|
|
STATEMENT := CHARACTER
|
||
|
|
PREVIOUS.CHARACTER = CHARACTER
|
||
|
|
GOTO NEXT.CHARACTER:
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Compress all contiguous blanks to a single blank. **
|
||
|
|
***************************************************************************
|
||
|
|
WHITESPACE.LABEL:
|
||
|
|
IF PREVIOUS.CHARACTER # '' THEN
|
||
|
|
WHITESPACE.FLAG = TRUE
|
||
|
|
END
|
||
|
|
GOTO NEXT.CHARACTER
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Handle the nesting of expressions. **
|
||
|
|
***************************************************************************
|
||
|
|
OPEN.LABEL:
|
||
|
|
INSIDE.EXPR += 1
|
||
|
|
GOTO ADD.CHARACTER:
|
||
|
|
CLOSE.LABEL:
|
||
|
|
INSIDE.EXPR -= 1
|
||
|
|
GOTO ADD.CHARACTER:
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Handle end of statement. **
|
||
|
|
***************************************************************************
|
||
|
|
SEMI.LABEL:
|
||
|
|
IF NOT(INSIDE.EXPR) OR PREVIOUS.CHARACTER = ',' THEN
|
||
|
|
COMMENT = ORIGINAL.LINE[CHARACTER.POS+1,999999]
|
||
|
|
*********************************************************************
|
||
|
|
** Remove leading spaces **
|
||
|
|
*********************************************************************
|
||
|
|
POS = 1
|
||
|
|
LOOP
|
||
|
|
UNTIL COMMENT[POS,1] # ' '
|
||
|
|
POS += 1
|
||
|
|
REPEAT
|
||
|
|
COMMENT = COMMENT[POS,99999]
|
||
|
|
*****************************************************************
|
||
|
|
** Don't worry about check if the statement is a comment. **
|
||
|
|
*****************************************************************
|
||
|
|
IF COMMENT[1,1] = '*' THEN
|
||
|
|
IF FORMAT.COMMENT THEN
|
||
|
|
COMMENT = COMMENT[2,999999]
|
||
|
|
*********************************************************************
|
||
|
|
** Remove leading spaces **
|
||
|
|
*********************************************************************
|
||
|
|
POS = 1
|
||
|
|
LOOP
|
||
|
|
UNTIL COMMENT[POS,1] # ' '
|
||
|
|
POS += 1
|
||
|
|
REPEAT
|
||
|
|
COMMENT = ' ;* ':COMMENT[POS,99999]
|
||
|
|
END ELSE
|
||
|
|
COMMENT = ' ; ':COMMENT
|
||
|
|
END
|
||
|
|
GOTO END.OF.LINE:
|
||
|
|
END
|
||
|
|
IF COMMENT[1,1] = '!' OR OCONV(COMMENT,FORMAT.CASE) = 'REM' OR OCONV(COMMENT[1,4],FORMAT.CASE) = 'REM ' THEN
|
||
|
|
COMMENT = ' ; ':COMMENT
|
||
|
|
GOTO END.OF.LINE:
|
||
|
|
END ELSE
|
||
|
|
***********************************************************************
|
||
|
|
** End of statement. Check control keywords, add to line. **
|
||
|
|
***********************************************************************
|
||
|
|
COMMENT = ''
|
||
|
|
GOSUB CHECK.CONTROL.KEYWORDS:
|
||
|
|
LINE := STATEMENT:' ; '
|
||
|
|
STATEMENT = ''
|
||
|
|
CHARACTER = ''
|
||
|
|
PREVIOUS.CHARACTER = ''
|
||
|
|
WHITESPACE.FLAG = FALSE
|
||
|
|
FIRST.STATEMENT.ON.LINE = FALSE
|
||
|
|
GOTO NEXT.CHARACTER:
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
GOTO ADD.CHARACTER:
|
||
|
|
END
|
||
|
|
|
||
|
|
**************************************************************************
|
||
|
|
** Handle quoted strings. **
|
||
|
|
**************************************************************************
|
||
|
|
QUOTE.LABEL:
|
||
|
|
STRING = ORIGINAL.LINE[CHARACTER.POS,9999]
|
||
|
|
STR.LEN = INDEX(STRING[2,9999],CHARACTER,1) + 1
|
||
|
|
STRING = STRING[1,STR.LEN]
|
||
|
|
IF WHITESPACE.FLAG THEN
|
||
|
|
STATEMENT := ' '
|
||
|
|
WHITESPACE.FLAG = FALSE
|
||
|
|
END
|
||
|
|
STATEMENT := STRING
|
||
|
|
PREVIOUS.CHARACTER = CHARACTER
|
||
|
|
CHARACTER.POS += STR.LEN - 1
|
||
|
|
GOTO NEXT.CHARACTER:
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Handle '+=','-=',':='. **
|
||
|
|
***************************************************************************
|
||
|
|
COLON.LABEL:
|
||
|
|
PLUS.LABEL:
|
||
|
|
MINUS.LABEL:
|
||
|
|
CHAR.NEXT = ORIGINAL.LINE[CHARACTER.POS+1,1]
|
||
|
|
IF CHAR.NEXT = '=' THEN
|
||
|
|
GOTO SURROUND.2
|
||
|
|
END ELSE
|
||
|
|
GOTO ADD.CHARACTER:
|
||
|
|
END
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Handle '=','=>','=<','#','#>','#<'. **
|
||
|
|
***************************************************************************
|
||
|
|
EQ.LABEL:
|
||
|
|
CHAR.NEXT = ORIGINAL.LINE[CHARACTER.POS+1,1]
|
||
|
|
IF CHAR.NEXT = '<' OR CHAR.NEXT = '>' THEN
|
||
|
|
GOTO SURROUND.2
|
||
|
|
END ELSE
|
||
|
|
GOTO SURROUND.1
|
||
|
|
END
|
||
|
|
|
||
|
|
NE.LABEL:
|
||
|
|
IF ORIGINAL.LINE[CHARACTER.POS,5] = '####(' THEN
|
||
|
|
IF WHITESPACE.FLAG THEN
|
||
|
|
STATEMENT := ' '
|
||
|
|
WHITESPACE.FLAG = FALSE
|
||
|
|
END
|
||
|
|
STATEMENT := '####('
|
||
|
|
PREVIOUS.CHARACTER = '('
|
||
|
|
CHARACTER.POS += 4
|
||
|
|
GOTO NEXT.CHARACTER:
|
||
|
|
END ELSE
|
||
|
|
CHAR.NEXT = ORIGINAL.LINE[CHARACTER.POS+1,1]
|
||
|
|
IF CHAR.NEXT = '<' OR CHAR.NEXT = '>' THEN
|
||
|
|
GOTO SURROUND.2
|
||
|
|
END ELSE
|
||
|
|
GOTO SURROUND.1
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Handle '<','<=','<>','>','>=','><'. **
|
||
|
|
***************************************************************************
|
||
|
|
GT.LABEL:
|
||
|
|
CHAR.NEXT = ORIGINAL.LINE[CHARACTER.POS+1,1]
|
||
|
|
IF CHAR.NEXT = '<' OR CHAR.NEXT = '=' THEN
|
||
|
|
GOTO SURROUND.2
|
||
|
|
END ELSE
|
||
|
|
*************************************************************************
|
||
|
|
** Possible check for dynamic array reference or GT **
|
||
|
|
** Always assumes dynamic array reference at present **
|
||
|
|
*************************************************************************
|
||
|
|
IF DYN.REF THEN
|
||
|
|
GOTO ADD.CHARACTER:
|
||
|
|
END ELSE
|
||
|
|
GOTO SURROUND.1
|
||
|
|
END
|
||
|
|
END
|
||
|
|
LT.LABEL:
|
||
|
|
CHAR.NEXT = ORIGINAL.LINE[CHARACTER.POS+1,1]
|
||
|
|
IF CHAR.NEXT = '=' OR CHAR.NEXT = '>' THEN
|
||
|
|
GOTO SURROUND.2
|
||
|
|
END ELSE
|
||
|
|
*************************************************************************
|
||
|
|
** Possible check for dynamic array reference or LT **
|
||
|
|
** Always assumes dynamic array reference at present **
|
||
|
|
*************************************************************************
|
||
|
|
IF DYN.REF THEN
|
||
|
|
GOTO ADD.CHARACTER:
|
||
|
|
END ELSE
|
||
|
|
GOTO SURROUND.1
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Surround single character with spaces. **
|
||
|
|
***************************************************************************
|
||
|
|
SURROUND.1:
|
||
|
|
STATEMENT := ' ':CHARACTER
|
||
|
|
WHITESPACE.FLAG = TRUE
|
||
|
|
PREVIOUS.CHARACTER = CHARACTER
|
||
|
|
GOTO NEXT.CHARACTER:
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Surround double characters with spaces. **
|
||
|
|
***************************************************************************
|
||
|
|
SURROUND.2:
|
||
|
|
STATEMENT := ' ':CHARACTER:CHAR.NEXT
|
||
|
|
WHITESPACE.FLAG = TRUE
|
||
|
|
PREVIOUS.CHARACTER = CHAR.NEXT
|
||
|
|
CHARACTER.POS += 1
|
||
|
|
GOTO NEXT.CHARACTER:
|
||
|
|
|
||
|
|
END.OF.LINE:
|
||
|
|
***************************************************************************
|
||
|
|
** Add the last statement to the line. **
|
||
|
|
***************************************************************************
|
||
|
|
GOSUB CHECK.CONTROL.KEYWORDS:
|
||
|
|
LINE := STATEMENT
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Check if this line is continued. **
|
||
|
|
***************************************************************************
|
||
|
|
IF LINE[1] = ',' THEN
|
||
|
|
IF NOT(LIST.CONTINUED) THEN
|
||
|
|
LIST.CONTINUED = TRUE
|
||
|
|
NEXT.INDENT.LEVEL += 1
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
IF LIST.CONTINUED THEN
|
||
|
|
LIST.CONTINUED = FALSE
|
||
|
|
NEXT.INDENT.LEVEL -= 1
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
EXIT.PROCESS.LINE:
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
*******************************************************************************
|
||
|
|
** Add a line to the formatted program. **
|
||
|
|
*******************************************************************************
|
||
|
|
ADD.FORMATTED.LINE:
|
||
|
|
NO.OF.LINES += 1
|
||
|
|
* PROGRAM<-1> = FORMATTED.LINE
|
||
|
|
IF PROGRAM THEN
|
||
|
|
PROGRAM := @FM : FORMATTED.LINE
|
||
|
|
END ELSE
|
||
|
|
PROGRAM = FORMATTED.LINE
|
||
|
|
END
|
||
|
|
LAST.LINE = FORMATTED.LINE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
*******************************************************************************
|
||
|
|
** Check for the beginning and/or end of a control block. **
|
||
|
|
*******************************************************************************
|
||
|
|
CHECK.CONTROL.KEYWORDS:
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
** Check for leading keywords. **
|
||
|
|
***************************************************************************
|
||
|
|
STATEMENT.CASE = OCONV(STATEMENT,FORMAT.CASE)
|
||
|
|
ON INDEX('BCEFLNORTUW',STATEMENT.CASE[1,1],1) + 1 GOTO CLAUSE.LABEL, ;* clauses
|
||
|
|
B.LABEL, ;* BEGIN CASE keyword
|
||
|
|
C.LABEL, ;* CASE keyword
|
||
|
|
E.LABEL, ;* END and ELSE keywords
|
||
|
|
F.LABEL, ;* FOR keyword
|
||
|
|
L.LABEL, ;* LOOP and LOCKED keywords
|
||
|
|
N.LABEL, ;* NEXT keyword
|
||
|
|
O.LABEL, ;* ON ERROR keyword
|
||
|
|
R.LABEL, ;* REPEAT keyword
|
||
|
|
T.LABEL, ;* THEN keyword
|
||
|
|
U.LABEL, ;* UNTIL keyword
|
||
|
|
W.LABEL ;* WHILE keyword
|
||
|
|
|
||
|
|
CLAUSE.LABEL:
|
||
|
|
***************************************************************************
|
||
|
|
** Indent the next line if this line ends in a clause. **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE[9] = ' ON ERROR' OR STATEMENT.CASE[7] = ' LOCKED' OR STATEMENT.CASE[5] = ' THEN' OR STATEMENT.CASE[5] = ' ELSE' THEN
|
||
|
|
NEXT.INDENT.LEVEL += 1
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
REPEAT.LABEL:
|
||
|
|
****************************************************************************
|
||
|
|
** Stop indenting for LOOP on the next line if this line ends in a repeat.**
|
||
|
|
****************************************************************************
|
||
|
|
IF STATEMENT.CASE[7] = ' REPEAT' THEN
|
||
|
|
NEXT.INDENT.LEVEL -= 1
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
B.LABEL:
|
||
|
|
***************************************************************************
|
||
|
|
** Indent the next line by 2 if this line starts a CASE statement. **
|
||
|
|
** This is so CASE clauses can be indented form the BEGIN CASE. **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE = 'BEGIN CASE' THEN
|
||
|
|
NEXT.INDENT.LEVEL += 2
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF STATEMENT.CASE = 'BEGIN TRANSACTION' OR FIELD(STATEMENT.CASE," ",3) = 'ISOLATION' THEN
|
||
|
|
NEXT.INDENT.LEVEL += 1
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
|
||
|
|
C.LABEL:
|
||
|
|
***************************************************************************
|
||
|
|
** Outdent this line if it is a CASE clause. **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE[1,5] = 'CASE ' THEN
|
||
|
|
INDENT.LEVEL -= 1
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
|
||
|
|
E.LABEL:
|
||
|
|
***************************************************************************
|
||
|
|
** Stop the indenting for the clause if this is an END **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE = 'END' THEN
|
||
|
|
IF FIRST.STATEMENT.ON.LINE THEN
|
||
|
|
INDENT.LEVEL -= 1
|
||
|
|
END
|
||
|
|
NEXT.INDENT.LEVEL -= 1
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
***************************************************************************
|
||
|
|
** Stop the indenting for the CASE statement if this is an END CASE **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE = 'END CASE' THEN
|
||
|
|
NEXT.INDENT.LEVEL -= 2
|
||
|
|
INDENT.LEVEL -= 2
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF STATEMENT.CASE = 'END TRANSACTION' THEN
|
||
|
|
NEXT.INDENT.LEVEL -= 1
|
||
|
|
INDENT.LEVEL -= 1
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
***************************************************************************
|
||
|
|
** Stop the indenting for the clause and check for the start of more **
|
||
|
|
** clauses **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE[1,4] = 'END ' THEN
|
||
|
|
NEXT.INDENT.LEVEL -= 1
|
||
|
|
INDENT.LEVEL -= 1
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
END
|
||
|
|
***************************************************************************
|
||
|
|
** Handle ELSE clauses **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE = 'ELSE' THEN
|
||
|
|
NEXT.INDENT.LEVEL += 1
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF STATEMENT.CASE[1,5] = 'ELSE ' THEN
|
||
|
|
INDENT.LEVEL += 1
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
END
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
|
||
|
|
F.LABEL:
|
||
|
|
***************************************************************************
|
||
|
|
** Handle FOR statements. **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE[1,4] = 'FOR ' THEN
|
||
|
|
*************************************************************************
|
||
|
|
** Check for FOR = type of constructs **
|
||
|
|
*************************************************************************
|
||
|
|
IF NOT(INDEX(VAR.IND,STATEMENT.CASE[5,1],1)) THEN
|
||
|
|
NEXT.INDENT.LEVEL += 1
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
END
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
|
||
|
|
L.LABEL:
|
||
|
|
***************************************************************************
|
||
|
|
** Handle LOOP statements. **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE = 'LOOP' THEN
|
||
|
|
NEXT.INDENT.LEVEL += 1
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF STATEMENT.CASE[1,5] = 'LOOP ' THEN
|
||
|
|
*************************************************************************
|
||
|
|
** Check for LOOP = type of constructs **
|
||
|
|
*************************************************************************
|
||
|
|
IF NOT(INDEX(VAR.IND,STATEMENT.CASE[6,1],1)) THEN
|
||
|
|
NEXT.INDENT.LEVEL += 1
|
||
|
|
GOTO REPEAT.LABEL:
|
||
|
|
END
|
||
|
|
END
|
||
|
|
***************************************************************************
|
||
|
|
** Handle LOCKED clauses **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE = 'LOCKED' THEN
|
||
|
|
NEXT.INDENT.LEVEL += 1
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF STATEMENT.CASE[1,7] = 'LOCKED ' THEN
|
||
|
|
INDENT.LEVEL += 1
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
END
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
|
||
|
|
N.LABEL:
|
||
|
|
***************************************************************************
|
||
|
|
** Handle NEXT statements. **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE = 'NEXT' OR STATEMENT.CASE[1,5] = 'NEXT ' THEN
|
||
|
|
NEXT.INDENT.LEVEL -= 1
|
||
|
|
IF FIRST.STATEMENT.ON.LINE THEN
|
||
|
|
INDENT.LEVEL -= 1
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
|
||
|
|
O.LABEL:
|
||
|
|
***************************************************************************
|
||
|
|
** Handle ON ERROR clauses **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE = 'ON ERROR' THEN
|
||
|
|
NEXT.INDENT.LEVEL += 1
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF STATEMENT.CASE[1,9] = 'ON ERROR ' THEN
|
||
|
|
INDENT.LEVEL += 1
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
END
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
|
||
|
|
R.LABEL:
|
||
|
|
***************************************************************************
|
||
|
|
** Handle REPEAT statements. **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE = 'REPEAT' THEN
|
||
|
|
NEXT.INDENT.LEVEL -= 1
|
||
|
|
INDENT.LEVEL -= 1
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
|
||
|
|
T.LABEL:
|
||
|
|
***************************************************************************
|
||
|
|
** Handle THEN clauses **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE = 'THEN' THEN
|
||
|
|
NEXT.INDENT.LEVEL += 1
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF STATEMENT.CASE[1,5] = 'THEN ' THEN
|
||
|
|
INDENT.LEVEL += 1
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
END
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
|
||
|
|
U.LABEL:
|
||
|
|
***************************************************************************
|
||
|
|
** Handle an UNTIL clause. **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE[1,6] = 'UNTIL ' THEN
|
||
|
|
INDENT.LEVEL -= 1
|
||
|
|
GOTO REPEAT.LABEL:
|
||
|
|
END
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
|
||
|
|
W.LABEL:
|
||
|
|
***************************************************************************
|
||
|
|
** Handle a WHILE clause. **
|
||
|
|
***************************************************************************
|
||
|
|
IF STATEMENT.CASE[1,6] = 'WHILE ' THEN
|
||
|
|
INDENT.LEVEL -= 1
|
||
|
|
GOTO REPEAT.LABEL:
|
||
|
|
END
|
||
|
|
GOTO CLAUSE.LABEL:
|
||
|
|
|
||
|
|
*******************************************************************************
|
||
|
|
** Exit the INFO/BASIC source formatting routine. **
|
||
|
|
*******************************************************************************
|
||
|
|
EXIT.FORMAT.BASIC:
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
* END-CODE
|