/* REXX exec/edit macro to convert COBOL to 'HILITE'd HTML            */
/*** trace ?r ***************************************************** \| *
*               (C) Copyright Robert AH Prins, 2007-2016               *
************************************************************************
*  ------------------------------------------------------------------  *
* | Date       | By   | Remarks                                      | *
* |------------+------+----------------------------------------------| *
* |            |      |                                              | *
* |------------+------+----------------------------------------------| *
* | 2016-11-18 | RAHP | Multiple updates/simplifications             | *
* |------------+------+----------------------------------------------| *
* | 2013-09-16 | RAHP | Support inline "*>" comments                 | *
* |------------+------+----------------------------------------------| *
* | 2012-06-25 | RAHP | Add IP address                               | *
* |------------+------+----------------------------------------------| *
* | 2010-10-28 | RAHP | Upgrade to Enterprise Cobol 4.2              | *
* |------------+------+----------------------------------------------| *
* | 2009-07-27 | RAHP | Use pop-up on ISPF to display progress       | *
* |------------+------+----------------------------------------------| *
* | 2009-07-02 | RAHP | Add selection for short CSS 'em' colors      | *
* |------------+------+----------------------------------------------| *
* | 2009-06-23 | RAHP | - translate entities in comment lines        | *
* |            |      | - assume non-numerics in col 73-80 comment   | *
* |            |      | - replace '"' by "                      | *
* |------------+------+----------------------------------------------| *
* | 2009-04-22 | RAHP | Update comment                               | *
* |------------+------+----------------------------------------------| *
* | 2009-04-01 | RAHP | Add font selection for generated HTML        | *
* |------------+------+----------------------------------------------| *
* | 2009-02-09 | RAHP | RACF problem with 'html' extension @ NVSM    | *
* |------------+------+----------------------------------------------| *
* | 2007-09-24 | RAHP | Remove sequence numbers                      | *
* |------------+------+----------------------------------------------| *
* | 2007-09-20 | RAHP | Initial version (copy of EHIPLI)             | *
* |------------+------+----------------------------------------------| *
************************************************************************
* EHICOBOL is a REXX exec/edit macro that analyses COBOL code and      *
* builds a HTML file with the color attributes as used by ISPF Edit.   *
*                                                                      *
* This file can be transferred to the PC by using ISPF Workstation     *
* Agent. In addition the exec might invoke the Windows application     *
* associated with file extension ".html"                               *
*                                                                      *
* The exec runs as ISPF edit macro or might be used as line command    *
* on the extended member list of ISPF List Utility (usually menu       *
* option 3.4).                                                         *
*                                                                      *
* In addition the exec can be invoked on the command line. In this     *
* case the dataset name has to be supplied as invocation parameter.    *
*                                                                      *
* Special thanks to Ken MacKenzie of Pramerica Systems Ireland Ltd for *
* helping me to get to grips with some of the intricacies of COBOL.    *
*                                                                      *
* t_rex will contain the environment. It can be:                       *
*                                                                      *
* - TSO     - TSO/ISPF                                                 *
* - MVS     - z/OS (PGM=IRXJCL)                                        *
* - SYSTEM  - Regina                                                   *
* - COMMAND - PC DOS 7/2000                                            *
* - CMD     - Object REXX (OS/2, Windoze)                              *
************************************************************************
* Send questions, suggestions and/or bug reports to:                   *
*                                                                      *
* robert@prino.org / robert.ah.prins@gmail.com                         *
*                                                                      *
* Robert AH Prins                                                      *
* Taboralaan 46                                                        *
* 8400 Oostende                                                        *
* Belgium                                                              *
************************************************************************
* This program is free software: you can redistribute it and/or        *
* modify it under the terms of the GNU General Public License as       *
* published by the Free Software Foundation, either version 3 of       *
* the License, or (at your option) any later version.                  *
*                                                                      *
* This program is distributed in the hope that it will be useful,      *
* but WITHOUT ANY WARRANTY; without even the implied warranty of       *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the         *
* GNU General Public License for more details.                         *
*                                                                      *
* You should have received a copy of the GNU General Public License    *
* along with this program. If not, see <http://www.gnu.org/licenses/>  *
***********************************************************************/
parse source source
parse value source with . . moi . . . cmdenv aspace .

t_rex = address()

if t_rex  = 'TSO' &,
   aspace = 'ISPF' then
  do
    "ispexec vget (zenvir)"
    envir = strip(substr(zenvir, 17, 8))
  end
else
  envir = 'OTHER'

parse arg idsn

call get_source                /* Read the COBOL program source       */
call init_vars                 /* Initialize the global variables     */
call build_html                /* Now go on and build the HTML output */

call ehisupp 'generate_output,'sep','htmlout  || sep ||,
                                     odsn     || sep ||,
                                     title    || sep ||,
                                     header   || sep ||,
                                     footer   || sep ||,
                                     htmlfont

