/*EDITOL    AUTHOR: DAVID MCRITCHIE, CREATED 1988/02/25 IS03 -REXX-  */
/*          "THE REXX MACROS TOOLBOX"                                */
/*          UPDATED 1990/11/14 21:14 IS03                            */
/*          UPDATED 1992/04/13 09:26 IS03 TO FIT IN 71 COLUMNS       */
/*********************************************************************/
/* TITLE:       EDITOL THE INCLUSIVE LINES BETWEEN TWO LABELS        */
/* USERS:       TSO ISPF EDIT USERS   | SCRIPT USERS                 */
/*                                                                   */
/* EXAMPLE:     EDITOL   .ZFIRST .ZLAST                              */
/*                                                                   */
/* OPTIONS:                                                          */
/*     LPTR-RANGE | ENTIRE   (REQUIRED) LINE POINTER RANGE           */
/*  <<<ADDITIONAL OPERANDS>>>                                        */
/* PURPOSE -- CHECK   NESTING OF  :OL :EOL   ETC.                    */
/*********************************************************************/
/*  REQUIREMENTS:                                                    */
/*       TWO LABELS AND SEVERAL PAIRS OF COLUMNS                     */
/*  OPTIONS:                                                         */
/*       LVL1       LEVEL 1 :LI LINES SO CAN BE USED WITH PINX       */
/*       LVL2       LEVEL 2 :LI LINES OF COLUMNS                     */
/*       LVL3       LEVEL 3 :LI LINES OF COLUMNS                     */
/*       NEST    SHOW NESTING UNDER EACH :OL :SL :UL (:GL) :DL       */
/*  EXAMPLES OF USE:                                                 */
/*       ===> EDITOL                                                 */
/*       ===>LEDITOL LVL2; LABNX; EDITOL LVL1                        */
/*       ===>LEDITOL NEST                                            */
/*  ...............................................                  */
/*  NEED TO OBTAIN STARTING LABELS OF REFBEG REFEND                  */
/*  ...............................................                  */
/*********************************************************************/
   ADDRESS "ISREDIT"; "MACRO (TOKEN)"
   TOKEN = TRANSLATE(' '||TOKEN||' ')
   LABF='.ZFIRST';LABL='.ZLAST';NOGOOD=''
   R. = ""; RCNT=0;
   OL="OL";UL="UL";SL="SL"
   LVLXX=0
   ECTL = '**ERROR** ATTEMPTING TO USE      ==>',
         'EDITOL' SUBSTR(TOKEN,1,23) TIME('N')
   PTR = 1
   DEBUG  = PROCESS('DEBUG')
   ENTIRE= PROCESS('ENTIRE')
   HELP = PROCESS('HELP')
   LVL1 = PROCESS('LVL1')
   LVL2 = PROCESS('LVL2')
   LVL3 = PROCESS('LVL3')
   NEST = PROCESS('NEST')
   NX   = PROCESS('NX')
   X    = PROCESS('X')
   PARSE VAR TOKEN LEFT '.' LABF ' ' RIGHT
   TOKEN = LEFT RIGHT
   IF LABF \= '' THEN LABF = '.'||LABF
   PARSE VAR TOKEN LEFT '.' LABL ' ' RIGHT
   TOKEN = LEFT RIGHT
   IF LABL \= '' THEN LABL = '.'||LABL
   PARSE VAR TOKEN LEFT '.' NOGOOD ' ' RIGHT
   TOKEN = LEFT RIGHT
   IF NOGOOD \= '' THEN DO
     ZEDSMSG = 'LABEL 'TOKEN''
     ZEDLMSG = "EXACTLY TWO LABELS ARE REQUIRED FOUND",
            LABF",  "LABL"  AND   ."NOGOOD
     /*ADDRESS*/ "ISPEXEC" " SETMSG MSG(ISRZ000)"
     RETURN 12
   END
   IF TOKEN \= '' THEN DO
     ZEDSMSG = '?' TOKEN
     ZEDLMSG = 'INVALID PARAMETER(S) FOR EDITOL, REMOVE OR CORRECT'
     /*ADDRESS*/ "ISPEXEC" " SETMSG MSG(ISRZ000)"
     RETURN 12
   END
 END_TOK:
 /****************************************************************/
  /****************** CODE FOR  EDITOL COMMANDS ***************/
  /****************** CODE FOR  EDITOL COMMANDS ***************/
  /****************** CODE FOR  EDITOL COMMANDS ***************/
  ERROR=0; LEVEL=0; LVLDL=0; LVLGL=0; LVLOL=0; LVLSL=0; LVLUL=0;
  IF  LABF  = '' THEN DO
     LABF = '.ZFIRST'
     LABL = '.ZLAST'
  END
  IF LABL = '' THEN DO
     ZEDSMSG = '2ND LABEL'
     ZEDLMSG = '2ND LABEL IS MISSING'
     /*ADDRESS*/ "ISPEXEC" " SETMSG MSG(ISRZ000)"
     RETURN 12
  END
  "(PTR) = LINENUM" LABF
  "(PTRL) = LINENUM" LABL
  "X ALL" LABF   LABL
  "LABEL .ZF = .TAGOL 1"
  IF RC = 0 THEN "RESET LABEL .TAGOL .TAGOL"
  "LABEL .ZF = .TAGSL 1"
  IF RC = 0 THEN "RESET LABEL .TAGSL .TAGSL"
  "LABEL .ZF = .TAGUL 1"
  IF RC = 0 THEN "RESET LABEL .TAGUL .TAGUL"
 LOOP:
  "CURSOR =" PTR  1
  "(VAR036) = LINE .ZCSR"
  X3 = SUBSTR(VAR036,1,3)
  X3 = TRANSLATE(X3)
  X4 = SUBSTR(VAR036,1,4)
  X4 = TRANSLATE(X4)
  IF X3 = ':OL' THEN DO
        IF LVLOL = 0 THEN "LABEL .ZCSR = .TAGOL 0"
        LEVEL =  LEVEL  + 1
        LVLOL =  LVLOL  + 1
        CALL   NESTX OL LVLOL
  END
  IF X4 = ':EOL' THEN DO
        LEVEL = LEVEL - 1
        LVLOL = LVLOL - 1
        IF LVLOL = 0 THEN "RESET LABEL .TAGOL .TAGOL"
        CALL UNNESTX OL LVLOL
        SIGNAL TSTLVL
  END
  /* -----------*/
  IF X3 = ':SL' THEN DO
        IF LVLSL = 0 THEN "LABEL .ZCSR = .TAGSL 0"
        LEVEL = LEVEL + 1
        LVLSL = LVLSL + 1
        CALL   NESTX SL LVLSL
  END
  IF  X4   = ':ESL' THEN DO
        LEVEL =  LEVEL - 1
        LVLSL =  LVLSL - 1
        IF  LVLSL = 0 THEN "RESET LABEL .TAGSL .TAGSL"
        CALL UNNESTX SL LVLSL
        SIGNAL TSTLVL
  END
  /* -----------*/
  IF  X3   = ':UL' THEN DO
        IF LVLUL = 0 THEN "LABEL .ZCSR = .TAGUL 0"
        LEVEL = LEVEL + 1
        LVLUL = LVLUL + 1
        CALL   NESTX UL LVLUL
  END
  IF  X4   = ':EUL' THEN DO
        LEVEL = LEVEL - 1
        LVLUL = LVLUL - 1
        IF LVLUL = 0 THEN "RESET LABEL .TAGUL .TAGUL"
        CALL UNNESTX UL LVLUL
        SIGNAL TSTLVL
  END
  /* -----------*/
  IF  X3   = ':DL' THEN DO
        IF LVLDL = 0 THEN "LABEL .ZCSR = .TAGDL 0"
        LEVEL = LEVEL + 1
        LVLDL = LVLDL + 1
        CALL   NESTX DL LVLDL
  END
  IF X4 = ':EDL' THEN DO
        LEVEL = LEVEL - 1
        LVLDL = LVLDL - 1
        IF LVLDL = 0 THEN "RESET LABEL .TAGDL .TAGDL"
        CALL UNNESTX DL LVLDL
        SIGNAL TSTLVL
  END
  /* -----------*/
  IF X3 = ':GL' THEN DO
        IF LVLGL = 0 THEN "LABEL .ZCSR = .TAGGL 0"
        LEVEL = LEVEL + 1
        LVLGL = LVLGL + 1
        CALL   NESTX GL LVLGL
  END
  IF X4 = ':EGL' THEN DO
        LEVEL = LEVEL - 1
        LVLGL = LVLGL - 1
        IF LVLGL = 0 THEN "RESET LABEL .TAGGL .TAGGL"
        CALL UNNESTX GL LVLGL
        SIGNAL TSTLVL
  END
  /* -----------*/
  IF X3 \= ':LI' THEN SIGNAL TSTHD
  IF  LEVEL <   1 THEN DO
     "LINE_AFTER .ZCSR = NOTELINE",
         """:LI ERROR -- LEVEL ="LEVEL,
         "OL="LVLOL" SL="LVLSL" UL="LVLUL"" TIME('N')""""
     ERROR =  ERROR + 1
     IF ERROR = 1 THEN DO
        "LINE_AFTER .ZCSR = MSGLINE 'ERROR=1 "VAR036"'"
     END
     IF ERROR    > 20 THEN RETURN 12
  END
  /* -----------*/
 TSTLVL:
  IF  LEVEL < 0 | LVLOL < 0 | LVLSL < 0 | ,
        LVLUL  < 0 | LVLDL < 0 THEN DO
     "LINE_AFTER .ZCSR = NOTELINE ""LEVEL="LEVEL,
       " OL="LVLOL" SL="LVLSL" UL="LVLUL" DL="LVLDL" --" TIME('N')""""
     ERROR =  ERROR + 1
     IF ERROR > 20 THEN RETURN 12
  END
  IF LVL1 = "LVL1"  THEN IF LEVEL = 1 THEN
     "F LAST ' ' .ZCSR .ZCSR"
  IF LVL2 = LVL2 THEN IF LEVEL = 2 THEN
     "F LAST ' ' .ZCSR .ZCSR"
  IF LVL3 = LVL3 THEN IF LEVEL = 3 THEN
     "F LAST ' ' .ZCSR .ZCSR"
  /* -----------*/
  TSTHD:
  IF X3 = ':H1' | X3 = ':H2' | X3 = ':H3' | X3 = ':H4' | X3 = ':H5' |,
            X3 = ':H6' ,
        THEN DO
        DO WHILE RCNT > 0
           IF RCNT \= 0 THEN DO
              "LINE_BEFORE .ZCSR = NOTELINE """,
                 R.RCNT "HAS NOT BEEN TERMINATED BEFORE" X3""""
              RCNT = RCNT - 1
           END
        END
        IF LEVEL \= 0 THEN DO
           ERROR =  ERROR + 1
           IF  ERROR > 20 THEN RETURN 12
           "LINE_BEFORE .ZCSR = NOTELINE """,
             "LEVEL="LEVEL "OL="LVLOL" SL="LVLSL" UL="LVLUL,
              "DL="LVLDL" GL="LVLGL" -- "TIME('N')""""
           "LINE_BEFORE .ZCSR = NOTELINE """,
             "OPEN OR INVALID LIST STATUS ENCOUNTERED AT" X3 """"
           "RESET .ZCSR .ZCSR X"
           IF LVLOL  > 0 THEN "RESET .TAGOL .TAGOL"
           IF LVLSL  > 0 THEN "RESET .TAGSL .TAGSL"
           IF LVLUL  > 0 THEN "RESET .TAGUL .TAGUL"
           IF LVLDL  > 0 THEN "RESET .TAGDL .TAGDL"
           IF LVLGL  > 0 THEN "RESET .TAGGL .TAGGL"
           LVLOL = 0; LVLSL=0; LVLUL=0; LVLDL=0; LVLGL=0; LEVEL=0;
           "RESET .ZCSR .ZCSR X"
        END
  END
  /* -----------*/
  NXT:
  PTR =  PTR + 1
  IF  PTR  <  PTRL  THEN SIGNAL LOOP
  DO WHILE RCNT > 0
     IF RCNT \= 0 THEN DO
        "LINE_BEFORE .ZCSR = NOTELINE """,
           R.RCNT "HAS NOT BEEN TERMINATED BEFORE" X3""""
        RCNT = RCNT - 1
     END
  END
  IF LVLGL  \= 0 THEN "LINE_AFTER .ZCSR = NOTELINE",
       """LEVEL="LEVEL" GL="LVLGL" -- "TIME('N')""""
  "LINE_AFTER .ZL = NOTELINE ",
       """LEVEL ="LEVEL"  OL="LVLOL"  SL="LVLSL" UL="LVLUL,
       "DL="LVLDL" GL="LVLGL" -- " TIME('N')""""
  "LINE_BEFORE .ZF = NOTELINE ""EDITOL OPTIONS",
    "AVAILABLE INCLUDE  -- LVL1 LVL2 LVL3 NEST"""
  RETURN 0
 NESTX:
  ARG TYPE LVLXX
  RCNT = RCNT+1; R.RCNT = ":"TYPE "LINE" PTR
  IF NEST = "NEST" THEN
     "LINE_AFTER .ZCSR = NOTELINE ",
       """LEVEL="LEVEL TYPE"="LVLXX""""
  IF (LVL1 = "LVL1" & LEVEL=1) ,
   | (LVL2 = "LVL2" & LEVEL=2) ,
   | (LVL3 = "LVL3" & LEVEL=3) THEN
       "RESET .ZCSR .ZCSR X"
 RETURN
 UNNESTX:
  ARG TYPE LVLXX
  X2=SUBSTR(R.RCNT,2,2)
  IF TYPE /= X2 THEN
    "LINE_AFTER .ZCSR = NOTELINE ""EXPECTING :E"X2 "FOUND :E"TYPE,
     "UNMATCHED TO" R.RCNT""""
  RCNT = RCNT-1;
  IF NEST = "NEST" THEN
     "LINE_AFTER .ZCSR = NOTELINE ",
       """LEVEL="LEVEL TYPE"="LVLXX""""
  IF (LVL1 = "LVL1" & LEVEL=0) ,
   | (LVL2 = "LVL2" & LEVEL=1) ,
   | (LVL3 = "LVL3" & LEVEL=2) THEN
       "RESET .ZCSR .ZCSR X"
 RETURN;
PROCESS: PROCEDURE EXPOSE TOKEN
 ARG SUBTOKEN
 I = POS(' '||SUBTOKEN||' ',TOKEN)
 IF I=0 THEN RETURN ''
 TOKENX = SUBSTR(TOKEN,1,I) || SUBSTR(TOKEN,I+2+LENGTH(SUBTOKEN))
 TOKEN = TOKENX
 RETURN SUBTOKEN