/* REXX -- REMBLANK - Remove columns which are all blank in range */
/*  F. David McRitchie -- "The REXX Macros Toolbox" 1991/10/01    */
Address "ISREDIT"
/*CONTROL NOFLUSH NOLIST NOMSG*/

/*********************************************/
/* DO NOT PROCESS ANY LINE COMMANDS UNTIL    */
/* MACRO INITIALIZATION HAS BEEN COMPLETE.   */
/*********************************************/

  "MACRO NOPROCESS (LABF LABL)"

  labf = translate(labf)
  nopreserve = ''
  if labl = '' then if labf = "NOPRESERVE"    then do
     nopreserve = 'NOPRESERVE';labf = ''
  end
  If LABL \= "" then do
     "(CHK1) = LINENUM " LABF
     "(CHK2) = LINENUM " LABL
     If CHK1 \= "000000"  then If CHK2 \= "000000" then do
        "LABEL " LABF "= .LABF "
        If rc \= 0 then return 16
        "LABEL " LABL "= .LABL "
        If rc \= 0 then return 16
     end
     else do
        ZEDSMSG = "Labels" LABF LABL
        ZEDLMSG = "Missing label " labf "or" labl ,
           "or both labels missing"
        /*Address*/ "ISPEXEC" "SETMSG MSG(ISRZ000)"
        Return 12
        Exit   12
     end
  END
  else do
/*********************************************************************/
/*  TELL MACRO THAT WE WILL PROCESS ONLY C (COPY)    OPERATIONS      */
/*********************************************************************/

  "PROCESS RANGE C M"
  CC = RC

  "(RANGE) = RANGE_CMD"
  If RANGE \= "C" then do
     ZEDSMSG = "M range invalid"
     ZEDLMSG = "C ranges are only ranges permited"
     /*Address*/ "ISPEXEC" "SETMSG MSG(ISRZ001)"
     exit 12
  end

  If CC =  4  THEN
   DO
     ZEDSMSG = "ENTER ''C''       COMMANDS"
     ZEDLMSG = "C FOR LINE RANGE TO REMOVE BLANKS"
     /*Address*/ "ISPEXEC" "SETMSG MSG(ISRZ001)"

/*********************************************/
/*  SET A RETURN CODE OF 12 IN THE CLIST     */
/*  EXIT COMMAND.  THE CURSOR IS PLACED ON   */
/*  THE COMMAND LINE AND THE COMMAND IS LEFT */
/*  DISPLAYED FOR USER CORRECTION.           */
/*********************************************/

     EXIT 12
   END

  If  CC >  0 THEN
   DO
     "LINE_AFTER 0 = NOTELINE ""PROCESS ",
       "RANGE C   RETURN CODE IS &CC -- IN REMBLANK MACRO"""
     ZEDSMSG = "CONFLICTING RANGE"
     ZEDLMSG = "CONFLICTING RANGE SPECIFIED RC="||RC
     "ISPEXEC SETMSG MSG(ISRZ001)"
     EXIT 12
   END
  "LABEL .ZFRANGE = .LABF"
  "LABEL .ZLRANGE = .LABL"
 end
 /************ */
  if nopreserve = ''
  then "line_before .labf = noteline ""Spaces will be preserved",
   "at end of words unless NOPRESERVE is used"""
  else "line_before .labf = noteline ""Spaces will not be",
   "preserved at end of words since NOPRESERVE option was invoked"""

  "(LRECL) = LRECL"
  do i=lrecl to 1 by -1
    "seek first p'^' .labf .labl " I I
    If RC =0 then do;
       if i = lrecl | nopreserve = 'NOPRESERVE'
       then "change all .labf .labl" i i "' ' x'01'"
       else "change all .labf .labl" i value(i+1) "' ' x'01'"
    end
  end
  "change all .labf .labl ' ' x'02'"
  "change all .labf .labl x'02' ''"
  "change all .labf .labl x'01' ' '"