/* Reformat: rearrange columns and constant information  (REXX)*/
/*********************************************************************
 MACRO:     Reformat lines of data
 PURPOSE:   Reformat data in edit
 EXAMPLES:
   Reformat 1 10 '..' 20 30
   reformat 'line ==>' 1  50 '<==='  .third .zl
   reformat 0 10 '..' 20 30 ' columns 1-10 now blank'
   reformat NX 50 70 1 40 .LABA .LABB
   reformat test '>' x'414243' '<' 1 80   -- on OS2 with ascii
   reformat test '>' x'c1c2c3' '<' 1 80   -- on TSO with ebcdic
   ------- additional functions added 1993/12/29 ---
   reformat hex 1 1 2 50    or  reformat  hex 1 1  2 L
   reformat unhex 1 2 3 51
   reformat "find all word c'" s 1 8 "'"    -- strip(name,'T')
   ------- additional functions added 1994/10/07 --- using .MSK label
   reformat m 1 23    1 8  '.spf'  m 40 63    1 8  s m 75 90 " <=="
***********************************************************************

  REFORMAT  Author: David McRitchie, created 1985/08/30 is03
            at "The REXX Macros Toolbox", DMcRitchie@hotmail.com
            Rewritten in REXX 1993/05/14 D.McRitchie IS03
            Revised 1993/07/23 compatability with SPF/2 under OS/2
            Revised 1993/12/29 HEX, UNHEX options added, L option fixed
            -- TSO Stats -- created(1985/08/30) initsize(171)--
  *******************************************************************
  Title:   reformat the inclusive lines between two labels
  Users:   TSO ISPF edit users, and OS2 users with SPF from CTC.
  Entry:   used as an edit clist within ispf edit  ===> reformat
  Contributed: 08/29/1985 David McRitchie "The REXX Macros Toolbox"
     "The REXX Macros Toolbox"
    "The REXX Macros Toolbox"
  Example(s):
     ===> reformat  .zfirst .zlast  10 30  200 01  31 40
     ===> reformat  .refa   .refb   40 45  1 3  75 L
        The second example reformats lines labeled .refa through
        .refb such that the line begins with former contents of
        pos. 40-45, followed by pos. 1-3 then 75 through the end
        of the line
     ===> reformat  e  'id(' 1 8 ') '  11 30
  requirements:
      constants enclosed in quotes and/or column pairs
      The second of a column pair can be an L for end of line.
  options:
      NX        only do NX lines
      TEST      use notelines instead of changing data
      x'hhhh'   hex constant
      test      use NOTELINE instead of actually changing data
      HEX       will use C2X() to convert to hex,  cols in next pair
      UNHEX     will use X2C() to convert to char, cols in next pair
      S         will strip trailing blanks, cols in next pair
                should generate noteline if left blank.
      M         will use .MSK line to obtain "STRING"
    * entire (compatibility) will be substituted by  ".zfirst .zlast "
    * init   (option dropped) will be used in an  initial macro
    * labels required option has been dropped  1993/05/14*
 *****************************************************************/

 Address 'ISREDIT'
 'MACRO (argx)';  /* NOPROCESS  if adding cc-range later */
 linex = substr(time('n'),1,5) 'REFORMAT' argx
 'LINE_BEFORE .ZFIRST = NOTELINE (linex)'
 err='';labfirst='';lablast='';nx='';pair=0;string='';nulls='';
 prevtoken=0;newtoken=0; hexwork=0; unhexwork=0;stripwork=0;maskwork=0;
 mask="";

 if argx = '' then do
    dataline = 'NOTELINE'
    argx = "1 10 'Testing --' 11 72"
 end
 argx = argx'   '   /* provide for terminating spaces during phase1 */

 /* ---- parse similar to  MACRO (a,b,c)  But creating an INTERPRET */
 /* ---- argument utilizing NUM/CHAR column pair determinations     */
 do forever;
    i = verify(argx,' ')
    if i =0 then signal endphase1
    argx = substr(argx,i)
    x = substr(argx,1,1)
    if substr(argx,1,2) = "x'" then do
       if pair = 1 then err = 'unpaired column before hex constant'
       j=pos('''',substr(argx,3));
       if j \= 0 then do
         token = 'X2C('||substr(argx,2,j)''')'
         /* When in ascii ABC is x'414243'  */
         string = string'||'token;
         argx = substr(argx,3+j)
         minor  = '' /*terminate any pair column started*/
         pair = 0;
         if argx = '' then signal endphase1
       end
       else exit
    end;
    else if x = '''' then do
       if pair = 1 then err = 'unpaired column before literal'
       j=pos('''',substr(argx,2));
       if j \= 0 then do
         token = substr(argx,2,j-1);
         string = string'||'''token'''';
         argx = substr(argx,2+j)
         minor  = '' /*terminate any pair column started*/
         pair = 0;
         if argx = '' then signal endphase1
       end
       else exit
    end;
    else if x = """" then do
       if pair = 1 then err = "unpaired column before literal"
       j=pos("""",substr(argx,2));
       if j \= 0 then do
         token = substr(argx,2,j-1);
         string = string"||"""token"""";
         argx = substr(argx,2+j)
         minor  = "" /*terminate any pair column started*/
         pair = 0;
         if argx = "" then signal endphase1
       end
       else exit
    end;
    else do;
       j = pos(' ',argx)
       token = substr(argx,1,j-1);
       argx = substr(argx,j)

       xx = translate(token)
       if xx = 'HEX' then hexwork = 1
       else if xx = 'UNHEX' then unhexwork = 1;
       else if xx = 'NX' then NX='NX'  /* limit process to NX lines */
       else if xx = 'TEST' | xx ='NOTELINE' then dataline='NOTELINE'
       else if xx = 'S' then stripwork = 1
       else if xx = 'M' then do; /*slightly redundant if multiple m */
                '(LNOlabm) = LINENUM .MSK'
                if LNOlabm = 0 then do
                  ZEDSMSG = '.MSK missing'
                  ZEDLMSG = 'M option requires MASK line at label .MSK'
                  Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
                  return 1
               end
               '(MASK) = LINE .MSK'; maskwork = 1;
            end;
       else if xx = 'ENTIRE' then do
          if labfirst \= '' then err='...too many labels'
          labfirst='.ZFIRST'; lablast='.ZLAST';
       end
       else if xx = 'INIT' then err='INIT option dropped 1993/05/14'
       /* check for label before assuming a constant */
       else if (substr(token,1,1)='.') & length(token) < 7 ,
        & datatype(substr(token,2),'A') then do
          if labfirst='' then labfirst=token
          else if lablast='' then lablast=token
          else err='.... too many labels .....'
          '(TTT) = linenum' token
          if ttt = 0 then err = 'Label' token 'is missing'
       end
       else do
          if pair = 0 then do
             CURRx = "CURR"; if maskwork = 1 then CURRx = "MASK";
             if token = 0 then minor = '||substr(nulls,1';
             else minor = '||substr('CURRx','token;
             if stripwork = 1 then minor='||strip(substr('CURRx','token;
             if hexwork   = 1 then minor='||C2X(substr('CURRx','token;
             if unhexwork = 1 then minor='||X2C(substr('CURRx','token;
             prevtoken = token;  /* will have to be subtracted*/
             pair = 1;
          end
          else do    /* process second column in col-pair */
             if xx \= 'L' then do;
                if prevtoken = 0 then newtoken = token /*nulls -- 0 5 */
                else newtoken = token + 1 - prevtoken
                string = string||minor||','||newtoken||')'
                if stripwork = 1 then
                   do; string = string||",'T')"; stripwork=0; end;
             end;
             else do
                if unhexwork = 1 then
                   err= "Use of L with UNHEX not permitted"
                string = string||minor||')'
             end
             if hexwork = 1 then
                 do; hexwork=0; string=string||')';end;
             if unhexwork = 1 then do;
                ttt = newtoken // 2
                if ttt \= 0 then err = "The UNHEX column-pair did",
                     "not address an even number of columns"
                unhexwork=0; string=string||')'
             end;
             pair = 0;
             maskwork=0;
          end
       end;
       if argx  = '' then signal endphase1
    end
 end
 /* ---------------------------------------------------------*/
 endphase1: string = substr(string,3)

 if pair = 1 then do
    "line_before .zf = Noteline 'Unpaired pairs -- reenter with pairs'"
    ZEDSMSG = 'Pairs?'     /* this check added 1995/04/07 FDM */
    ZEDLMSG = 'Unpaired column range(s) -- see noteline and REENTER'
    Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
    return 12
 end

 if labfirst = ' ' then do; labfirst='.ZFIRST'; lablast='.ZLAST';end;
 if lablast = '' then err = 'second label missing'
 else do
   '(SNO) = linenum' labfirst
   '(LNO) = linenum' lablast
   if sno = 0 then sno = 1
 end
 if lno = 0 then err = "One or more labels specified are missing"
 if dataline = 'NOTELINE' then say 'string='string
 if err \= '' then do
    say err '<--- err'
    "(caps) = caps"
    "caps off"
    'line_before .zfirst = noteline (err)'
     ZEDSMSG = "     "
     ZEDLMSG = "See Noteline --" err
     ADDRESS "ISPEXEC" "SETMSG MSG(ISRZ000)"
     "caps" caps
     exit 12
 end

 do i = sno to lno;
    doit = 1
    if nx = 'NX' then do;  /* x  only is not available */
       '(XSTATUS) = XSTATUS' i;
       if XSTATUS \= 'NX' then doit = 0
    end
    if doit = 1 then do
       '(CURR) = line' i
       line =''
       /* "LINE_BEFORE .zf  = INFOLINE """string"""" */
       interpret 'LINE = ' string
       if dataline = 'NOTELINE' then
          'LINE_BEFORE' i '= INFOLINE (LINE)' /*(LINE) must be caps*/
       else  do
            /* SPF/PC will destroy labels -- ISPF would not */
            '(lab1,lab2) = label' i
            'LINE' i '= (LINE)'
            if lab1 \= "" then "label" i "=" lab1 lab2
       end
     end
 end;
 if warnstrip = 1 then  "line_before .zf = noteline",
   """REFORMAT use of Strip option(S) has resulted in some nulls"""
exit
/* A scale like the following in a different dataset ideal for testi
    such scales can be created with the  COLS  macro
1...5...10...15...20...25...30...35...40...45...50...55...60...65...70

0000000001111111112222222222233333333334444444444555555555566666666667
1234567890123456789012345678901234567890123456789012345678901234567890

AAAAAAAAAaBBBBBBBBBbCCCCCCCCCcDDDDDDDDDdEEEEEEEEEeFFFFFFFFFfGGGGGGGGGg
*********************************************************************/