/* REXX  FLOW  edit macro modified from  -- TSO TIMES                */
/* issue No. 5 --published by chicago-Soft Ltd., contest winner      */
/*  written by David Leigh at Unipac service corporation.  Entered   */
/* as a short macro clist of 14 lines, changes have been made to     */
/* make it a REXX execute, make it move text left as well as well as */
/* right, and specify right column boundary. David McRitchie 1992/01/10*/
/* TFLOW can receive without problem a higher number than it can act-*/
/* ually use, so only reason to limit is to avoid right truncation   */
/*                                                                   */
/* Usage MOVE text left or right to CURSOR position and TFLOW lines. */
/* Optional use of PROCESS C line command as bottom limit of FLOW.   */
/*                                                                   */
Address "ISREDIT"
blanks = '                            '
"MACRO NOPROCESS (OPT1)"
Address "ISPEXEC" "control errors return"
"(SLINE,SCOL) = cursor"               /* retain cursor info at Start */
if sline = 000 | scol = 000 then do
   ZEDSMSG = "CURSOR POS."
   ZEDLMSG = "CURSOR not placed within a line of text/data"
   Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
   RETURN 0
end
"PROCESS RANGE C"                     /* obtain C-range              */
process = rc                          /* check if a C-range exists   */
IF process = 0 THEN DO
   "(ZFRANGE) = LINENUM .ZFRANGE"     /* will only use ZLRANGE       */
   "(ZLRANGE) = LINENUM .ZLRANGE"     /* will only use ZLRANGE       */
   If zfrange \= zlrange then do
     ZEDSMSG = "CC Invalid"
     ZEDLMSG = "CC line range invalid, the C line command is optional"
     call removal
   end
   "LINE_AFTER " .zlrange "= DATALINE '.REMOV'"
   remov =  zlrange + 1
   "LABEL " remov "= .remov 0"        /* create a FLOW proof line    */
END
else zlrange = 0
"find first p'^' .zcsr .zcsr"         /* find first non-blank on line*/
"(LN,CL) = cursor"
"LABEL .zcsr = .curr "
"(LBND,RBND) = BOUNDS"
"BOUNDS"
"(LCCC,RCCC) = BOUNDS"
if lbnd \= lccc | rbnd \= rccc then do
  zedlmsg = "Warning in use BOUNDS" LBND RBND||", ",
    ||"default is" LCCC RCCC
  "(RECFM) = RECFM"
   IF left(RECFM,1) = "V" then
     zedlmsg = zedlmsg ||", RECFM="||RECFM" adds +8 to each"
 end
"BOUNDS" LBND RBND
if opt1 = '' then opt2 = RBND; else opt2 = opt1

if scol = cl then do
   "TFLOW .ZCSR" opt2
   call removal  /* and exits */
end
if scol > cl then do
   sright = scol - cl                 /* calculate shift right amt   */
   flowcols = opt2 - sright
   "TFLOW .zcsr " flowcols
   "(X,Y) = FLOW_COUNTS"              /*  how many lines BEFORE,AFT  */
   y = y - 1;
   do i = 0 to y;                     /* y+1 is new lines involved   */
      csrat = sline + i               /* add  1 to move cursor down  */
      "cursor = " csrat 1             /*   a line and over to col 1  */
      "shift ) .zcsr " sright         /*   shift right               */
   end
   call removal  /* and exits */
end
if scol < cl then do                  /* make sure, even if redundant*/
   sleft  = cl - scol                 /* calculate shift left  amt   */
   csrp = sline + 1
   if zlrange \= sline then do
      "LABEL " csrp   "= .csrp 1"        /* next line down           */
      "SEEK '"||left(blanks,sleft)||"' 1 first .csrp .csrp"
      if rc \= 0 then do
         ZEDSMSG = "Can't move"
         ZEDLMSG = "Insufficient blanks on left side of ",
             ||"next line to shift left by " sleft "columns"
         Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
         call removal  /* and exit */
      end
   end
   "cursor = " sline scol             /* after SEEK put back cursor  */
   flowcols = opt2 + sleft
   "TFLOW .zcsr " flowcols
   "(X,Y) = FLOW_COUNTS"              /*  how many lines BEFORE,AFT  */
   y = y - 1
   do i = 0 to y;                     /* y+1 is new lines involved   */
      csrat = sline + i               /* add  1 to move cursor down  */
      "cursor = " csrat 1             /*   a line and over to col 1  */
      "shift ( .zcsr " sleft
   end
   "LINE_AFTER " csrat    "= DATALINE '.remvx'"
   csrat  =  csrat + 1
   "LABEL " csrat  "= .remvx 0"       /* create a FLOW proof line    */
  "cursor = " sline scol              /*   a line and over to col 1  */
   "TFLOW .zcsr " opt2
   "(X,Y) = FLOW_COUNTS"              /*  how many lines BEFORE,AFT  */
   "del .remvx .remvx all"
   call removal  /* and exits */
end
return
REMOVAL: procedure expose zedsmsg zedlmsg sline scol;
  "del .remov .remov all"
  "cursor = " sline scol           /*  a line and over to col 1  */
  Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
  exit 0
end