/* REXX exec/edit macro to convert ISPF panels to 'HILITE'd HTML      */
/*** trace ?r ***************************************************** \| *
*               (C) Copyright Robert AH Prins, 2007-2016               *
************************************************************************
*  ------------------------------------------------------------------  *
* | Date       | By   | Remarks                                      | *
* |------------+------+----------------------------------------------| *
* |            |      |                                              | *
* |------------+------+----------------------------------------------| *
* | 2016-12-26 | RAHP | Initial version                              | *
* |------------+------+----------------------------------------------| *
************************************************************************
* EHIPAN is a REXX exec/edit macro that analyses PANEL code an 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.    *
*                                                                      *
* 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 PANEL 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

"ispexec vget (ehixmit) shared"

if rc = 0 then
  do
    "ispexec verase (rexxparm) shared"
    "isredit can"
    exit
  end

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 PANEL 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 (ZF)  = linenum .zf"
      "isredit (ZL)  = linenum .zl"

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

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

      /*****************************************************************
      * Concatenate the full source, but indicate original line breaks *
      *****************************************************************/
      i = 0

      do j = +zf to +zl
        "isredit (DATALINE) = line" j

        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.rexx.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 code                                                  *
      *****************************************************************/
      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")"

      /*****************************************************************
      * Merge full source, indicating linebreaks                       *
      *****************************************************************/
      olines = queued()

      i = 0
      do queued()
        parse pull dataline

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

      rxdata.0 = i
    end
return

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

  do i = 1 by 1 while lines(idsn)
    dataline = linein(idsn)
    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 || ".panel.html'"
  else
    odsn = "'" || userid() || '.' || moi || ".panel.html'"

  /*********************************************************************
  * Text strings for title, header and footer                          *
  *********************************************************************/
  title  = 'PANEL source:' strip(idsn,, '''')
  header = 'PANEL 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 = 'ispfpan.html'

  /*********************************************************************
  * HTML colors                                                        *
  *                                                                    *
  * - lime(green) - default                                            *
  * - red         - keywords                                           *
  * - white       - quoted strings                                     *
  * - aqua(turq)  - comments                                           *
  * - yellow      - special characters                                 *
  *********************************************************************/
  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  */

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

  /*********************************************************************
  * Characters to be highlighted                                       *
  *********************************************************************/
  special_hilite = '&'
return

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

  /*********************************************************************
  * Switches                                                           *
  *********************************************************************/
  in_com   = 0                  /* Inside a comment                   */
  in_apost = 0                  /* Inside a '(apost) delimited string */
  in_quote = 0                  /* Inside a "(quote) delimited string */

  /*********************************************************************
  * 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 = ''

  tempout = ''

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

  tempout = ''

  do r = 1 to rxdata.0
    /*******************************************************************
    * 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

    rxdata = rxdata.r

    /*******************************************************************
    * Panel keyword lines are RED, and start with a ')' in column 1    *
    *******************************************************************/
    if left(rxdata, 1) = ')' then
      do
        htmlout = htmlout || tempout ||,
                             col_key || rxdata || '</em><br>'
        tempout = ''
        iterate r
      end

    do while rxdata \= ''
      c1 = left(rxdata, 1)
      c2 = left(rxdata, 2)

      sh = pos(c1, special_hilite) > 0 then
      sc = wordpos(c1, special_chars)

      select
        /***************************************************************
        * Spaces are kept unchanged - process multiple immediately     *
        ***************************************************************/
        when c1 == ' ' then
          do
            n       = verify(rxdata, ' ')
            tempout = tempout || left(rxdata, n - 1)
            rxdata  = substr(rxdata, n)
          end

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

            tempout  = tempout || "'</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 a comment                                           *
        ***************************************************************/
        when c2 = '/' || '*' &,
             \in_apost &,
             \in_quote then
          do
            in_com  = 1

            tempout = tempout || col_com'/' || '*'
            rxdata  = substr(rxdata, 3)
          end

        /***************************************************************
        * End of a comment                                             *
        ***************************************************************/
        when c2 = '*' || '/' &,
             \in_apost    &,
             \in_quote then
          do
            in_com  = 0

            tempout = tempout || '*' || '/</em>'
            rxdata  = substr(rxdata, 3)
          end

        /***************************************************************
        * A special character has to be translated and highlighted     *
        ***************************************************************/
        when sc > 0    &,
             sh > 0    &,
             \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

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

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

    tempout = tempout'<br>'

    /*******************************************************************
    * Append data to final result                                      *
    *******************************************************************/
    if length(tempout) > 512 then
      do
        htmlout = htmlout || tempout
        tempout = ''
      end
  end

  htmlout = htmlout || tempout
return

/***********************************************************************
* BUILD_LIST_OF_KEYWORDS:                                              *
*                                                                      *
* This procedure loads the list of REXX keywords                       *
***********************************************************************/
build_list_of_keywords:
  keyword. = 0

  /*********************************************************************
  * PANEL Keywords                                                     *
  *********************************************************************/
  keyword.ABC     = 1
  keyword.ABCINIT = 1
  keyword.ABCPROC = 1
  keyword.AREA    = 1
  keyword.ATTR    = 1
  keyword.BODY    = 1
  keyword.CCSID   = 1
  keyword.END     = 1
  keyword.FIELD   = 1
  keyword.HELP    = 1
  keyword.INEXIT  = 1
  keyword.INEXIT  = 1
  keyword.INIT    = 1
  keyword.LIST    = 1
  keyword.MODEL   = 1
  keyword.PANEL   = 1
  keyword.PNTS    = 1
  keyword.PROC    = 1
  keyword.REINIT  = 1
return