/* REXX edit macro to convert ISPF source into in-line REXX (and vv)  */
/*** trace ?r ***************************************************** \| *
*               (C) Copyright Robert AH Prins, 2006-2009               *
************************************************************************
*  ------------------------------------------------------------------  *
* | Date       | By   | Remarks                                      | *
* |------------+------+----------------------------------------------| *
* |            |      |                                              | *
* |------------+------+----------------------------------------------| *
* | 2009-04-22 | RAHP | Update comment                               | *
* |------------+------+----------------------------------------------| *
* | 2007-09-24 | RAHP | Put under GPL V3                             | *
* |------------+------+----------------------------------------------| *
* | 2007-09-03 | RAHP | Add 'bin' parameter for binary data          | *
* |------------+------+----------------------------------------------| *
* | 2007-08-16 | RAHP | Split comment delimiters in strings          | *
* |------------+------+----------------------------------------------| *
* | 2007-07-25 | RAHP | Use 'MSG' lines in help                      | *
* |------------+------+----------------------------------------------| *
* | 2007-01-25 | RAHP | Build temporary dataset to find p'.' chars   | *
* |            |      | Speedup queue conversion by bulktest for     | *
* |            |      | p'.'s and quotes                             | *
* |            |      | Store un-EPANQ'ed data in temporary dataset  | *
* |------------+------+----------------------------------------------| *
* | 2006-12-13 | RAHP | Add reverse function                         | *
* |------------+------+----------------------------------------------| *
* | 2006-11-28 | RAHP | Initial version                              | *
* |------------+------+----------------------------------------------| *
************************************************************************
* EPANQ is a REXX edit macro to take ISPF panel, message and skeleton  *
* source and convert them into a number of REXX 'queue' statements     *
* that can be embedded in an exec to dynamically build them without    *
* the use for a predefined libraries.                                  *
*                                                                      *
* The code automagically doubles single quotes (') and converts any    *
* 'invalid' (ie p'.') characters to x2c().                             *
*                                                                      *
* Obviously, it can also do the reverse, converting 'queue'd ISPF      *
* panels, messages and/or skeleton source back into an editable        *
* format.                                                              *
************************************************************************
* 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 .

"isredit macro (parm)"

parm = translate(space(parm))

/***********************************************************************
* Recursive invocation to get all p'.'s from temporary dataset         *
***********************************************************************/
if parm = 'PDOT'x2c(ff) then
  do
    call find_pdot
    return
  end

dest  = 0
line. = ''
type. = 'MSG'

"isredit (SESSION) = session"
if parm = '?' then
  do
    call help

    exit 1
  end

"isredit (STATE) = user_state"

"isredit (SF) = linenum .SF"
rcf = rc

"isredit (SL) = linenum .SL"
rcl = rc

if rcf = 0 &,
   rcl = 0 then
  call queue_2_source
else
  if rcf \= 0 &,
     rcl \= 0 then
    call source_2_queue
  else
    call help

"isredit user_state = (STATE)"
exit 1

/***********************************************************************
* SOURCE_2_QUEUE:                                                      *
*                                                                      *
* Procedure to convert panel, message or skeleton source into REXX     *
* queue statements, with doubles quotes and p'.' characters translated *
* into x2c() statements.                                               *
***********************************************************************/
source_2_queue:
  /*********************************************************************
  * Get all p'.' characters that later need to be translated to x2c()  *
  *********************************************************************/
  call get_pdot

  "isredit (ZL) = linenum .zl"

  "newstack"

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

  queue 'member = '''strip(mem)''''
  queue ''

  do i = 1 to +zl
    "isredit (L) = line" i

    if parm \= 'BIN' then
      call process_line
    else
      call process_bin
  end

  dynlib = 'dyn'random(99999)
  "alloc f("dynlib") del space(1,1) recfm(f b) lrecl(80) blksize(0) reu"

  "execio" queued() "diskw "dynlib" (finis"

  "ispexec lminit dataid(mydsn) ddname("dynlib") enq(exclu)"
  "ispexec view dataid("mydsn")"
  "ispexec lmfree dataid("mydsn")"

  "free f("dynlib")"

  "delstack"
return

/***********************************************************************
* PROCESS_LINE:                                                        *
*                                                                      *
* This procedure processes each line. It doubles all quotes, converts  *
* all 'invalid' (ie p'.') characters to x2c() and breaks up the line   *
* in queueable parts of up to 60 characters.                           *
***********************************************************************/
process_line: procedure expose l pdot
  /*********************************************************************
  * Marker for non-x2c()'ed lines                                      *
  *********************************************************************/
  o. = x2c(00)
  o  = 0

  /*********************************************************************
  * Need at least one character                                        *
  *********************************************************************/
  l  = strip(l, 'T')' '

  i  = 1

  ls = space(l, 0)
  lz = space(translate(l, ' ', pdot''''), 0)

  if ls = lz then
    do
      if l \== ' ' then
        l = strip(l, 'T')

      p = pos('/' || '*', l)
      do while p \= 0
        l = substr(l, 1, p) || ''' || ''' || substr(l, p + 1)
        p = pos('/' || '*', l)
      end

      p = pos('*' || '/', l)
      do while p \= 0
        l = substr(l, 1, p) || ''' || ''' || substr(l, p + 1)
        p = pos('*' || '/', l)
      end

      if length(l) <= 63 then
        queue 'queue '''l''''
      else
        do
          queue 'queue '''substr(l,  1, 58)''' ||,'
          queue '      '''substr(l, 59)''''
        end

      return
    end

  do while i <= length(l)
    c = substr(l, i, 1)
    if i = length(l) & i \= 1 then
      c = ''

    h = pos(c, pdot)

    select
      /*****************************************************************
      * String together all (up to 25 at a time) p'.' characters       *
      *****************************************************************/
      when h \= 0 then
        do
          hex = ''

          do while h \= 0 & length(hex) < 25
            hex = hex || c
            i   = i + 1
            c   = substr(l, i, 1)
            h   = pos(c, pdot)
          end

          o   = o + 1
          o.o = 'x2c(' || c2x(hex) || ')'
        end

      /*****************************************************************
      * Normal characters                                              *
      *****************************************************************/
      otherwise
        do
          if c = '''' then
            c = ''''''

          /*************************************************************
          * Start new segment if                                       *
          *                                                            *
          *  - this is the first segment                               *
          *  - if the previous segment resulted from one or more p'.'  *
          *    characters                                              *
          *  - if length of the segment concatenated with the current  *
          *    character exceeds 59                                    *
          *************************************************************/
          if o                       = 0 |,
             left(o.o, 1)           \= x2c(00) |,
             length(o.o) + length(c) > 59 then
            o = o + 1

          o.o = o.o || c
          i   = i + 1
        end
    end

    o.0 = o
  end

  prefix = 'queue '
  do o = 1 to o.0
    if left(o.o, 1) = x2c(00) then
      q = prefix || '''' || substr(o.o, 2) || ''''
    else
      q = prefix || o.o

    prefix = '      '

    if o \= o.0 then
      q = q || ' ||,'

    queue q
  end
