home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / MOUSEDIR.ZIP / REXXREF2.KEX < prev    next >
Text File  |  1992-03-20  |  34KB  |  815 lines
  1. /***********************************************************************\
  2.  *  Rexx / Kexx indenter and cross referencing tool.                   *
  3.  *                                                                     *
  4.  *  Written for VM/CMS by Don Hughes, EDP Techniques                   *
  5.  *  Modified for OS/2 REXX SAA by Bob Flores, CIA                      *
  6. \***********************************************************************/
  7.  
  8.    'PRESERVE'
  9.    'SET MSGMODE OFF'
  10.    'EXTRACT /LINE /TOF /EOF'
  11.    If (tof.1='ON') Then line.1 = line.1 + 1
  12.    If (eof.1='ON') Then line.1 = line.1 - 1
  13.    start_line = line.1                           /* Line we started on */
  14.    first_line = line.1                     /* Line to begin processing */
  15.  
  16. /***************** Set various variables and switches ******************/
  17.    rtncode = 0      /* Holds return code to be passed back to system   */
  18.    switch.set = 1                      /* For setting switches to TRUE */
  19.    switch.reset = 0
  20.    left_margin = 0
  21.    c_squote = "'"                               /* Character constants */
  22.    c_dquote = '"'
  23.    c_astslash = '*/'
  24.    c_slashast = '/*'
  25. /*** 'keywords.scantok' & 'keywords.func' are used in 'SCANTOKEN', *****/
  26. /************* but defined here for execution efficiency. **************/
  27.    keywords.scantok = ' do to end if then else' ,
  28.      ' say iterate leave while until forever' ,
  29.      ' select when otherwise nop' ,
  30.      ' parse upper arg var external source pull push queue' ,
  31.      ' address value arg call drop exit return interpret' ,
  32.      ' signal on off error halt novalue syntax trace' ,
  33.      ' procedure expose by for' ,
  34.      ' numeric digits form scientific engineering fuzz'
  35.  
  36. /************ 'keywords.func' is used in routine 'FUNCTION' ************/
  37.    keywords.func = ' abbrev abs address arg bitand bitor bitxor' ,
  38.      ' center centre charin charout chars compare copies c2d c2x' ,
  39.      ' datatype date delstr delword digits d2c d2x errortext' ,
  40.      ' externals find form format fuzz index insert lastpos' ,
  41.      ' left length linein lineout lines linesize max min overlay pos' ,
  42.      ' queued random reverse right sign sourceline' ,
  43.      ' space strip substr subword symbol time' ,
  44.      ' trace translate trunc userid value verify word' ,
  45.      ' wordindex wordlength wordpos words xrange x2c x2d'
  46.    keywords.func = keywords.func 'pcdisk pcequip pcfloppy pcgame' ,
  47.      ' pcparallel pcram pcromdate' ,
  48.      ' pcserial pctype pcvideo doscd docchdir doschmod doscreat dosdel' ,
  49.      ' dosdir dosdirpos dosdisk dosdrive dosenv dosmem dosmkdir' ,
  50.      ' dosrename dosrmdir dosversion dosvolume cursor corsortype' ,
  51.      ' delay inkey inp outp peek poke scrclear scrmethod scrput' ,
  52.      ' scrread scrsize scrwrite sound dateconv emsmem fcnpkg lower' ,
  53.      ' parsefn stackstatus upper'
  54.    keywords.func = keywords.func 'w_attr w_border w_clear w_close' ,
  55.      ' w_field w_get w_hide w_keys w_move w_open w_put w_read w_scrput' ,
  56.      ' w_scrread w_scrwrite w_size w_unfield w_unhide'
  57.    keywords.func = keywords.func 'lastmsg lastmsg.1'
  58.    keywords.func = TRANSLATE(keywords.func)
  59.  
  60. /******* Here are the switches that control the various options ********/
  61.    switch.xref = switch.reset          /* Default:  no cross reference */
  62.    xreffed = 0
  63.    /******* COML = SET => Leave comments alone; RESET => INDENT ********/
  64.    switch.coml = switch.set
  65.    /** COMRJUST = SET => Right justify comments. RESET => Leave alone **/
  66.    switch.comrjust = switch.set
  67.    switch.variable_case = switch.set           /* Change variable case */
  68.    switch.label_case = switch.set                 /* Change label case */
  69.    switch.function_case = switch.set           /* Change function case */
  70.    switch.keyword_case = switch.set             /* Change keyword case */
  71.    switch.signalonoffv = 0   /* Signal on|off|value .. being processed */
  72.  
  73. /************** Get right margin for justifying comments ***************/
  74.    'EXTRACT /LRECL'
  75.    right_margin = lrecl.1
  76.    If (right_margin>73) Then right_margin = 73
  77.    continue_indent = 2     /* Number of spaces to indent continuations */
  78.    thenelse_indent = 2     /* Number of spaces to indent hanging thens */
  79.    indent_thenelse = 0    /* Current value of hanging then/else indent */
  80.    switch.thenelse = switch.reset  /* For processing hanging then/else */
  81.    switch.comment_only = switch.reset
  82.    switch.skip = switch.reset                        /* Skip indenting */
  83.    last_delim = ''               /* Ending delimiter for previous line */
  84. /************************** Search parameters **************************/
  85.    switch.search = switch.reset; search_key = ''
  86.    switch.literal = switch.reset            /* last item was a literal */
  87.    searchkey_cnt. = 0                   /* Nesting level of delimiters */
  88.    searchkey_list. = ''            /* Line-number stack for delimiters */
  89.  
  90. /******** 'com.' variables are also passed to called functions *********/
  91.    com.linenum = 0                              /* Current line number */
  92.    com.tokennum = 0                            /* Current token number */
  93.    com.last_key_num = 0                /* Token number of last keyword */
  94.    com.last_keyword = ''                           /* Previous keyword */
  95.    com.last_token = ''                               /* Previous token */
  96.    com.dolist = ''         /* line-number stack for DO's and SELECTS's */
  97.    com.endlist = ''                     /* Line-number stack for END's */
  98.    com.delim = ''                                 /* Current delimiter */
  99.    com.nest = 1                 /* Current nesting level for indenting */
  100.    com.indent = 3                        /* Number of spaces to indent */
  101.    com.offset = 0                                    /* Current offset */
  102.    xref. = 0                                 /* Cross reference tables */
  103.  
  104. /************************ Check input arguments ************************/
  105.    Parse Arg args
  106.    If (WORD(args,1)='?') Then Signal EXPLAIN
  107.    If (args='' | LEFT(args,1)='(') Then args = 'ALL' args
  108.    If (TRANSLATE(WORD(args,1))='ALL') Then Do
  109.       args = '*' DELWORD(args,1,1)
  110.       first_line = 1
  111.    End
  112.    Parse Var args '(' opts
  113.    valid_opts = ' 2INDENT 2LM 2LEFTMARGIN 3NOXREF 2RM 2RIGHTMARGIN',
  114.      '3REFRESH 1XREF'
  115.    Do While (opts<>'')
  116.       Parse Upper Var opts . opts 1 optword temp2 .
  117.       optword = GETOPTWORD(optword,valid_opts)
  118.       If (optword='LM') Then optword = 'LEFTMARGIN'
  119.       If (optword='RM') Then optword = 'RIGHTMARGIN'
  120.       Select
  121.          When (optword='INDENT') Then Do
  122.             Parse Var opts com.indent opts        /* Extract argument. */
  123.             If (\DATATYPE(com.indent,'N')) Then Do
  124.                emsg = 'INDENT operand '''com.indent'''',
  125.                  'is not numeric.'
  126.                Call EXIT16 emsg                    /* Take error exit. */
  127.             End
  128.          End
  129.          When (optword='LEFTMARGIN') Then Do
  130.             Parse Var opts left_margin opts       /* Extract argument. */
  131.             If (\DATATYPE(left_margin,'N')) Then Do
  132.                emsg = 'LEFTMARGIN operand '''left_margin'''',
  133.                  'is not numeric.'
  134.                Call EXIT16 emsg                    /* Take error exit. */
  135.             End
  136.             If (left_margin<1) Then Do
  137.                emsg = 'LEFTMARGIN operand '''left_margin'''',
  138.                  'must be positive and non-zero.'
  139.                Call EXIT16 emsg                    /* Take error exit. */
  140.             End
  141.          End
  142.          When (optword='NOXREF') Then Do
  143.             switch.xref = switch.reset
  144.          End
  145.          When (optword='RIGHTMARGIN') Then Do
  146.             Parse Var opts right_margin opts      /* Extract argument. */
  147.             If (\DATATYPE(right_margin,'N')) Then Do
  148.                emsg = 'RIGHTMARGIN operand '''right_margin'''',
  149.                  'is not numeric.'
  150.                Call EXIT16 emsg                    /* Take error exit. */
  151.             End
  152.          End
  153.          When (optword='XREF') Then Do
  154.             switch.xref = switch.set
  155.          End
  156.          When (optword='REFRESH') Then Do
  157.             Parse Var opts refresh opts           /* Extract argument. */
  158.             If (¬DATATYPE(refresh,'N')) Then Do
  159.                emsg = 'REFRESH operand '''refresh'''',
  160.                  'is not numeric.'
  161.                Call EXIT16 emsg                    /* Take error exit. */
  162.             End
  163.             If (refresh<1) Then refresh=99999999    /* 'Never' refresh */
  164.          End
  165.          Otherwise
  166.          emsg = 'Invalid option '''optword'''.'
  167.          Call EXIT16 emsg                                     /* Exit. */
  168.       End
  169.    End
  170. /************ Adjust Leftmargin value, if it was specified *************/
  171.    If (left_margin>0) Then left_margin = left_margin - com.indent - 1
  172.  
  173. /*********************** Get the range of lines ************************/
  174.    'TOP'
  175.    'FIND /********* REXX CROSS REFERENCE -'
  176.    If rc <> 2 & switch.xref Then 'DELETE *'
  177.    ':'start_line
  178.    target = WORD(args,1)
  179.    'LOCATE' target
  180.    If (rc=2) Then Signal PARSE_ERROR
  181.    temp = rc
  182.    'EXTRACT /LINE'
  183.    If (line.1<start_line) Then line.1 = line.1 + 1
  184.    If (line.1>start_line) Then line.1 = line.1 - 1
  185.    ':'line.1
  186.    'EXTRACT /LINE /TOF /EOF'
  187.    If (temp=1) Then Do
  188.       If (tof.1='ON') Then line.1 = line.1 + 1
  189.       If (eof.1='ON') Then line.1 = line.1 - 1
  190.    End
  191.    If (line.1>first_line) Then Do
  192.       last_line = line.1
  193.    End
  194.    Else Do
  195.       last_line = first_line
  196.       first_line = line.1
  197.    End
  198.  
  199. /*********************** Setup environment ***********************/
  200.    'SET ZONE 1 *'
  201.    'SET LINEND OFF'
  202.    'SET SCOPE ALL'
  203.    'SET CASE MIXED RESPECT'
  204.    'SET SCALE OFF'
  205.    'SET TABLINE OFF'
  206.  
  207. 'SET MSGMODE ON'
  208.  
  209.    curlmin = 3
  210.    curlmax = 22
  211.    curll   = curlmin
  212.    'SET CURLINE ON' curlmin
  213.  
  214. /****************** This is the main processing loop *******************/
  215.    total_lines = 1 + last_line - first_line
  216.    If SYMBOL('REFRESH') = 'LIT' Then refresh = MIN(50,SIZE.1())
  217.    processed = 0
  218.    Do linecnt=first_line To last_line
  219.       processed = processed + 1
  220.       switch.endtoken = switch.set      /* Check if end is first token */
  221.       switch.comment_only = switch.reset
  222.       ':'linecnt
  223.       'EXTRACT /CURLINE'
  224.       raw_line = curline.3
  225.       first_char = left(strip(raw_line),1)
  226.       If raw_line='' | (fext.1() = 'KML' & first_char = '*') Then Do
  227.          curll = curll + 1
  228.          Iterate linecnt
  229.       End
  230.       If (\switch.search) Then s = STRIP(raw_line); Else s = raw_line
  231.       com.linenum = linecnt          /* Line number to be used in XREF */
  232.       out_string = ''                     /* Work area for output line */
  233.       com.delim = ''                              /* Current delimiter */
  234.       com.offset = left_margin + com.indent*com.nest,/* Current offset */
  235.         + indent_thenelse
  236.       p. = ''; pindex = 1                     /* Tokenized output line */
  237.       Do While (s<>'')
  238.          If (switch.search) Then Do
  239.             Parse Var s s1 (search_key) s +0
  240.             If (search_key==c_astslash) Then Do
  241.                /************* check for '/./' possibility **************/
  242.                Do While (s<>' & 'RIGHT(s1,1)='/')
  243.                   /** Search Found an imbedded comment instead of end **/
  244.                   Parse Var s +1 s
  245.                   Parse Var s s2 (search_key) s +0
  246.                   s1 = s1'*'s2
  247.                End
  248.                Parse Var s1 . (c_slashast) s2 +0
  249.                Do While (s2<>'')
  250.                   /************* Found an imbedded comment *************/
  251.                   searchkey_cnt.search_key = searchkey_cnt.search_key + 1
  252.                   searchkey_list.search_key = linecnt,
  253.                     searchkey_list.search_key
  254.                   Parse Var s2 (c_slashast) (c_slashast) s2 +0
  255.                End
  256.             End
  257.             p.pindex = p.pindex || s1
  258.             If (s<>'') Then Do
  259.                /************** Found the ending delimiter **************/
  260.                p.pindex = p.pindex || search_key
  261.                s = SUBSTR(s,LENGTH(search_key)+1)
  262.                searchkey_cnt.search_key = searchkey_cnt.search_key - 1
  263.                searchkey_list.search_key =,
  264.                  DELWORD(searchkey_list.search_key,1,1)
  265.                If (searchkey_cnt.search_key<=0) Then Do
  266.                   If (search_key==c_astslash) Then pindex = pindex + 1
  267.                   Else Do
  268.                      com.delim = search_key
  269.                      switch.literal = switch.set
  270.                      com.tokennum = com.tokennum + 1
  271.                      com.last_token = s1
  272.                   End
  273.                   switch.search = switch.reset; search_key = ''
  274.                End
  275.             End
  276.             Iterate
  277.          End
  278.          /**************** looking for comment or quote ****************/
  279.          Parse Var s s1a (c_slashast) s1b +0
  280.          Parse Var s s2a (c_squote) s2b +0
  281.          Parse Var s s3a (c_dquote) s3b +0
  282.          Select
  283.             When (LENGTH(s1a)<LENGTH(s2a) & LENGTH(s1a)<LENGTH(s3a)) Then
  284.               Do
  285.                /************* Found the start of a comment *************/
  286.                switch.search = switch.set; search_key = c_astslash
  287.                searchkey_cnt.search_key = searchkey_cnt.search_key + 1
  288.                searchkey_list.search_key = linecnt,
  289.                  searchkey_list.search_key
  290.                p.pindex = p.pindex || SCAN(s1a)
  291.                pindex = pindex + 1
  292.                p.pindex = p.pindex || c_slashast
  293.                s = SUBSTR(s1b,3)
  294.             End
  295.             When (LENGTH(s3a)<LENGTH(s2a) | s2b<>'') Then Do
  296.                /********* Found the start of a literal string **********/
  297.                If (LENGTH(s3a)<LENGTH(s2a)) Then Do
  298.                   search_key = c_dquote
  299.                   s2a = s3a
  300.                   s2b = s3b
  301.                End
  302.                Else search_key = c_squote
  303.                Parse Var s2b (search_key) s1 (search_key) s +0
  304.                p.pindex = p.pindex || SCAN(s2a) || search_key || s1
  305.                If (s<>'') Then Do
  306.                   p.pindex = p.pindex || search_key
  307.                   s = SUBSTR(s,2)
  308.                   com.delim = search_key
  309.                   switch.literal = switch.set
  310.                   com.tokennum = com.tokennum + 1
  311.                   com.last_token = search_key || s1 || search_key
  312.                   search_key = ''
  313.                   If (LEFT(s,1)='(') Then Do      /* quoted function */
  314.                      s1 = FUNCTION(s1)              /* capitalize it   */
  315.                      j = POS(com.last_token,p.pindex)
  316.                      p.pindex = OVERLAY(TRANSLATE(com.last_token),p.pindex,j)
  317.                   End
  318.                End
  319.                Else Do
  320.                   searchkey_cnt.search_key = searchkey_cnt.search_key + 1
  321.                   searchkey_list.search_key = linecnt,
  322.                     searchkey_list.search_key
  323.                   switch.search = switch.set
  324.                End
  325.                switch.signalonoffv = switch.reset
  326.             End
  327.             Otherwise                        /* Just process remainder */
  328.             p.pindex = p.pindex || SCAN(s)
  329.             s = ''
  330.          End
  331.       End
  332.       If (p.pindex='') Then pindex = pindex - 1
  333.  
  334.       /****************** Check for continuation line ******************/
  335.       If (last_delim==',') Then com.offset = com.offset + continue_indent
  336.       If (com.offset<0 | switch.skip) Then com.offset = 0
  337.  
  338.       /* No further indenting if still searching for ending delimiter **/
  339.       If (switch.search) Then switch.skip = switch.set
  340.  
  341.       /****************** Justify comments as needed *******************/
  342.       If (p.1='' & p.2<>'') Then Do
  343.          If (switch.coml) Then Do
  344.             com.offset = 0
  345.             switch.skip = switch.set   /* Do not adjust comment indent */
  346.             p.1 = LEFT('',LENGTH(raw_line)-LENGTH(STRIP(raw_line,'L')))
  347.          End
  348.          Else Do
  349.             /******* Do not re-indent already indented comments. *******/
  350.             If (SUBSTR(raw_line,com.offset+1,2)==c_slashast) Then
  351.               switch.skip = switch.set
  352.          End
  353.       End
  354.       p.1 = LEFT('',com.offset) || p.1
  355.       out_string = ''
  356.       Do i=1 To pindex
  357.          out_string = out_string || p.i
  358.       End
  359.       len1 = LENGTH(out_string)
  360.       If (len1>1) Then Do
  361.          If (SUBSTR(out_string,len1-1,2)==c_astslash &,
  362.            switch.comrjust & \switch.search) Then Do
  363.             If (s1a='') Then switch.comment_only = switch.set
  364.             /****************** Right Adjust Comment *******************/
  365.             i=POS(c_slashast,out_string)
  366.             If (i>1) Then Do           /* '/.' is to right of column 1 */
  367.                comment=SUBSTR(out_string,i)
  368.                line=STRIP(SUBSTR(out_string,1,i-1),'T')
  369.                If (line<>'') Then Do       /* More than just a comment */
  370.                   i=LENGTH(line)
  371.                   If (i+LENGTH(comment)<right_margin) Then Do
  372.                      out_string = line,    /* Adjust comment when room */
  373.                        RIGHT(comment,right_margin-LENGTH(line)-1)
  374.                   End
  375.                End
  376.             End
  377.          End
  378.       End
  379.  
  380.       /***************** Replace the line in the file ******************/
  381.       If (out_string\==raw_line) Then Do
  382.          'REPLACE' out_string
  383.          /******** Check if new line was too long for the file *********/
  384.          If (rc=3) Then Do
  385.             'REPLACE' raw_line
  386.             'EXTRACT /ALT'
  387.             'SET ALT' alt.1-2 alt.2-2
  388.          End
  389.       End
  390.       If ((pindex>2 | p.1<>'')) Then last_delim = com.delim
  391.       If (com.delim<>',') Then Do
  392.          If (\switch.comment_only) Then Do
  393.             switch.thenelse = ,
  394.               ((com.last_keyword='then' | com.last_keyword='else'),
  395.               & com.tokennum=com.last_key_num)
  396.             If (switch.thenelse) Then
  397.               indent_thenelse = indent_thenelse + thenelse_indent
  398.             Else indent_thenelse = 0
  399.          End
  400.          switch.signalonoffv = switch.reset
  401.          com.tokennum = 0
  402.          com.last_key_num = 0
  403.          com.last_keyword = ''
  404.          com.last_token = ''
  405.          If (\switch.search) Then switch.skip = switch.reset
  406.       End
  407.       Else If (\switch.thenelse) Then indent_thenelse = 0
  408.       Else Do
  409.          curll = curll + 1
  410.          If (curll>curlmax) Then curll = curlmin
  411.          'SET CURLINE ON' curll
  412.       End
  413.       If (linecnt%refresh=linecnt/refresh) Then Do
  414.          reserved = 1
  415.          msg = CENTER(linecnt 'of' total_lines 'lines processed so far . . .',80)
  416.          'SET RESERVED 11 YELLOW ON RED' msg
  417.          'COMMAND REFRESH'
  418.       End
  419.    End linecnt                                        /* End main loop */
  420.  
  421. /******************* Check for Unbalanced delimiters *******************/
  422.    'SET MSGMODE ON'
  423.    If (com.endlist<>'') Then
  424.      'EMSG Unbalanced "END"s detected at:' com.endlist
  425.    If (com.dolist<>'') Then Do
  426.       temp = ''
  427.       Do i=1 To WORDS(com.dolist)
  428.          temp = WORD(com.dolist,i) temp
  429.       End
  430.       'EMSG Unbalanced "DO"s or "SELECT"s at:' temp
  431.    End
  432.    If (searchkey_list.c_astslash<>'') Then Do
  433.       temp = ''
  434.       Do i=1 To WORDS(searchkey_list.c_astslash)
  435.          temp = WORD(searchkey_list.c_astslash,i) temp
  436.       End
  437.       'EMSG Unbalanced comments at:' temp
  438.    End
  439.    If (searchkey_list.c_squote<>'') Then Do
  440.       temp = ''
  441.       Do i=1 To WORDS(searchkey_list.c_squote)
  442.          temp = WORD(searchkey_list.c_squote,i) temp
  443.       End
  444.       'EMSG Unbalanced "''"s at:' temp
  445.    End
  446.    If (searchkey_list.c_dquote<>'') Then Do
  447.       temp = ''
  448.       Do i=1 To WORDS(searchkey_list.c_dquote)
  449.          temp = WORD(searchkey_list.c_dquote,i) temp
  450.       End
  451.       "EMSG Unbalanced '""'s At:" temp
  452.    End
  453.  
  454. /******* Finish up.  Write the cross reference stuff. *******/
  455.    If \switch.xref Then Signal EXIT
  456.    reserved = 1
  457.    'SET MSGMODE OFF'
  458.    ':'start_line                  /* Re-position to line we started at */
  459.    msg = CENTER('Creating cross reference. . .',80)
  460.    'SET RESERVED 11' msg
  461.    'REFRESH'
  462.    timestamp = STREAM(FILEID.1(),'C','Query datetime')
  463.    timestamp = TRANSLATE(timestamp,'/','-')
  464.    fdate = DATE('U'); ftime = TIME()
  465.    pad = LEFT('',24)
  466.  
  467.    temp=' 1'||pad||'/********* REXX CROSS REFERENCE - Created:',
  468.      fdate ftime' *********'
  469.    Call LINEOUT FNAME.1()'.REF',temp
  470.    temp='99'||pad||CENTER('END OF' FILEID.1() 'CROSS REFFERENCE',70,'*') || '*/'
  471.    Call LINEOUT FNAME.1()'.REF',temp
  472.    temp=' 2'||pad||CENTER('for file ' FILEID.1() 'Dated:',
  473.      timestamp,70,'*')
  474.    Call LINEOUT FNAME.1()'.REF',temp
  475.    temp = ' 3'
  476.    Call LINEOUT FNAME.1()'.REF',temp
  477.    pad = LEFT(' ',24)
  478.    temp = ' 4' || pad || '---- VARIABLES ----'
  479.    Call LINEOUT FNAME.1()'.REF',temp
  480.    temp = ' 5 '
  481.    Call LINEOUT FNAME.1()'.REF',temp
  482.    temp = ' 5' || pad || '---- LABELS ----'
  483.    Call LINEOUT FNAME.1()'.REF',temp
  484.    temp = ' 6 '
  485.    Call LINEOUT FNAME.1()'.REF',temp
  486.    temp = ' 6' || pad || '---- FUNCTIONS ----'
  487.    Call LINEOUT FNAME.1()'.REF',temp
  488.  
  489. /***********************************************************************\
  490.  * There are the following XREF variables:                             *
  491.  * XREF.LABCNT                                                         *
  492.  * XREF.LAB.i                                                          *
  493.  * XREF.CNT.varname.                                                   *
  494.  * XREF.REF.varname.i                                                  *
  495.  *                                                                     *
  496.  * XREF.LABCNT has the total count of labels found                     *
  497.  * XREF.LAB.i  is a list of labels in the order that they were found   *
  498.  *       they are of the form xx string                                *
  499.  *       xx = ' 4' => variable                                         *
  500.  *            ' 5' => label                                            *
  501.  *            ' 6' => subroutine                                       *
  502.  *       xx is also used to control the sorting on the final listing   *
  503.  * XREF.CNT.varname has the total count of occurrences of varname      *
  504.  * XREF.REF.varname.i is a list of line number references for varname  *
  505.  * XREF.REF.varname.0 is the first occurence where a label is defined  *
  506. \***********************************************************************/
  507.  
  508.    outcnt = 0                        /* Initialize output line counter */
  509.    Do i=1 To xref.labcnt
  510.       varname = xref.lab.i
  511.       /* Label for SORT */
  512.       Parse Var varname sortkey 3 varlabel
  513.       sortkey2 = LEFT(varname,23)
  514.       /* Label */
  515.       /****** Check for a label that's too long for a single line ******/
  516.       If (LENGTH(varlabel)>=19) Then Do
  517.          Call LINEOUT FNAME.1()'.REF',sortkey2 || RIGHT(outcnt,3) ||,
  518.            varlabel
  519.          outcnt = outcnt + 1                 /* Increment line counter */
  520.          varlabel = LEFT('',18)
  521.       End
  522.       varlabel = LEFT(varlabel,18)
  523.       temp3 = ''
  524.       /**************** Check for function definitions *****************/
  525.       If (sortkey=' 6') Then Do
  526.          temp = 'REF.' || OVERLAY(' 5',varname,1) || '.' || 0
  527.          If (xref.temp<>0) Then temp3 = temp3 xref.temp
  528.       End
  529.  
  530.       /************ Build table of locations - 10 to a line ************/
  531.       j2 = xref.cnt.varname
  532.       Do j=1 To j2 By 10
  533.          Do k=j To j+9 Until (k=j2)
  534.             temp = 'REF.' || varname || '.' || k
  535.             temp3 = temp3 xref.temp
  536.          End k
  537.          temp3 = sortkey2 || RIGHT(outcnt,3) || varlabel temp3
  538.          Call LINEOUT FNAME.1()'.REF',temp3
  539.          outcnt = outcnt + 1                 /* Increment line counter */
  540.          temp3 = ''
  541.          varlabel = LEFT('',18)
  542.       End j
  543.    End i
  544.    Call LINEOUT FNAME.1()'.REF'
  545.  
  546. /*************************** Sort into order ***************************/
  547.    'SET RESERVED 11' CENTER('Sorting cross reference. . .',80)
  548.    'REFRESH'
  549.    'BOTTOM'
  550.    'GET' FNAME.1()'.REF'
  551.    ':'1+last_line
  552.    'SORT * 1 26'
  553.  
  554. /*********************** Remove sort search_key ************************/
  555.    'SET ARBCHAR ON $'
  556.    'SET ZONE 1 26'
  557.    'CHANGE /$//*'
  558.    'DOSQUIET ERASE' FNAME.1()'.REF'
  559.    xreffed = 1
  560.    Signal EXIT
  561.  
  562. /******************* Internal routines and functions *******************/
  563.  
  564. /******* SCAN - Look for delimiters and break line into tokens. ********/
  565. /** Delimiters such as <> will not be recognized as such, but we are ***/
  566. /********** not checking syntax, only looking for delimiters. **********/
  567.  
  568. SCAN: Procedure Expose switch. com. xref. keywords.
  569.    Parse Arg string
  570.    If (string='') Then Return string
  571.  
  572. if substr(string,1,1) = ':' then return LABEL(string)
  573.  
  574.  
  575.    delims = ',=()\|&+-;:></%* '
  576.    return_string = ''
  577.    switch.eot = switch.reset
  578.    Do While (string<>'')
  579.       iw = VERIFY(string,delims,'M')
  580.       If (iw=0) Then Do
  581.          com.delim = ''
  582.          switch.eot = switch.set
  583.          return_string = return_string || SCANTOKEN(string)
  584.          string = ''
  585.       End
  586.       Else Do
  587.          com.delim = SUBSTR(string,iw,1)
  588.          Parse Var string token (com.delim) string
  589.          return_string = return_string || SCANTOKEN(token) || com.delim
  590.          iw = VERIFY(string'a',delims)
  591.          If (iw>1) Then Do
  592.             return_string = return_string || SUBSTR(string,1,iw-1)
  593.             com.delim = RIGHT(STRIP(return_string,'T'),1)
  594.             If (POS(com.delim,delims)=0) Then com.delim = ''
  595.             string = SUBSTR(string,iw)
  596.          End
  597.          If (com.delim==';') Then Do
  598.             switch.signalonoffv = switch.reset
  599.             com.tokennum = 0
  600.             com.last_keyword = ''
  601.             com.last_key_num = 0
  602.             com.last_token = ''
  603.          End
  604.       End
  605.       switch.literal = switch.reset
  606.    End
  607.    Return return_string
  608.  
  609. /* SCANTOKEN - Classify TOKEN as KEYWORD, VARIABLE, LABEL, or FUNCTION.
  610.    Currently, keywords are not scanned exactly as the language
  611.    specifies,  ie. 'FUZZ' is always considered a keyword, not just
  612.    when if follows 'NUMERIC'.
  613.    Keywords are checked for last, in case a label or function has the
  614.    same name as a keyword.
  615.    Additional tables are provided if you wish to be more exacting.     */
  616.  
  617. SCANTOKEN: Procedure Expose switch. com. xref. keywords.
  618.    Parse Arg string
  619.    If (string='') Then Return string
  620.    return_string = ''
  621.  
  622.    If (LOWER(string)<>'end') Then
  623.      switch.endtoken = switch.reset     /* END token not first on line */
  624.    Do i=1 To WORDS(string)
  625.       com.tokennum = com.tokennum + 1
  626.       word1 = SUBWORD(string,i)
  627.       temp = LOWER(word1)
  628.       Select
  629.          When (DATATYPE(word1)='NUM' | SYMBOL(word1)='BAD') Then
  630.            /* Ignore whatever it is */
  631.            return_string = return_string word1
  632. /*          When (com.delim=':') Then */
  633. when com.delim = ':' | (fext.1() = 'KML' & substr(word1,1,1) = ':') then
  634.            /* Things before ':'s are assumed to be LABELs */
  635.            return_string = return_string LABEL(word1)
  636.          When (com.delim='(') Then
  637.            /* Things before '(' (no BLANKs) are assumed to be FUNCTIONs*/
  638.            return_string = return_string FUNCTION(word1)
  639.          When ((com.last_token=='signal' | com.last_token=='call'),
  640.            & com.tokennum>com.last_key_num) Then Do
  641.            /* Things after 'SIGNAL' and 'CALL' are assumed to be LABELs*/
  642.             If (com.last_token=='signal' & ,
  643.               (temp=='on' | temp=='off' | temp=='value')) Then Do
  644.                switch.signalonoffv = switch.set
  645.                return_string = return_string KEYWORD(word1)
  646.             End
  647.             Else return_string = return_string LABEL(word1)
  648.          End
  649.          When WORDPOS(temp,keywords.scantok)>0 Then Do
  650.             If (switch.signalonoffv) Then Do
  651.                switch.signalonoffv = switch.reset
  652.                return_string = return_string LABEL(word1)
  653.             End
  654.             Else return_string = return_string KEYWORD(word1)
  655.          End
  656.          Otherwise return_string = return_string VARIABLE(word1)
  657.          switch.signalonoffv = switch.reset
  658.       End
  659.       com.last_token = temp
  660.       switch.literal = switch.reset
  661.    End
  662.    return_string = STRIP(return_string)
  663.    Return return_string
  664.  
  665. KEYWORD: Procedure Expose switch. com. xref. keywords.
  666.    Parse Arg word1
  667.    keyword = LOWER(word1)
  668.    com.last_keyword = keyword
  669.    com.last_key_num = com.tokennum
  670.    If (switch.keyword_case) Then Do           /* Capitalize 1st letter */
  671.       word1 = LOWER(word1)
  672.       temp = TRANSLATE(SUBSTR(word1,1,1))
  673.       word1 = OVERLAY(temp,word1,1,1)
  674.    End
  675.    Select
  676.       When (keyword='select') | (keyword='do') Then Do
  677.          com.nest = com.nest + 1
  678.          com.dolist = com.linenum com.dolist
  679.       End
  680.       When (keyword='end') Then Do
  681.          com.nest = com.nest - 1
  682.          If (switch.endtoken) Then com.offset = com.offset - com.indent
  683.          If (com.dolist='') Then com.endlist = com.endlist com.linenum
  684.          Else com.dolist = DELWORD(com.dolist,1,1)
  685.       End
  686.       Otherwise Nop
  687.    End
  688.    Return word1
  689.  
  690. VARIABLE: Procedure Expose switch. com. xref. keywords.
  691.    Parse Arg word1
  692.    If (switch.variable_case) Then word1 = LOWER(word1)
  693. /* Next DO loop added by Flores */
  694.    If (switch.xref) Then Do
  695.       sortkey = ' 4' || word1
  696.       If (xref.cnt.sortkey=0) Then Do
  697.          xref.labcnt = xref.labcnt + 1
  698.          temp = 'LAB.' || xref.labcnt
  699.          xref.temp = sortkey
  700.       End
  701.       xref.cnt.sortkey = xref.cnt.sortkey + 1
  702.       temp2 = com.linenum
  703.       If (com.tokennum=1) Then Do
  704.          temp = 'REF.' || sortkey || '.' || 0
  705.          /* Flag lines where variable is the first token (an assignment) **/
  706.          temp2 = '*' || temp2
  707.          xref.temp = temp2
  708.       End
  709.       temp = 'REF.' || sortkey || '.' || xref.cnt.sortkey
  710.       xref.temp = temp2
  711.    End
  712.    Return word1
  713.  
  714. LABEL: Procedure Expose switch. com. xref. keywords.
  715.    Parse Arg word1
  716.    If (switch.label_case) Then word1 = TRANSLATE(word1)
  717.    If (com.tokennum<=1) Then com.offset = 0
  718.    If (switch.xref) Then Do
  719.       sortkey = ' 5' || word1
  720.       If (xref.cnt.sortkey=0) Then Do
  721.          xref.labcnt = xref.labcnt + 1
  722.          temp = 'LAB.' || xref.labcnt
  723.          xref.temp = sortkey
  724.       End
  725.       xref.cnt.sortkey = xref.cnt.sortkey + 1
  726.       temp2 = com.linenum
  727.       If (com.delim==':') Then Do
  728.          temp = 'REF.' || sortkey || '.' || 0
  729.          /******* Flag line for possible use as FUNCTION definition *******/
  730.          temp2 = '*' || temp2
  731.          If (xref.temp=0) Then xref.temp = temp2
  732.       End
  733.       temp = 'REF.' || sortkey || '.' || xref.cnt.sortkey
  734.       xref.temp = temp2
  735.    End
  736.    Return word1
  737.  
  738. FUNCTION: Procedure Expose switch. com. xref. keywords.
  739.    Parse Arg word1
  740.    If (switch.function_case) Then Do
  741.       word1 = TRANSLATE(word1)
  742.       /************** Check for system defined functions ***************/
  743.       If WORDPOS(word1,keywords.func)>0 Then Do
  744.          temp  = TRANSLATE(word1)
  745.          word1 = OVERLAY(temp,word1,1,1)
  746.       End
  747.    End
  748.    If (switch.xref) Then Do
  749.       If (LEFT(word1,2)='||') Then sortkey = ' 6'||SUBSTR(word1,3)
  750.       Else sortkey = ' 6'word1
  751.       If (xref.cnt.sortkey=0) Then Do
  752.          xref.labcnt = xref.labcnt + 1
  753.          temp = 'LAB.' || xref.labcnt
  754.          xref.temp = sortkey
  755.       End
  756.       xref.cnt.sortkey = xref.cnt.sortkey + 1
  757.       temp = 'REF.' || sortkey || '.' || xref.cnt.sortkey
  758.       xref.temp = com.linenum
  759.    End
  760.    Return word1
  761.  
  762. /***********************************************************************\
  763.  *     Internal function 'GETOPTWORD'                                  *
  764.  *        Arguments are - single token, possibly abbreviated,          *
  765.  *                      - string of valid full-length operands with    *
  766.  *                        the length coded as the first character.     *
  767.  *        If first argument is found, the full-length token is         *
  768.  *        returned.  If not found, return original first argument.     *
  769. \***********************************************************************/
  770. GETOPTWORD: Procedure
  771.    Parse Arg option, template
  772.    nwords = WORDS(template)
  773.    Do k=1 To nwords
  774.       optword = WORD(template,k)
  775.       len = LEFT(optword,1)
  776.       optword = SUBSTR(optword,2)
  777.       If (LENGTH(option)>LENGTH(optword)) Then Iterate
  778.       If (ABBREV(optword,option,len)) Then Return optword
  779.    End
  780.    Return option
  781.  
  782. LOWER:                                   /* Return lower case of parms */
  783.    Parse Arg args
  784.    Return TRANSLATE(args,'abcdefghijklmnopqrstuvwxyz','ABCDEFGHIJKLMNOPQRSTUVWXYZ')
  785.  
  786. EXIT16: Procedure
  787.    Parse Arg e_msg
  788.    'SET MSGMODE ON'
  789.    'EMSG' e_msg
  790.    rtncode = 16
  791. EXIT:
  792.    If reserved = 1 then 'SET RESERVED 11 OFF'
  793.    'RESTORE'
  794.    ':'start_line
  795.    'MSG REXXREF finished.'
  796.    If xreffed = 1 Then 'MSG Cross reference starts at line' 1+last_line'.'
  797.    Exit rtncode
  798.  
  799. PARSE_ERROR:
  800.    emsg = 'Error while parsing arguments:' args
  801.    Call EXIT16 emsg
  802.  
  803. EXPLAIN:
  804.    'SET MSGMODE ON'
  805.    'SET MSGLINE ON 2 22 OVERLAY'
  806.    'MSG'
  807.    'MSG REXXREF <target <(options>>'
  808.    'MSG'
  809.    'MSG This KEDIT macro reformats and cross references'
  810.    'MSG Rexx and Kexx files.'
  811.    'MSG'
  812.    'MSG See REXXREF.DOC for details.'
  813.    'MSG'
  814.    Signal EXIT
  815.