if t_rex  = 'TSO' &,
   aspace = 'ISPF' then
  if envir \= 'BATCH' then
    do
      /*****************************************************************
      * Show the resulting dataset, if desired                         *
      *****************************************************************/
      if view_html = 'YES' then
        "ispexec view dataset("odsn")"

      /*****************************************************************
      * Transfer the html file to the PC                               *
      *****************************************************************/
      if xfer_wsa = 'YES' then
        call ehisupp 'xfer_and_show_html,'sep','dir_pc   || sep ||,
                                                htmlfile || sep ||,
                                                odsn     || sep ||,
                                                ipaddr   || sep ||,
                                                start_browser
    end
  else
    do
      if macmode then
        "isredit end"
    end
exit

/***********************************************************************
* TRANSLATE_ENTITIES                                                   *
*                                                                      *
* This procedure translates special characters to HTML entities        *
***********************************************************************/
translate_entities: procedure expose special_chars special_html
  parse arg in

  out = ''

  if translate(in, ' ', special_chars) = in then
    out = in
  else
    do while in \== ''
      c = left(in, 1)
      k = wordpos(c, special_chars)

      if k \= 0 then
        out = out || word(special_html, k)
      else
        out = out || c

      in = substr(in, 2)
    end
return out

/***********************************************************************
* GET_SOURCE:                                                          *
*                                                                      *
* Read the COBOL source                                                *
***********************************************************************/
get_source:
  macmode = 0
  rxdata. = ''
  rxdata  = ''
  pgm     = ''

  select
    when t_rex = 'TSO' then call get_source_tso
    when t_rex = 'MVS' then call get_source_mvs
    otherwise               call get_source_pc
  end
return