return

/***********************************************************************
* PROCESS_BIN:                                                         *
*                                                                      *
* This procedure processes pure binary data to greatly reduce the      *
* number of separate queue statements.                                 *
***********************************************************************/
process_bin: procedure expose l
  /*********************************************************************
  * Need at least one character                                        *
  *********************************************************************/
  l  = strip(l, 'T')' '
  o  = 0

  do while l \= ''
    o   = o + 1
    o.o = 'x2c('c2x(left(l, 28))')'
    l   = substr(l, 29)
  end
  o.0 = o

  prefix = 'queue '
  do o = 1 to o.0
    q      = prefix || o.o
    prefix = '      '

    if o \= o.0 then
      q = q || ' ||,'

    queue q
  end
return

/***********************************************************************
* QUEUE_2_SOURCE:                                                      *
*                                                                      *
* Procedure to convert 'queue'd panel, message or skeleton back into   *
* an editable format.                                                  *
***********************************************************************/
queue_2_source:
  m   = 0
  m.0 = 0
  nl  = ''

  dynlib = 'dyn'random(99999)

  "alloc f("dynlib") new space(1,1) recfm(f b) lrecl(80) blksize(0) reu"

  do i = +sf to +sl
    "isredit (L) = line" i
    l  = strip(l)

    nl = strip(nl,, ',') || l

    if right(nl, 1) \= ',' then
      do
        if left(nl, 6) = 'queue ' then
          do
            interpret nl
            m   = m + 1
            m.0 = m
            parse pull m.m
          end
        else
          if left(nl, 6) = 'member' then
            do
              call saver

              drop m.
              m   = 0
              m.0 = 0

              interpret nl
            end

        nl = ''
      end
  end

  call saver

  drop mydsn

  "ispexec lminit dataid(mydsn) ddname("dynlib") enq(shr)"
  "ispexec view dataid("mydsn")"
  "ispexec lmfree dataid("mydsn")"

  "free f("dynlib")"
return

/***********************************************************************
* SAVER:                                                               *
*                                                                      *
* Save a complete panel, message or skeleton                           *
***********************************************************************/
saver:
  if m \= 0 then
    do
      "newstack"

      do m = 1 to m.0
        queue m.m
      end

      "execio" queued() "diskw "dynlib" (finis"

      "delstack"
    end
return

/***********************************************************************
* GET_PDOT:                                                            *
*                                                                      *
* This procedure finds all p'.' characters that exist for the current  *
* edit/view session.                                                   *
***********************************************************************/
get_pdot: procedure expose moi pdot
  dynlib = 'dyn'random(99999)

  "alloc f("dynlib") new space(1,1) recfm(f b) lrecl(80) blksize(0) reu"

  "newstack"

  queue xrange('00'x,'3f'x)
  queue xrange('40'x,'7f'x)
  queue xrange('80'x,'bf'x)
  queue xrange('c0'x,'ff'x)

  "execio" queued() "diskw "dynlib" (finis"

  "delstack"

  drop mydsn

  "ispexec lminit dataid(mydsn) ddname("dynlib") enq(exclu)"

  parm = 'PDOT'x2c(ff)
  "ispexec view dataid("mydsn") macro("moi") parm(parm)"

  "ispexec lmfree dataid("mydsn")"

  "ispexec vget (pdot) shared"

  "free f("dynlib")"
