home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
MOUSEDIR.ZIP
/
REXXREF2.KEX
< prev
next >
Wrap
Text File
|
1992-03-20
|
34KB
|
815 lines
/***********************************************************************\
* Rexx / Kexx indenter and cross referencing tool. *
* *
* Written for VM/CMS by Don Hughes, EDP Techniques *
* Modified for OS/2 REXX SAA by Bob Flores, CIA *
\***********************************************************************/
'PRESERVE'
'SET MSGMODE OFF'
'EXTRACT /LINE /TOF /EOF'
If (tof.1='ON') Then line.1 = line.1 + 1
If (eof.1='ON') Then line.1 = line.1 - 1
start_line = line.1 /* Line we started on */
first_line = line.1 /* Line to begin processing */
/***************** Set various variables and switches ******************/
rtncode = 0 /* Holds return code to be passed back to system */
switch.set = 1 /* For setting switches to TRUE */
switch.reset = 0
left_margin = 0
c_squote = "'" /* Character constants */
c_dquote = '"'
c_astslash = '*/'
c_slashast = '/*'
/*** 'keywords.scantok' & 'keywords.func' are used in 'SCANTOKEN', *****/
/************* but defined here for execution efficiency. **************/
keywords.scantok = ' do to end if then else' ,
' say iterate leave while until forever' ,
' select when otherwise nop' ,
' parse upper arg var external source pull push queue' ,
' address value arg call drop exit return interpret' ,
' signal on off error halt novalue syntax trace' ,
' procedure expose by for' ,
' numeric digits form scientific engineering fuzz'
/************ 'keywords.func' is used in routine 'FUNCTION' ************/
keywords.func = ' abbrev abs address arg bitand bitor bitxor' ,
' center centre charin charout chars compare copies c2d c2x' ,
' datatype date delstr delword digits d2c d2x errortext' ,
' externals find form format fuzz index insert lastpos' ,
' left length linein lineout lines linesize max min overlay pos' ,
' queued random reverse right sign sourceline' ,
' space strip substr subword symbol time' ,
' trace translate trunc userid value verify word' ,
' wordindex wordlength wordpos words xrange x2c x2d'
keywords.func = keywords.func 'pcdisk pcequip pcfloppy pcgame' ,
' pcparallel pcram pcromdate' ,
' pcserial pctype pcvideo doscd docchdir doschmod doscreat dosdel' ,
' dosdir dosdirpos dosdisk dosdrive dosenv dosmem dosmkdir' ,
' dosrename dosrmdir dosversion dosvolume cursor corsortype' ,
' delay inkey inp outp peek poke scrclear scrmethod scrput' ,
' scrread scrsize scrwrite sound dateconv emsmem fcnpkg lower' ,
' parsefn stackstatus upper'
keywords.func = keywords.func 'w_attr w_border w_clear w_close' ,
' w_field w_get w_hide w_keys w_move w_open w_put w_read w_scrput' ,
' w_scrread w_scrwrite w_size w_unfield w_unhide'
keywords.func = keywords.func 'lastmsg lastmsg.1'
keywords.func = TRANSLATE(keywords.func)
/******* Here are the switches that control the various options ********/
switch.xref = switch.reset /* Default: no cross reference */
xreffed = 0
/******* COML = SET => Leave comments alone; RESET => INDENT ********/
switch.coml = switch.set
/** COMRJUST = SET => Right justify comments. RESET => Leave alone **/
switch.comrjust = switch.set
switch.variable_case = switch.set /* Change variable case */
switch.label_case = switch.set /* Change label case */
switch.function_case = switch.set /* Change function case */
switch.keyword_case = switch.set /* Change keyword case */
switch.signalonoffv = 0 /* Signal on|off|value .. being processed */
/************** Get right margin for justifying comments ***************/
'EXTRACT /LRECL'
right_margin = lrecl.1
If (right_margin>73) Then right_margin = 73
continue_indent = 2 /* Number of spaces to indent continuations */
thenelse_indent = 2 /* Number of spaces to indent hanging thens */
indent_thenelse = 0 /* Current value of hanging then/else indent */
switch.thenelse = switch.reset /* For processing hanging then/else */
switch.comment_only = switch.reset
switch.skip = switch.reset /* Skip indenting */
last_delim = '' /* Ending delimiter for previous line */
/************************** Search parameters **************************/
switch.search = switch.reset; search_key = ''
switch.literal = switch.reset /* last item was a literal */
searchkey_cnt. = 0 /* Nesting level of delimiters */
searchkey_list. = '' /* Line-number stack for delimiters */
/******** 'com.' variables are also passed to called functions *********/
com.linenum = 0 /* Current line number */
com.tokennum = 0 /* Current token number */
com.last_key_num = 0 /* Token number of last keyword */
com.last_keyword = '' /* Previous keyword */
com.last_token = '' /* Previous token */
com.dolist = '' /* line-number stack for DO's and SELECTS's */
com.endlist = '' /* Line-number stack for END's */
com.delim = '' /* Current delimiter */
com.nest = 1 /* Current nesting level for indenting */
com.indent = 3 /* Number of spaces to indent */
com.offset = 0 /* Current offset */
xref. = 0 /* Cross reference tables */
/************************ Check input arguments ************************/
Parse Arg args
If (WORD(args,1)='?') Then Signal EXPLAIN
If (args='' | LEFT(args,1)='(') Then args = 'ALL' args
If (TRANSLATE(WORD(args,1))='ALL') Then Do
args = '*' DELWORD(args,1,1)
first_line = 1
End
Parse Var args '(' opts
valid_opts = ' 2INDENT 2LM 2LEFTMARGIN 3NOXREF 2RM 2RIGHTMARGIN',
'3REFRESH 1XREF'
Do While (opts<>'')
Parse Upper Var opts . opts 1 optword temp2 .
optword = GETOPTWORD(optword,valid_opts)
If (optword='LM') Then optword = 'LEFTMARGIN'
If (optword='RM') Then optword = 'RIGHTMARGIN'
Select
When (optword='INDENT') Then Do
Parse Var opts com.indent opts /* Extract argument. */
If (\DATATYPE(com.indent,'N')) Then Do
emsg = 'INDENT operand '''com.indent'''',
'is not numeric.'
Call EXIT16 emsg /* Take error exit. */
End
End
When (optword='LEFTMARGIN') Then Do
Parse Var opts left_margin opts /* Extract argument. */
If (\DATATYPE(left_margin,'N')) Then Do
emsg = 'LEFTMARGIN operand '''left_margin'''',
'is not numeric.'
Call EXIT16 emsg /* Take error exit. */
End
If (left_margin<1) Then Do
emsg = 'LEFTMARGIN operand '''left_margin'''',
'must be positive and non-zero.'
Call EXIT16 emsg /* Take error exit. */
End
End
When (optword='NOXREF') Then Do
switch.xref = switch.reset
End
When (optword='RIGHTMARGIN') Then Do
Parse Var opts right_margin opts /* Extract argument. */
If (\DATATYPE(right_margin,'N')) Then Do
emsg = 'RIGHTMARGIN operand '''right_margin'''',
'is not numeric.'
Call EXIT16 emsg /* Take error exit. */
End
End
When (optword='XREF') Then Do
switch.xref = switch.set
End
When (optword='REFRESH') Then Do
Parse Var opts refresh opts /* Extract argument. */
If (¬DATATYPE(refresh,'N')) Then Do
emsg = 'REFRESH operand '''refresh'''',
'is not numeric.'
Call EXIT16 emsg /* Take error exit. */
End
If (refresh<1) Then refresh=99999999 /* 'Never' refresh */
End
Otherwise
emsg = 'Invalid option '''optword'''.'
Call EXIT16 emsg /* Exit. */
End
End
/************ Adjust Leftmargin value, if it was specified *************/
If (left_margin>0) Then left_margin = left_margin - com.indent - 1
/*********************** Get the range of lines ************************/
'TOP'
'FIND /********* REXX CROSS REFERENCE -'
If rc <> 2 & switch.xref Then 'DELETE *'
':'start_line
target = WORD(args,1)
'LOCATE' target
If (rc=2) Then Signal PARSE_ERROR
temp = rc
'EXTRACT /LINE'
If (line.1<start_line) Then line.1 = line.1 + 1
If (line.1>start_line) Then line.1 = line.1 - 1
':'line.1
'EXTRACT /LINE /TOF /EOF'
If (temp=1) Then Do
If (tof.1='ON') Then line.1 = line.1 + 1
If (eof.1='ON') Then line.1 = line.1 - 1
End
If (line.1>first_line) Then Do
last_line = line.1
End
Else Do
last_line = first_line
first_line = line.1
End
/*********************** Setup environment ***********************/
'SET ZONE 1 *'
'SET LINEND OFF'
'SET SCOPE ALL'
'SET CASE MIXED RESPECT'
'SET SCALE OFF'
'SET TABLINE OFF'
'SET MSGMODE ON'
curlmin = 3
curlmax = 22
curll = curlmin
'SET CURLINE ON' curlmin
/****************** This is the main processing loop *******************/
total_lines = 1 + last_line - first_line
If SYMBOL('REFRESH') = 'LIT' Then refresh = MIN(50,SIZE.1())
processed = 0
Do linecnt=first_line To last_line
processed = processed + 1
switch.endtoken = switch.set /* Check if end is first token */
switch.comment_only = switch.reset
':'linecnt
'EXTRACT /CURLINE'
raw_line = curline.3
first_char = left(strip(raw_line),1)
If raw_line='' | (fext.1() = 'KML' & first_char = '*') Then Do
curll = curll + 1
Iterate linecnt
End
If (\switch.search) Then s = STRIP(raw_line); Else s = raw_line
com.linenum = linecnt /* Line number to be used in XREF */
out_string = '' /* Work area for output line */
com.delim = '' /* Current delimiter */
com.offset = left_margin + com.indent*com.nest,/* Current offset */
+ indent_thenelse
p. = ''; pindex = 1 /* Tokenized output line */
Do While (s<>'')
If (switch.search) Then Do
Parse Var s s1 (search_key) s +0
If (search_key==c_astslash) Then Do
/************* check for '/./' possibility **************/
Do While (s<>' & 'RIGHT(s1,1)='/')
/** Search Found an imbedded comment instead of end **/
Parse Var s +1 s
Parse Var s s2 (search_key) s +0
s1 = s1'*'s2
End
Parse Var s1 . (c_slashast) s2 +0
Do While (s2<>'')
/************* Found an imbedded comment *************/
searchkey_cnt.search_key = searchkey_cnt.search_key + 1
searchkey_list.search_key = linecnt,
searchkey_list.search_key
Parse Var s2 (c_slashast) (c_slashast) s2 +0
End
End
p.pindex = p.pindex || s1
If (s<>'') Then Do
/************** Found the ending delimiter **************/
p.pindex = p.pindex || search_key
s = SUBSTR(s,LENGTH(search_key)+1)
searchkey_cnt.search_key = searchkey_cnt.search_key - 1
searchkey_list.search_key =,
DELWORD(searchkey_list.search_key,1,1)
If (searchkey_cnt.search_key<=0) Then Do
If (search_key==c_astslash) Then pindex = pindex + 1
Else Do
com.delim = search_key
switch.literal = switch.set
com.tokennum = com.tokennum + 1
com.last_token = s1
End
switch.search = switch.reset; search_key = ''
End
End
Iterate
End
/**************** looking for comment or quote ****************/
Parse Var s s1a (c_slashast) s1b +0
Parse Var s s2a (c_squote) s2b +0
Parse Var s s3a (c_dquote) s3b +0
Select
When (LENGTH(s1a)<LENGTH(s2a) & LENGTH(s1a)<LENGTH(s3a)) Then
Do
/************* Found the start of a comment *************/
switch.search = switch.set; search_key = c_astslash
searchkey_cnt.search_key = searchkey_cnt.search_key + 1
searchkey_list.search_key = linecnt,
searchkey_list.search_key
p.pindex = p.pindex || SCAN(s1a)
pindex = pindex + 1
p.pindex = p.pindex || c_slashast
s = SUBSTR(s1b,3)
End
When (LENGTH(s3a)<LENGTH(s2a) | s2b<>'') Then Do
/********* Found the start of a literal string **********/
If (LENGTH(s3a)<LENGTH(s2a)) Then Do
search_key = c_dquote
s2a = s3a
s2b = s3b
End
Else search_key = c_squote
Parse Var s2b (search_key) s1 (search_key) s +0
p.pindex = p.pindex || SCAN(s2a) || search_key || s1
If (s<>'') Then Do
p.pindex = p.pindex || search_key
s = SUBSTR(s,2)
com.delim = search_key
switch.literal = switch.set
com.tokennum = com.tokennum + 1
com.last_token = search_key || s1 || search_key
search_key = ''
If (LEFT(s,1)='(') Then Do /* quoted function */
s1 = FUNCTION(s1) /* capitalize it */
j = POS(com.last_token,p.pindex)
p.pindex = OVERLAY(TRANSLATE(com.last_token),p.pindex,j)
End
End
Else Do
searchkey_cnt.search_key = searchkey_cnt.search_key + 1
searchkey_list.search_key = linecnt,
searchkey_list.search_key
switch.search = switch.set
End
switch.signalonoffv = switch.reset
End
Otherwise /* Just process remainder */
p.pindex = p.pindex || SCAN(s)
s = ''
End
End
If (p.pindex='') Then pindex = pindex - 1
/****************** Check for continuation line ******************/
If (last_delim==',') Then com.offset = com.offset + continue_indent
If (com.offset<0 | switch.skip) Then com.offset = 0
/* No further indenting if still searching for ending delimiter **/
If (switch.search) Then switch.skip = switch.set
/****************** Justify comments as needed *******************/
If (p.1='' & p.2<>'') Then Do
If (switch.coml) Then Do
com.offset = 0
switch.skip = switch.set /* Do not adjust comment indent */
p.1 = LEFT('',LENGTH(raw_line)-LENGTH(STRIP(raw_line,'L')))
End
Else Do
/******* Do not re-indent already indented comments. *******/
If (SUBSTR(raw_line,com.offset+1,2)==c_slashast) Then
switch.skip = switch.set
End
End
p.1 = LEFT('',com.offset) || p.1
out_string = ''
Do i=1 To pindex
out_string = out_string || p.i
End
len1 = LENGTH(out_string)
If (len1>1) Then Do
If (SUBSTR(out_string,len1-1,2)==c_astslash &,
switch.comrjust & \switch.search) Then Do
If (s1a='') Then switch.comment_only = switch.set
/****************** Right Adjust Comment *******************/
i=POS(c_slashast,out_string)
If (i>1) Then Do /* '/.' is to right of column 1 */
comment=SUBSTR(out_string,i)
line=STRIP(SUBSTR(out_string,1,i-1),'T')
If (line<>'') Then Do /* More than just a comment */
i=LENGTH(line)
If (i+LENGTH(comment)<right_margin) Then Do
out_string = line, /* Adjust comment when room */
RIGHT(comment,right_margin-LENGTH(line)-1)
End
End
End
End
End
/***************** Replace the line in the file ******************/
If (out_string\==raw_line) Then Do
'REPLACE' out_string
/******** Check if new line was too long for the file *********/
If (rc=3) Then Do
'REPLACE' raw_line
'EXTRACT /ALT'
'SET ALT' alt.1-2 alt.2-2
End
End
If ((pindex>2 | p.1<>'')) Then last_delim = com.delim
If (com.delim<>',') Then Do
If (\switch.comment_only) Then Do
switch.thenelse = ,
((com.last_keyword='then' | com.last_keyword='else'),
& com.tokennum=com.last_key_num)
If (switch.thenelse) Then
indent_thenelse = indent_thenelse + thenelse_indent
Else indent_thenelse = 0
End
switch.signalonoffv = switch.reset
com.tokennum = 0
com.last_key_num = 0
com.last_keyword = ''
com.last_token = ''
If (\switch.search) Then switch.skip = switch.reset
End
Else If (\switch.thenelse) Then indent_thenelse = 0
Else Do
curll = curll + 1
If (curll>curlmax) Then curll = curlmin
'SET CURLINE ON' curll
End
If (linecnt%refresh=linecnt/refresh) Then Do
reserved = 1
msg = CENTER(linecnt 'of' total_lines 'lines processed so far . . .',80)
'SET RESERVED 11 YELLOW ON RED' msg
'COMMAND REFRESH'
End
End linecnt /* End main loop */
/******************* Check for Unbalanced delimiters *******************/
'SET MSGMODE ON'
If (com.endlist<>'') Then
'EMSG Unbalanced "END"s detected at:' com.endlist
If (com.dolist<>'') Then Do
temp = ''
Do i=1 To WORDS(com.dolist)
temp = WORD(com.dolist,i) temp
End
'EMSG Unbalanced "DO"s or "SELECT"s at:' temp
End
If (searchkey_list.c_astslash<>'') Then Do
temp = ''
Do i=1 To WORDS(searchkey_list.c_astslash)
temp = WORD(searchkey_list.c_astslash,i) temp
End
'EMSG Unbalanced comments at:' temp
End
If (searchkey_list.c_squote<>'') Then Do
temp = ''
Do i=1 To WORDS(searchkey_list.c_squote)
temp = WORD(searchkey_list.c_squote,i) temp
End
'EMSG Unbalanced "''"s at:' temp
End
If (searchkey_list.c_dquote<>'') Then Do
temp = ''
Do i=1 To WORDS(searchkey_list.c_dquote)
temp = WORD(searchkey_list.c_dquote,i) temp
End
"EMSG Unbalanced '""'s At:" temp
End
/******* Finish up. Write the cross reference stuff. *******/
If \switch.xref Then Signal EXIT
reserved = 1
'SET MSGMODE OFF'
':'start_line /* Re-position to line we started at */
msg = CENTER('Creating cross reference. . .',80)
'SET RESERVED 11' msg
'REFRESH'
timestamp = STREAM(FILEID.1(),'C','Query datetime')
timestamp = TRANSLATE(timestamp,'/','-')
fdate = DATE('U'); ftime = TIME()
pad = LEFT('',24)
temp=' 1'||pad||'/********* REXX CROSS REFERENCE - Created:',
fdate ftime' *********'
Call LINEOUT FNAME.1()'.REF',temp
temp='99'||pad||CENTER('END OF' FILEID.1() 'CROSS REFFERENCE',70,'*') || '*/'
Call LINEOUT FNAME.1()'.REF',temp
temp=' 2'||pad||CENTER('for file ' FILEID.1() 'Dated:',
timestamp,70,'*')
Call LINEOUT FNAME.1()'.REF',temp
temp = ' 3'
Call LINEOUT FNAME.1()'.REF',temp
pad = LEFT(' ',24)
temp = ' 4' || pad || '---- VARIABLES ----'
Call LINEOUT FNAME.1()'.REF',temp
temp = ' 5 '
Call LINEOUT FNAME.1()'.REF',temp
temp = ' 5' || pad || '---- LABELS ----'
Call LINEOUT FNAME.1()'.REF',temp
temp = ' 6 '
Call LINEOUT FNAME.1()'.REF',temp
temp = ' 6' || pad || '---- FUNCTIONS ----'
Call LINEOUT FNAME.1()'.REF',temp
/***********************************************************************\
* There are the following XREF variables: *
* XREF.LABCNT *
* XREF.LAB.i *
* XREF.CNT.varname. *
* XREF.REF.varname.i *
* *
* XREF.LABCNT has the total count of labels found *
* XREF.LAB.i is a list of labels in the order that they were found *
* they are of the form xx string *
* xx = ' 4' => variable *
* ' 5' => label *
* ' 6' => subroutine *
* xx is also used to control the sorting on the final listing *
* XREF.CNT.varname has the total count of occurrences of varname *
* XREF.REF.varname.i is a list of line number references for varname *
* XREF.REF.varname.0 is the first occurence where a label is defined *
\***********************************************************************/
outcnt = 0 /* Initialize output line counter */
Do i=1 To xref.labcnt
varname = xref.lab.i
/* Label for SORT */
Parse Var varname sortkey 3 varlabel
sortkey2 = LEFT(varname,23)
/* Label */
/****** Check for a label that's too long for a single line ******/
If (LENGTH(varlabel)>=19) Then Do
Call LINEOUT FNAME.1()'.REF',sortkey2 || RIGHT(outcnt,3) ||,
varlabel
outcnt = outcnt + 1 /* Increment line counter */
varlabel = LEFT('',18)
End
varlabel = LEFT(varlabel,18)
temp3 = ''
/**************** Check for function definitions *****************/
If (sortkey=' 6') Then Do
temp = 'REF.' || OVERLAY(' 5',varname,1) || '.' || 0
If (xref.temp<>0) Then temp3 = temp3 xref.temp
End
/************ Build table of locations - 10 to a line ************/
j2 = xref.cnt.varname
Do j=1 To j2 By 10
Do k=j To j+9 Until (k=j2)
temp = 'REF.' || varname || '.' || k
temp3 = temp3 xref.temp
End k
temp3 = sortkey2 || RIGHT(outcnt,3) || varlabel temp3
Call LINEOUT FNAME.1()'.REF',temp3
outcnt = outcnt + 1 /* Increment line counter */
temp3 = ''
varlabel = LEFT('',18)
End j
End i
Call LINEOUT FNAME.1()'.REF'
/*************************** Sort into order ***************************/
'SET RESERVED 11' CENTER('Sorting cross reference. . .',80)
'REFRESH'
'BOTTOM'
'GET' FNAME.1()'.REF'
':'1+last_line
'SORT * 1 26'
/*********************** Remove sort search_key ************************/
'SET ARBCHAR ON $'
'SET ZONE 1 26'
'CHANGE /$//*'
'DOSQUIET ERASE' FNAME.1()'.REF'
xreffed = 1
Signal EXIT
/******************* Internal routines and functions *******************/
/******* SCAN - Look for delimiters and break line into tokens. ********/
/** Delimiters such as <> will not be recognized as such, but we are ***/
/********** not checking syntax, only looking for delimiters. **********/
SCAN: Procedure Expose switch. com. xref. keywords.
Parse Arg string
If (string='') Then Return string
if substr(string,1,1) = ':' then return LABEL(string)
delims = ',=()\|&+-;:></%* '
return_string = ''
switch.eot = switch.reset
Do While (string<>'')
iw = VERIFY(string,delims,'M')
If (iw=0) Then Do
com.delim = ''
switch.eot = switch.set
return_string = return_string || SCANTOKEN(string)
string = ''
End
Else Do
com.delim = SUBSTR(string,iw,1)
Parse Var string token (com.delim) string
return_string = return_string || SCANTOKEN(token) || com.delim
iw = VERIFY(string'a',delims)
If (iw>1) Then Do
return_string = return_string || SUBSTR(string,1,iw-1)
com.delim = RIGHT(STRIP(return_string,'T'),1)
If (POS(com.delim,delims)=0) Then com.delim = ''
string = SUBSTR(string,iw)
End
If (com.delim==';') Then Do
switch.signalonoffv = switch.reset
com.tokennum = 0
com.last_keyword = ''
com.last_key_num = 0
com.last_token = ''
End
End
switch.literal = switch.reset
End
Return return_string
/* SCANTOKEN - Classify TOKEN as KEYWORD, VARIABLE, LABEL, or FUNCTION.
Currently, keywords are not scanned exactly as the language
specifies, ie. 'FUZZ' is always considered a keyword, not just
when if follows 'NUMERIC'.
Keywords are checked for last, in case a label or function has the
same name as a keyword.
Additional tables are provided if you wish to be more exacting. */
SCANTOKEN: Procedure Expose switch. com. xref. keywords.
Parse Arg string
If (string='') Then Return string
return_string = ''
If (LOWER(string)<>'end') Then
switch.endtoken = switch.reset /* END token not first on line */
Do i=1 To WORDS(string)
com.tokennum = com.tokennum + 1
word1 = SUBWORD(string,i)
temp = LOWER(word1)
Select
When (DATATYPE(word1)='NUM' | SYMBOL(word1)='BAD') Then
/* Ignore whatever it is */
return_string = return_string word1
/* When (com.delim=':') Then */
when com.delim = ':' | (fext.1() = 'KML' & substr(word1,1,1) = ':') then
/* Things before ':'s are assumed to be LABELs */
return_string = return_string LABEL(word1)
When (com.delim='(') Then
/* Things before '(' (no BLANKs) are assumed to be FUNCTIONs*/
return_string = return_string FUNCTION(word1)
When ((com.last_token=='signal' | com.last_token=='call'),
& com.tokennum>com.last_key_num) Then Do
/* Things after 'SIGNAL' and 'CALL' are assumed to be LABELs*/
If (com.last_token=='signal' & ,
(temp=='on' | temp=='off' | temp=='value')) Then Do
switch.signalonoffv = switch.set
return_string = return_string KEYWORD(word1)
End
Else return_string = return_string LABEL(word1)
End
When WORDPOS(temp,keywords.scantok)>0 Then Do
If (switch.signalonoffv) Then Do
switch.signalonoffv = switch.reset
return_string = return_string LABEL(word1)
End
Else return_string = return_string KEYWORD(word1)
End
Otherwise return_string = return_string VARIABLE(word1)
switch.signalonoffv = switch.reset
End
com.last_token = temp
switch.literal = switch.reset
End
return_string = STRIP(return_string)
Return return_string
KEYWORD: Procedure Expose switch. com. xref. keywords.
Parse Arg word1
keyword = LOWER(word1)
com.last_keyword = keyword
com.last_key_num = com.tokennum
If (switch.keyword_case) Then Do /* Capitalize 1st letter */
word1 = LOWER(word1)
temp = TRANSLATE(SUBSTR(word1,1,1))
word1 = OVERLAY(temp,word1,1,1)
End
Select
When (keyword='select') | (keyword='do') Then Do
com.nest = com.nest + 1
com.dolist = com.linenum com.dolist
End
When (keyword='end') Then Do
com.nest = com.nest - 1
If (switch.endtoken) Then com.offset = com.offset - com.indent
If (com.dolist='') Then com.endlist = com.endlist com.linenum
Else com.dolist = DELWORD(com.dolist,1,1)
End
Otherwise Nop
End
Return word1
VARIABLE: Procedure Expose switch. com. xref. keywords.
Parse Arg word1
If (switch.variable_case) Then word1 = LOWER(word1)
/* Next DO loop added by Flores */
If (switch.xref) Then Do
sortkey = ' 4' || word1
If (xref.cnt.sortkey=0) Then Do
xref.labcnt = xref.labcnt + 1
temp = 'LAB.' || xref.labcnt
xref.temp = sortkey
End
xref.cnt.sortkey = xref.cnt.sortkey + 1
temp2 = com.linenum
If (com.tokennum=1) Then Do
temp = 'REF.' || sortkey || '.' || 0
/* Flag lines where variable is the first token (an assignment) **/
temp2 = '*' || temp2
xref.temp = temp2
End
temp = 'REF.' || sortkey || '.' || xref.cnt.sortkey
xref.temp = temp2
End
Return word1
LABEL: Procedure Expose switch. com. xref. keywords.
Parse Arg word1
If (switch.label_case) Then word1 = TRANSLATE(word1)
If (com.tokennum<=1) Then com.offset = 0
If (switch.xref) Then Do
sortkey = ' 5' || word1
If (xref.cnt.sortkey=0) Then Do
xref.labcnt = xref.labcnt + 1
temp = 'LAB.' || xref.labcnt
xref.temp = sortkey
End
xref.cnt.sortkey = xref.cnt.sortkey + 1
temp2 = com.linenum
If (com.delim==':') Then Do
temp = 'REF.' || sortkey || '.' || 0
/******* Flag line for possible use as FUNCTION definition *******/
temp2 = '*' || temp2
If (xref.temp=0) Then xref.temp = temp2
End
temp = 'REF.' || sortkey || '.' || xref.cnt.sortkey
xref.temp = temp2
End
Return word1
FUNCTION: Procedure Expose switch. com. xref. keywords.
Parse Arg word1
If (switch.function_case) Then Do
word1 = TRANSLATE(word1)
/************** Check for system defined functions ***************/
If WORDPOS(word1,keywords.func)>0 Then Do
temp = TRANSLATE(word1)
word1 = OVERLAY(temp,word1,1,1)
End
End
If (switch.xref) Then Do
If (LEFT(word1,2)='||') Then sortkey = ' 6'||SUBSTR(word1,3)
Else sortkey = ' 6'word1
If (xref.cnt.sortkey=0) Then Do
xref.labcnt = xref.labcnt + 1
temp = 'LAB.' || xref.labcnt
xref.temp = sortkey
End
xref.cnt.sortkey = xref.cnt.sortkey + 1
temp = 'REF.' || sortkey || '.' || xref.cnt.sortkey
xref.temp = com.linenum
End
Return word1
/***********************************************************************\
* Internal function 'GETOPTWORD' *
* Arguments are - single token, possibly abbreviated, *
* - string of valid full-length operands with *
* the length coded as the first character. *
* If first argument is found, the full-length token is *
* returned. If not found, return original first argument. *
\***********************************************************************/
GETOPTWORD: Procedure
Parse Arg option, template
nwords = WORDS(template)
Do k=1 To nwords
optword = WORD(template,k)
len = LEFT(optword,1)
optword = SUBSTR(optword,2)
If (LENGTH(option)>LENGTH(optword)) Then Iterate
If (ABBREV(optword,option,len)) Then Return optword
End
Return option
LOWER: /* Return lower case of parms */
Parse Arg args
Return TRANSLATE(args,'abcdefghijklmnopqrstuvwxyz','ABCDEFGHIJKLMNOPQRSTUVWXYZ')
EXIT16: Procedure
Parse Arg e_msg
'SET MSGMODE ON'
'EMSG' e_msg
rtncode = 16
EXIT:
If reserved = 1 then 'SET RESERVED 11 OFF'
'RESTORE'
':'start_line
'MSG REXXREF finished.'
If xreffed = 1 Then 'MSG Cross reference starts at line' 1+last_line'.'
Exit rtncode
PARSE_ERROR:
emsg = 'Error while parsing arguments:' args
Call EXIT16 emsg
EXPLAIN:
'SET MSGMODE ON'
'SET MSGLINE ON 2 22 OVERLAY'
'MSG'
'MSG REXXREF <target <(options>>'
'MSG'
'MSG This KEDIT macro reformats and cross references'
'MSG Rexx and Kexx files.'
'MSG'
'MSG See REXXREF.DOC for details.'
'MSG'
Signal EXIT