/***********************************************************************
* GET_SOURCE_TSO:                                                      *
*                                                                      *
* Read the text when running under TSO                                 *
***********************************************************************/
get_source_tso:
  if aspace = 'ISPF' then
    "isredit macro (parm) NOPROCESS"
  else
    rc = 4

  /*********************************************************************
  * Running as edit macro                                              *
  *********************************************************************/
  if rc = 0 then
    do
      macmode = 1

      if parm = '?' then
        do
          "isredit ehihelp" moi
          exit
        end

      "isredit process range HI"
      if rc <= 4 then
        do
          "isredit (ZF) = linenum .zfrange"
          "isredit (ZL) = linenum .zlrange"
        end
      else
        do
          "isredit ehihelp" moi
          exit
        end

      "isredit (DSN) = dataset"
      "isredit (MEM) = member"

      if mem = '' then
        idsn = "'" || dsn || "'"
      else
        do
          pgm  = mem
          idsn = "'" || dsn || '(' || mem || ")'"
        end

      /*****************************************************************
      * Read the full source                                           *
      *****************************************************************/
      i = 0
      do j = +zf to +zl
        "isredit (DATALINE) = line" j
        if length(dataline) = 80 &,
           datatype(right(dataline, 8)) = 'NUM' then
          dataline = substr(dataline, 1, 72)

        i        = i + 1
        rxdata.i = strip(dataline, 'T')
      end

      rxdata.0 = i
      olines   = rxdata.0
    end
  /*********************************************************************
  * Running as TSO command                                             *
  *********************************************************************/
  else
    do
      if idsn = '' then
        do
          msg =     left('Error - No dataset name passed', 75)
          msg = msg left(moi 'can be used as an edit macro or',
                         'as a line command on the ISPF', 75)
          msg = msg left('dataset list utility. In both cases the',
                         'dataset name will be automatically', 75)
          msg = msg left('determined.', 75)
          msg = msg left('If you call' moi 'on the command line you',
                         'have to pass the name of the', 75)
          msg = msg left('dataset to be processed, e.g.', 75)
          msg = msg left('Command ===>' moi,
                         '''my.cobol.dataset(test)''', 75)

          zedsmsg = ''
          zedlmsg = msg

          if t_rex  = 'TSO'  &,
             aspace = 'ISPF' &,
             envir \= 'BATCH' then
            "ispexec setmsg msg(ISRZ001)"
          else
            do while msg \= ''
              say left(msg, 75)
              msg = substr(msg, 76)
            end

          exit 8
        end

      /*****************************************************************
      * Force single quotes around dataset name and check if it's OK   *
      *****************************************************************/
      idsn = "'" || strip(idsn,, '''') || "'"

      if sysdsn(idsn) \= 'OK' then
        do
          say 'Error - Dataset' idsn 'could not be found'
          exit 8
        end

      /*****************************************************************
      * Extract member name, if present                                *
      *****************************************************************/
      parse var idsn . '(' mem ')'

      if mem \= '' then
        pgm = mem

      /*****************************************************************
      * Read the source                                                *
      *****************************************************************/
      dynlib = 'dyn'random(99999)

      "alloc f("dynlib") da("idsn") shr reu"
      if rc > 0 then
        do
          say 'Error - Dataset' idsn 'could not be allocated - rc' rc
          exit 8
        end

      "execio * diskr" dynlib "(finis)"
      if rc > 0 then
        do
          say 'Error - Dataset' idsn 'could not be read - rc' rc
          exit 8
        end

      "free f("dynlib")"

      /*****************************************************************
      * Pre-process the source, removing sequence numbers              *
      *****************************************************************/
      olines = queued()

      i = 0
      do queued()
        parse pull dataline

        if length(dataline) = 80 &,
           datatype(right(dataline, 8)) = 'NUM' then
          dataline = substr(dataline, 1, 72)

        i        = i + 1
        rxdata.i = strip(dataline, 'T')
      end
    end
return

/***********************************************************************
* GET_SOURCE_PC:                                                       *
*                                                                      *
* Read the text when running on the PC                                 *
***********************************************************************/
get_source_pc:
  if idsn = '' then
    do
      say 'Syntax:' moi 'file.cobol'
      exit 8
    end

  do i = 1 by 1 while lines(idsn)
    dataline = linein(idsn)

    if length(dataline) = 80 &,
       datatype(right(dataline, 8)) = 'NUM' then
      dataline = substr(dataline, 1, 72)

    rxdata.i = strip(dataline, 'T')
  end

  rxdata.0 = i - 1
  olines   = rxdata.0
return

/***********************************************************************
* INIT_VARS:                                                           *
*                                                                      *
* This procedure initialises the global variables                      *
***********************************************************************/
init_vars:
  /*********************************************************************
  * Parameter separator for EHISUPP exec                               *
  *********************************************************************/
  sep = x2c(00)d2c(random(2**16))x2c(ff)d2c(random(2**16))x2c(00)
  sep = translate(sep, x2c(bababababa), ' <>&"')

  /*********************************************************************
  * Get processing options                                             *
  *********************************************************************/
  opt = ehisupp('get_options,'sep','moi)
  parse value opt with view_html     (sep),
                       xfer_wsa      (sep),
                       start_browser (sep),
                       ispf_edit     (sep),
                       show_progress (sep),
                       dir_pc        (sep),
                       htmlfont      (sep),
                       ipaddr        (sep) .

  /*********************************************************************
  * Temporary output dataset                                           *
  *********************************************************************/
  if mem \= '' then
    odsn = "'" || userid() || '.' || mem || ".cobol.html'"
  else
    odsn = "'" || userid() || '.' || moi || ".cobol.html'"

  /*********************************************************************
  * Text strings for title, header and footer                          *
  *********************************************************************/
  title  = 'COBOL source:' strip(idsn,, '''')
  header = 'COBOL source:' strip(idsn,, '''')
  now    = date('S')
  now    = left(now, 4)'-'substr(now, 5, 2)'-'right(now, 2)'T'time()
  footer = 'Generated on' now 'by' userid() 'with' moi

  /*********************************************************************
  * Name of generated html file on PC                                  *
  *********************************************************************/
  if pgm \= '' then
    htmlfile = pgm || '.html'
  else
    htmlfile = 'cobolpgm.html'

  /*********************************************************************
  * HTML colors                                                        *
  *                                                                    *
  * - lime(green) - default                                            *
  * - red         - keywords                                           *
  * - white       - quoted strings                                     *
  * - aqua(turq)  - comments                                           *
  * - yellow      - speceal characters                                 *
  * - blue        - directives                                         *
  * - blue        - in EXEC statements                                 *
  *********************************************************************/
  col_dft        = '<em class="l">'                        /* lime    */
  col_key        = '<em class="r">'                        /* red     */
  col_str        = '<em class="w">'                        /* white   */
  col_com        = '<em class="t">'                        /* turq    */
  col_spc        = '<em class="y">'                        /* yellow  */
  col_dir        = '<em class="b">'                        /* blue    */
  col_exe        = '<em class="b">'                        /* blue    */

  /*********************************************************************
  * Colors for nested parentheses                                      *
  *********************************************************************/
  col_par.0      = '<em class="f">'                        /* fuchsia */
  col_par.1      = '<em class="y">'                        /* yellow  */
  col_par.2      = '<em class="w">'                        /* white   */
  col_par.3      = '<em class="r">'                        /* red     */
  col_par.4      = '<em class="t">'                        /* turq    */

  /*********************************************************************
  * HTML special characters and their defined entities                 *
  *********************************************************************/
  special_chars  = '< > & "'
  special_html   = '&lt; &gt; &amp; &quot;'

  /*********************************************************************
  * Characters to be highlighted                                       *
  *********************************************************************/
  special_hilite = '.'

  /*********************************************************************
  * Characters separating words                                        *
  *********************************************************************/
  separator      = ' ,.;'
return

/***********************************************************************
* BUILD_HTML:                                                          *
*                                                                      *
* This procedure builds the HTML output                                *
***********************************************************************/
build_html:
  /*********************************************************************
  * Load the list of COBOL keywords                                    *
  *********************************************************************/
  call build_list_of_keywords

  /*********************************************************************
  * Switches                                                           *
  *********************************************************************/
  kwbegin  = 1                  /* Do we expect a new keyword ?       */

  in_com   = 0                  /* Inside a comment                   */
  in_apost = 0                  /* Inside a '(apost) delimited string */
  in_quote = 0                  /* Inside a "(quote) delimited string */
  in_dir   = 0                  /* Inside a compiler directive        */
  in_exec  = 0                  /* Inside an EXEC ... END-EXEC group  */
  level    = 0                  /* Nested comment levels              */
  paren    = 1                  /* Nested parentheses level           */

  /*********************************************************************
  * Initialize the html output string                                  *
  *********************************************************************/
  if ispf_edit = 'ISPF' then
    htmlout = x2c(ff)ispf_edit || x2c(ff)right(olines, 6, '0')x2c(ff)
  else
    htmlout = ''

  /*********************************************************************
  * Loop over the code                                                 *
  *********************************************************************/
  lip = time('E')
  lip = 0

  /*********************************************************************
  * Process (if present) any 'CBL' or 'PROCESS' statements             *
  *********************************************************************/
  do r = 1 by 1 while translate(substr(rxdata.r, 7, 3)) = 'CBL' |,
                      translate(substr(rxdata.r, 7, 8)) = 'PROCESS'
    if left(rxdata.r, 6) = '      ' then
      seq = '      '
    else
      seq = col_spc || left(rxdata.r, 6)'</em>'

    htmlout = htmlout || seq || col_dir ||,
              translate_entities(substr(rxdata.r, 7))'</em><br>'
  end

  do r = r to rxdata.0
    kwbegin = 1
    rxdata  = rxdata.r
    lip     = r

    if left(rxdata, 6) = '      ' then
      tempout = '      '
    else
      tempout = col_spc || left(rxdata.r, 6)'</em>'

    rxdata = substr(rxdata, 7)

    /*******************************************************************
    * Display (optional) progress messages                             *
    *******************************************************************/
    if show_progress > 0 then
      if lip >                  0 &,
         lip // show_progress = 0 then
        do
          progress = 'Elapsed time' right(time('E'), 12),
                     '- lines processed' right(lip, 6)

          if t_rex  = 'TSO'  &,
             aspace = 'ISPF' then
            rc = ehisupp('monitor,'moi 'Progress,'progress)
          else
            say progress

          lip = -lip
        end

    /*******************************************************************
    * Get column 7 data                                                *
    *******************************************************************/
    c7 = left(rxdata, 1)

    /*******************************************************************
    * Process comment                                                  *
    *******************************************************************/
    if c7 = '*' |,
       c7 = '/' then
      do
        comment = strip(rxdata, 'T')

        htmlout = htmlout || tempout ||,
                  col_com || translate_entities(comment) || '</em><br>'

        iterate r
      end

    /*******************************************************************
    * Process other column 7 characters                                *
    *******************************************************************/
    tempout = tempout || c7
    tail    = substr(rxdata, 67)
    rxdata  = substr(rxdata, 2, 65)

    do while rxdata \== ''
      c1 = left(rxdata, 1)
      c2 = left(rxdata, 2)
      c3 = left(rxdata, 3)                      /* ' *>' comment      */

      /*****************************************************************
      * Is it a special character?                                     *
      *****************************************************************/
      sc = wordpos(c1, special_chars)

      /*****************************************************************
      * Is it a special hilite character?                              *
      *****************************************************************/
      sh = pos(c1, special_hilite)
      if c2 \== '. ' then
        sh = 0

      kw = ''                                   /* Initialize keyword */

      /*****************************************************************
      * If we are at the beginning of a keyword ...                    *
      *****************************************************************/
      if kwbegin            = 1 &,
         pos(c1, separator) = 0 then
        do
          parse upper var rxdata kw

          /*************************************************************
          * ... we search the next separator ...                       *
          *************************************************************/
          sep_pos = verify(kw, separator, 'M')

          /*************************************************************
          * ... and save the keyword if separator is found             *
          *************************************************************/
          if sep_pos > 0 then
            kw = left(kw, sep_pos - 1)

          kwbegin = 0
        end

      /*****************************************************************
      * If we are on a separator we keep in mind that it's the         *
      * beginning of a new keyword                                     *
      *****************************************************************/
      if pos(c1, separator) > 0 then
        kwbegin = 1

      /*****************************************************************
      * Determine the HTML attributes for the data
      *****************************************************************/
      select
        /***************************************************************
        * Spaces are kept unchanged - process multiple spaces in one   *
        * go|                                                          *
        ***************************************************************/
        when c1  == ' ' &,
             c3 \== ' *>' then
          do
            n = verify(rxdata, ' ')
            if n \= 0 then
              do
                tempout = tempout || left(rxdata, n - 1)
                rxdata  = substr(rxdata, n)
              end
            else
              do
                tempout = tempout || rxdata
                rxdata  = ''
              end
          end

        /***************************************************************
        * End of single quoted string                                  *
        ***************************************************************/
        when in_apost &,
             c1 = "'" then
            do
              in_apost = 0

              tempout  = tempout || "'</em>"
              rxdata   = substr(rxdata, 2)
            end

        /***************************************************************
        * End of double quoted string                                  *
        ***************************************************************/
        when in_quote &,
             c1 = '"' then
            do
              in_quote = 0

              tempout  = tempout || '&quot;</em>'
              rxdata   = substr(rxdata, 2)
            end

        /***************************************************************
        * Start of single quoted string                                *
        ***************************************************************/
        when c1 = "'"  &,
             \in_quote &,
             \in_com then
          do
            in_apost = 1

            tempout  = tempout || col_str"'"
            rxdata   = substr(rxdata, 2)
          end

        /***************************************************************
        * Start of double quoted string                                *
        ***************************************************************/
        when c1 = '"'  &,
             \in_apost &,
             \in_com then
          do
            in_quote = 1

            tempout  = tempout || col_str || '&quot;'
            rxdata   = substr(rxdata, 2)
          end

        /***************************************************************
        * An in-line comment                                           *
        ***************************************************************/
        when c3 == ' *>' then
          do
            tempout = tempout || col_com || ' *&gt;' ||,
                      strip(substr(rxdata, 4), "T") || '</em>'
            rxdata  = ''
          end

        /***************************************************************
        * A special character has to be translated and highlighted     *
        ***************************************************************/
        when sc > 0    &,
             sh > 0    &,
             \in_dir   &,
             \in_exec  &,
             \in_com   &,
             \in_apost &,
             \in_quote then
          do
            tempout = tempout || col_spc || word(special_html, sc) ||,
                      '</em>'
            rxdata  = substr(rxdata, 2)
          end

        /***************************************************************
        * A special character has to be translated                     *
        ***************************************************************/
        when sc > 0 then
          do
            tempout = tempout || word(special_html, sc)
            rxdata  = substr(rxdata, 2)
          end

        /***************************************************************
        * '.' End-of-Sentence character                                *
        ***************************************************************/
        when c2 = '. ' &,
             in_dir    &,
             \in_exec  &,
             \in_com   &,
             \in_apost &,
             \in_quote then
          do
            tempout = tempout || col_spc || c1'</em>'
            rxdata  = substr(rxdata, 2)
            in_dir  = 0

            select
              /*********************************************************
              * Directive followed by comment                          *
              *********************************************************/
              when kcol = 2 then
                do
                  tempout = tempout || col_com ||,
                            translate_entities(strip(rxdata, 'T')) ||,
                            '</em>'
                  rxdata  = ''
                end

              /*********************************************************
              * Directive may(3) or must(4) be followed by a '.'       *
              *********************************************************/
              when kcol = 3 |,
                   kcol = 4 then
                tempout = tempout || '</em>'

              otherwise nop
            end

            kcol = 0
          end

        /***************************************************************
        * A special character has to be highlighted                    *
        ***************************************************************/
        when sh > 0    &,
             \in_dir   &,
             \in_exec  &,
             \in_com   &,
             \in_apost &,
             \in_quote then
          do
            tempout = tempout || col_spc || c1'</em>'
            rxdata  = substr(rxdata, 2)
          end

        /***************************************************************
        * Ignore all keywords except 'END-EXEC' when in 'EXEC' mode    *
        ***************************************************************/
        when keyword.kw   \= 0 &,
             translate(kw) = 'END-EXEC' &,
             in_exec   &,
             \in_dir   &,
             \in_com   &,
             \in_apost &,
             \in_quote then
          do
            in_exec = 0
            kw      = left(rxdata, length(kw))
            tempout = tempout || kw || '</em>'
            rxdata  = substr(rxdata, length(kw) + 1)
          end

        /***************************************************************
        * It's a keyword                                               *
        ***************************************************************/
        when keyword.kw \= 0 &,
             \in_dir         &,
             \in_exec        &,
             \in_com         &,
             \in_apost       &,
             \in_quote then
          do
            kcol = keyword.kw
            kw   = left(rxdata, length(kw))

            select
              /*********************************************************
              * Followed by '. Comment'                                *
              *********************************************************/
              when kcol = 2 then
                do
                  in_dir  = 1
                  tempout = tempout || col_key
                end

              /*********************************************************
              * Followed by directive (3: '.' not req'd, 4: '.' req'd  *
              *********************************************************/
              when kcol = 3 |,
                   kcol = 4 then
                do
                  in_dir  = 1
                  tempout = tempout || col_dir
                end

              /*********************************************************
              * 'EXEC' - remain in color until 'END-EXEC'              *
              *********************************************************/
              when kcol = 5 then
                do
                  tempout = tempout || col_dir
                  in_exec = 1
                end

              otherwise
                do
                  tempout = tempout || col_key
                  kcol    = 0
                end
            end

            tempout = tempout || kw

            if kcol <= 2 then
              tempout = tempout || '</em>'

            rxdata = substr(rxdata, length(kw) + 1)
          end

        /***************************************************************
        * It's a left parenthesis                                      *
        ***************************************************************/
        when c1 = '('  &,
             \in_dir   &,
             \in_exec  &,
             \in_com   &,
             \in_apost &,
             \in_quote then
          do
            paren   = (paren + 1) // 5
            tempout = tempout || col_par.paren || '(</em>'
            rxdata  = substr(rxdata, 2)
          end

        /***************************************************************
        * It's a right parenthesis                                     *
        ***************************************************************/
        when c1 = ')'  &,
             \in_dir   &,
             \in_exec  &,
             \in_com   &,
             \in_apost &,
             \in_quote then
          do
            tempout = tempout || col_par.paren')</em>'
            paren   = (paren + 4) // 5
            rxdata  = substr(rxdata, 2)
          end

        /***************************************************************
        * Anything else                                                *
        ***************************************************************/
        otherwise
          do
            tempout = tempout || c1
            rxdata  = substr(rxdata, 2)
          end
      end
    end

    /*******************************************************************
    * If still in string, language rules will enforce continuation     *
    *******************************************************************/
    if in_apost |,
       in_quote then
      do
        in_apost = 0
        in_quote = 0
        tempout  = tempout || '</em>'
      end

    /*******************************************************************
    * Directives not requiring a terminating '.' end at end-of-line    *
    *******************************************************************/
    if kcol = 3 then
      do
        kcol    = 0
        in_dir  = 0
        tempout = tempout || '</em>'
      end

    /*******************************************************************
    * Append tail                                                      *
    *******************************************************************/
    if tail \= '' then
      tempout = tempout || col_com || tail || '</em>'

    /*******************************************************************
    * Append data to final result                                      *
    *******************************************************************/
    htmlout = htmlout || tempout || '<br>'
  end
return

/***********************************************************************
* BUILD_LIST_OF_KEYWORDS:                                              *
*                                                                      *
* This procedure loads the list of COBOL keywords                      *
***********************************************************************/
build_list_of_keywords:
  signal get_keywords

/*
 1ACCEPT
 1ACCESS
 1ADD
 1ADDRESS
 1ADVANCING
 1AFTER
 1ALL
 1ALPHABET
 1ALPHABETIC
 1ALPHABETIC-LOWER
 1ALPHABETIC-UPPER
 1ALPHANUMERIC
 1ALPHANUMERIC-EDITED
 1ALSO
 1ALTER
 1ALTERNATE
 1AND
 1ANY
 1APPLY
 1ARE
 1AREA
 1AREAS
 1ASCENDING
 1ASSIGN
 1AT
 1ATTRIBUTES
 1BEFORE
 1BEGINNING
 1BINARY
 1BLANK
 1BLOCK
 1BOTTOM
 1BY
 1CALL
 1CANCEL
 1CD
 1CF
 1CH
 1CHARACTER
 1CHARACTERS
 1CLASS
 1CLASS-ID
 1CLOCK-UNITS
 1CLOSE
 1COBOL
 1CODE
 1CODE-SET
 1COLLATING
 1COLUMN
 1COM-REG
 1COMMA
 1COMMON
 1COMMUNICATION
 1COMP
 1COMP-1
 1COMP-2
 1COMP-3
 1COMP-4
 1COMP-5
 1COMPUTATIONAL
 1COMPUTATIONAL-1
 1COMPUTATIONAL-2
 1COMPUTATIONAL-3
 1COMPUTATIONAL-4
 1COMPUTATIONAL-5
 1COMPUTE
 1CONFIGURATION
 1CONTAINS
 1CONTENT
 1CONTINUE
 1CONTROL
 1CONTROLS
 1CONVERTING
 1CORR
 1CORRESPONDING
 1COUNT
 1CURRENCY
 1DATA
 1DATE
 1DAY
 1DAY-OF-WEEK
 1DBCS
 1DE
 1DEBUG-CONTENTS
 1DEBUG-ITEM
 1DEBUG-LINE
 1DEBUG-NAME
 1DEBUG-SUB-1
 1DEBUG-SUB-2
 1DEBUG-SUB-3
 1DEBUGGING
 1DECIMAL-POINT
 1DECLARATIVES
 1DELETE
 1DELIMITED
 1DELIMITER
 1DEPENDING
 1DESCENDING
 1DESTINATION
 1DETAIL
 1DISABLE
 1DISPLAY
 1DISPLAY-1
 1DIVIDE
 1DIVISION
 1DOWN
 1DUPLICATES
 1DYNAMIC
 1EGCS
 1EGI
 1ELSE
 1EMI
 1ENABLE
 1ENCODING
 1END
 1END-ADD
 1END-CALL
 1END-COMPUTE
 1END-DELETE
 1END-DIVIDE
 1END-EVALUATE
 1END-EXEC
 1END-IF
 1END-INVOKE
 1END-MULTIPLY
 1END-OF-PAGE
 1END-PERFORM
 1END-READ
 1END-RECEIVE
 1END-RETURN
 1END-REWRITE
 1END-SEARCH
 1END-START
 1END-STRING
 1END-SUBTRACT
 1END-UNSTRING
 1END-WRITE
 1END-XML
 1ENDING
 1ENTRY
 1ENVIRONMENT
 1EOP
 1EQUAL
 1ERROR
 1ESI
 1EVALUATE
 1EVERY
 1EXCEPTION
 1EXECUTE
 1EXIT
 1EXTEND
 1EXTERNAL
 1FACTORY
 1FALSE
 1FD
 1FILE
 1FILE-CONTROL
 1FILLER
 1FINAL
 1FIRST
 1FOOTING
 1FOR
 1FORMAT
 1FROM
 1FUNCTION-POINTER
 1GENERATE
 1GIVING
 1GLOBAL
 1GO
 1GOBACK
 1GREATER
 1GROUP
 1HEADING
 1HIGH-VALUE
 1HIGH-VALUES
 1I-O
 1I-O-CONTROL
 1ID
 1IDENTIFICATION
 1IF
 1IN
 1INDEX
 1INDEXED
 1INDICATE
 1INHERITS
 1INITIAL
 1INITIALIZE
 1INITIATE
 1INPUT
 1INPUT-OUTPUT
 1INSPECT
 1INTO
 1INVALID
 1INVOKE
 1IS
 1JNIENVPTR
 1JUST
 1JUSTIFIED
 1KANJI
 1KEY
 1LABEL
 1LAST
 1LEADING
 1LEFT
 1LENGTH
 1LESS
 1LIMIT
 1LIMITS
 1LINAGE
 1LINAGE-COUNTER
 1LINE
 1LINE-COUNTER
 1LINES
 1LINKAGE
 1LOCAL-STORAGE
 1LOCK
 1LOW-VALUE
 1LOW-VALUES
 1MEMORY
 1MERGE
 1MESSAGE
 1METHOD
 1METHOD-ID
 1MODE
 1MODULES
 1MORE-LABELS
 1MOVE
 1MULTIPLE
 1MULTIPLY
 1NAME
 1NAMESPACE
 1NAMESPACE-PREFIX
 1NATIONAL
 1NATIVE
 1NEGATIVE
 1NEXT
 1NO
 1NOT
 1NULL
 1NULLS
 1NUMBER
 1NUMERIC
 1NUMERIC-EDITED
 1OBJECT
 1OBJECT-COMPUTER
 1OCCURS
 1OF
 1OFF
 1OMITTED
 1ON
 1OPEN
 1OPTIONAL
 1OR
 1ORDER
 1ORGANIZATION
 1OTHER
 1OUTPUT
 1OVERFLOW
 1OVERRIDE
 1PACKED-DECIMAL
 1PADDING
 1PAGE
 1PAGE-COUNTER
 1PERFORM
 1PF
 1PH
 1PIC
 1PICTURE
 1PLUS
 1POINTER
 1POSITION
 1POSITIVE
 1PRINTING
 1PROCEDURE
 1PROCEDURE-POINTER
 1PROCEDURES
 1PROCEED
 1PROCESSING
 1PROGRAM
 1PROGRAM-ID
 1PURGE
 1QUEUE
 1QUOTE
 1QUOTES
 1RANDOM
 1RD
 1READ
 1RECEIVE
 1RECORD
 1RECORDING
 1RECORDS
 1RECURSIVE
 1REDEFINES
 1REEL
 1REFERENCE
 1REFERENCES
 1RELATIVE
 1RELEASE
 1RELOAD
 1REMAINDER
 1REMOVAL
 1RENAMES
 1REPLACING
 1REPORT
 1REPORTING
 1REPORTS
 1REPOSITORY
 1RERUN
 1RESERVE
 1RETURN
 1RETURN-CODE
 1RETURNING
 1REVERSED
 1REWIND
 1REWRITE
 1RF
 1RH
 1RIGHT
 1ROUNDED
 1RUN
 1SAME
 1SD
 1SEARCH
 1SECTION
 1SEGMENT
 1SEGMENT-LIMIT
 1SELECT
 1SELF
 1SEND
 1SENTENCE
 1SEPARATE
 1SEQUENCE
 1SEQUENTIAL
 1SET
 1SHIFT-IN
 1SHIFT-OUT
 1SIGN
 1SIZE
 1SORT
 1SORT-CONTROL
 1SORT-CORE-SIZE
 1SORT-FILE-SIZE
 1SORT-MERGE
 1SORT-MESSAGE
 1SORT-MODE-SIZE
 1SORT-RETURN
 1SOURCE
 1SOURCE-COMPUTER
 1SPACE
 1SPACES
 1SPECIAL-NAMES
 1STANDARD
 1STANDARD-1
 1STANDARD-2
 1START
 1STATUS
 1STOP
 1STRING
 1SUB-QUEUE-1
 1SUB-QUEUE-2
 1SUB-QUEUE-3
 1SUBTRACT
 1SUM
 1SUPER
 1SUPPRESS
 1SYMBOLIC
 1SYNC
 1SYNCHRONIZED
 1TABLE
 1TALLY
 1TALLYING
 1TAPE
 1TERMINAL
 1TERMINATE
 1TEST
 1TEXT
 1THAN
 1THEN
 1THROUGH
 1THRU
 1TIME
 1TIMES
 1TO
 1TOP
 1TRACE
 1TRAILING
 1TRUE
 1TYPE
 1UNIT
 1UNSTRING
 1UNTIL
 1UP
 1UPON
 1USAGE
 1USING
 1VALIDATING
 1VALUE
 1VALUES
 1VARYING
 1WHEN
 1WHEN-COMPILED
 1WITH
 1WORDS
 1WORKING-STORAGE
 1WRITE
 1WRITE-ONLY
 1XML
 1XML-CODE
 1XML-DECLARATION
 1XML-EVENT
 1XML-INFORMATION
 1XML-NAMESPACE
 1XML-NAMESPACE-PREFIX
 1XML-NNAMESPACE
 1XML-NNAMESPACE-PREFIX
 1XML-NTEXT
 1XML-SCHEMA
 1XML-TEXT
 1YYYYDDD
 1YYYYMMDD
 1ZERO
 1ZEROES
 1ZEROS

* Enterprise Cobol V4.2 Language Reference - Not in ISPF|

 1GROUP-USAGE
 1NATIONAL-EDITED
 1PASSWORD
 1SQL

* Followed by comment

 2AUTHOR
 2DATE-COMPILED
 2DATE-WRITTEN
 2INSTALLATION
 2SECURITY

* In 'ISP.SISPSAMP(ISRPXASM)'

 1METACLASS
 1PARSE

* Why is QQQ highlighted in reverse

 1FUNCTION

* Compiler directives with optional '.'

 3BASIS
 3CBL
 3EJECT
 3INSERT
 3SERVICE
 3SKIP1
 3SKIP2
 3SKIP3
 3TITLE
 3USE

* Not in 'ISP.SISPSAMP(ISRPXASM)' but correctly highlighted...

 3PROCESS

* Compiler directives with mandatory '.'

 4COPY
 4ENTER
 4READY
 4REPLACE
 4RESET

* Compiler directives running until END-....

 5EXEC

* Enterprise Cobol V4.2 Language Reference - "Potential Reserved Words"
*
* ACTIVE-CLASS
* ALIGNED
* ALLOCATE
* ANYCASE
* B-AND
* B-NOT
* B-OR
* B-XOR
* BASED
* BINARY-CHAR
* BINARY-DOUBLE
* BINARY-LONG
* BINARY-SHORT
* BIT
* BOOLEAN
* COL
* COLS
* COLUMNS
* CONDITION
* CONSTANT
* CRT
* CURSOR
* DATA-POINTER
* DEFAULT
* EC
* END-ACCEPT
* END-DISPLAY
* EO
* EXCEPTION-OBJECT
* FLOAT-EXTENDED
* FLOAT-LONG
* FLOAT-SHORT
* FORMAT
* FREE
* FUNCTION-ID
* GET
* INTERFACE
* INTERFACE-ID
* LOCALE
* MINUS
* NESTED
* OBJECT-REFERENCE
* OPTIONS
* PRESENT
* PROGRAM-POINTER
* PROPERTY
* PROTOTYPE
* RAISE
* RAISING
* RESUME
* RETRY
* SCREEN
* SHARING
* SOURCES
* SYSTEM-DEFAULT
* TYPEDEF
* UNIVERSAL
* UNLOCK
* USER-DEFAULT
* VAL-STATUS
* VALID
* VALIDATE
* VALIDATE-STATUS
*/

get_keywords:
  keyword. = 0

  do i = sigl + 3 until substr(sourceline(i), 1, 2) = '*' || '/'
    kw = strip(sourceline(i))

    /*******************************************************************
    * Skip blank and 'comment' lines                                   *
    *******************************************************************/
    if kw          = '' |,
       left(kw, 1) = '*' then
      iterate i

    vk = left(kw, 1)
    kw = substr(kw, 2)

    keyword.kw = vk
  end
return