return

/***********************************************************************
* FIND_PDOT:                                                           *
*                                                                      *
* This procedure finds all p'.' characters that exist for the current  *
* edit/view session.                                                   *
***********************************************************************/
find_pdot: procedure
  pdot = ''

  "isredit f p'.' first"
  do while rc = 0
    "isredit (L) = line .zcsr"
    "isredit (R,C) = cursor"

    pdot = pdot || substr(l, c, 1)

    "isredit f p'.' next"
  end

  "ispexec vput (pdot) shared"
  "isredit end"
return

/***********************************************************************
* MESSAGE:                                                             *
*                                                                      *
* General purpose edit message insertion routine                       *
***********************************************************************/
message:
  "isredit (MSTATE) = user_state"
  "isredit caps = off"
  do i = line.0 to 1 by -1
    lin = line.i
    "isredit line_after "dest" = "type.i"line (LIN)"
  end
  "isredit user_state = (MSTATE)"
  "isredit locate" dest
return

/***********************************************************************
* HELP:                                                                *
*                                                                      *
* HELP is a general "help" screen displaying routine                   *
***********************************************************************/
help:
  arg parm

  type.  = 'NOTE'
  i      = 1
  text   = 'The' moi 'edit macro'
  line.i = center(text, 72)
  type.i = 'MSG'
  i      = i + 1
  line.i = center(left('~', length(text), '~'), 72)
  type.i = 'MSG'
  i      = i + 1
  line.i = center(' Use DOWN to read all "HELP"',
           'screens ', 72, '*')
  type.i = 'MSG'

  i      = i + 2
  line.i = '  The' moi 'edit macro performs the two tasks of',
           'converting ISPF'
  i      = i + 1
  line.i = '  panel, message and/or skeleton source into a series',
           'of REXX queue'
  i      = i + 1
  line.i = '  statements that can be embedded in an exec to recreate',
           'these items'
  i      = i + 1
  line.i = '  at runtime, reducing the dependency on external panel,',
           'message and/or'
  i      = i + 1
  line.i = '  skeleton libraries. It can also perform the reverse,',
           'converting a'
  i      = i + 1
  line.i = '  series of REXX queue statements back into editable',
           'source.'

  i      = i + 2
  line.i = '  Usage:'
  type.i = 'MSG'

  i      = i + 2
  line.i = '   o Convert to queue statements (default)'

  i      = i + 2
  line.i = '      - VIEW the member that needs to be',
           'turned into queue statements'
  i      = i + 1
  line.i = '      - Enter' moi 'on the commandline and',
           'press ENTER'
  i      = i + 2
  line.i = '     When' moi 'has finished, you will be VIEWing',
           'a temporary dataset'
  i      = i + 1
  line.i = '     with the queue statements. You can use',
           '''CUT'', ''CREATE'' or ''MOVE'''
  i      = i + 1
  line.i = '     to save them to their final location.'

  i      = i + 2
  line.i = '     Note:'
  type.i = 'MSG'

  i      = i + 2
  line.i = '     To convert data with a large number of',
           '''unprintable'' characters,'
  i      = i + 1
  line.i = '     resulting in excessively large code, it is possible',
           'to add a'
  i      = i + 1
  line.i = '     ''bin'' parameter, ie use ''EPANQ BIN'', which will',
           'result in all'
  i      = i + 1
  line.i = '     data being converted in x2c(...) queue statements.'

  i      = i + 2
  line.i = '   o Convert ''queue'' statements to source'

  i      = i + 2
  line.i = '      - VIEW the member that needs to be turned back',
           'into source and'

  i      = i + 2
  line.i = '         o mark the line containing the first ''queue''',
           'statement with'
  i      = i + 1
  line.i = '           a .SF label'
  i      = i + 1
  line.i = '         o mark the line containing the last ''queue''',
           'statement with'
  i      = i + 1
  line.i = '           a .SL label'

  i      = i + 2
  line.i = '     Note:'
  type.i = 'MSG'

  i      = i + 2
  line.i = '     If the member contains more than one object and',
           'they are'
  i      = i + 1
  line.i = '     separated by "member = ''xxxxxxxx''" statements, you',
           'can put the'
  i      = i + 1
  line.i = '     .SF label on the line that contains the first of',
           'these'
  i      = i + 1
  line.i = '     "member = ''xxxxxxxx''" statements and' moi 'will',
           'process all',
  i      = i + 1
  line.i = '     members in one go, ignoring all statements other',
           '''queue'''
  i      = i + 1
  line.i = '     and ''member = ...'''

  i      = i + 2
  line.i = center(' End of HELP information ', 72, '*')
  type.i = 'MSG'
  line.0 = i

  call message
return
/*- Start of testdata --------------------------------------------------
 *                                                             *
x2c(FFFFFFFF)
'
''
'''   Just some text
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
--- End of testdata --------------------------------------------------*/

Flags