/* REXX -- converted to REXX on 1994/06/03 */
ADDRESS "ISREDIT"
 /*  TITLE:       TAGX     THE INCLUSIVE LINES BETWEEN TWO LABELS   */
 /*                                           *GENERALIZED TAGX    * */
 /*  USERS:       TSO ISPF EDIT USERS   | SCRIPT USERS              */
 /*  CONTRIBUTED: 1990/10/23 DAVID MCRITCHIE                        */
 /*                                                                 */
 /*  EXAMPLE:     TAGX     .ZFIRST .ZLAST NX                        */
 /*                                                                 */
 /*  OPTIONS:                                                       */
 /*      NX|X     DEFAULT IS NX                                     */
 /*        NX     PLACES %B% BEFORE NX LINE GROUPS AND %A% AFTER    */
 /*         X     PLACES %B% BEFORE  X LINE GROUPS AND %A% AFTER    */
 /*     <TAG1>    REPLACEMENT FOR DEFAULT %B%                       */
 /*     <TAG2>    REPLACEMENT FOR DEFAULT %A%                       */
 /*                                                                 */
 /*  REQUIREMENTS:                                                  */
 /*    NONE IN WHICH CASE WILL PROCESS ENTIRE MEMBER SAME AS IF     */
 /*        ===> %TAGX .ZF .ZL NX %B% %A%                            */
 "MACRO (TOKENS)"
        I = 0
        L = 0
        /*********                                                  */
        help=""; debug=""; s=""; AT=""; entire=""; remain=""
        nx=""; x=""; tag1="";tag2=""; labf=""; labl=""
        notvalid = " ALL NEXT FIRST LAST PREV LEFT RIGHT "
    DO i = 1 to words(tokens)
        TOKEN = word(tokens,i)
        TOKEN = translate(TOKEN)
        IF TOKEN = "" THEN  iterate i /* should not happen*/
        IF pos(" "token" ", notvalid) > 0 then do
           zedsmsg = token "invalid"
           zedlmsg = token "not provided for, nor are" novalid
           call note "PIR" time("n") zedlmsg
           Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
           Exit 12
        END
        IF TOKEN = "DEBUG" then do; debug="DEBUG"; iterate i; end
        IF TOKEN = "NX" then do; NX="NX"; iterate i; end
        IF TOKEN = "X" then do; X="X"; iterate i; end
        IF TOKEN = "ENTIRE" then do; ENTIRE="ENTIRE"; iterate i; end
        IF SUBSTR(token,1) = "." THEN  DO
           IF LABF = "" THEN  DO
              LABF = TOKEN
              iterate i
           END
           IF LABL = "" THEN  DO
              LABL = TOKEN
              iterate i
           END
          ZEDSMSG = "LABEL" TOKEN
          ZEDLMSG = "EXACTLY TWO LABELS ARE REQUIRED ",
            "FOUND" LABF", "LABL" AND  "TOKEN
          Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
          Exit 12
        END
        IF TOKEN = ")" THEN  DO
           ZEDSMSG = "LOST PARENTHESIS"
           zedlmsg = """blanks""  separate all operands;",
              "therefore invalid in from() to() col() begin()"
           Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
           Exit 12
        END
        IF TAG1  = "" THEN  DO
           TAG1 = token
           iterate i
        END
        IF TAG2  = "" THEN  DO
           TAG2 = token
           iterate i
        END
        REMAIN = REMAIN TOKEN
    END i
    IF REMAIN  \= "" THEN  do
           zedsmsg = remain "invalid"
           zedlmsg = remain "not provided for in TAGX macro"
           call note "TAGX" time("n") zedlmsg
           call note " first two non control words are",
               "accepted as TAGS --" tag1 tag2
           Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
           Exit 12
    end
   /******************************************************************/
   /******************************************************************/
    IF "ENTIRE" = ENTIRE THEN  DO     /*** LABELS ARE REQUIRED *****/
       IF LABF = "" THEN  DO
          LABF = ".ZFIRST"
          LABL = ".ZLAST"
       END
       ELSE DO
          ZEDSMSG = "LABEL CONFLICT"
          ZEDLMSG = """ENTIRE"" implies .ZFIRST .ZLAST "
              "conflicts with" LABF "and" LABL
          Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
          Exit 12
       END
    END
    IF LABF = "" THEN  DO
          LABF = ".ZFIRST"
          LABL = ".ZLAST"
    END
    IF LABL = "" THEN  DO
          ZEDSMSG = "MISSING"  LABEL(S)
          ZEDLMSG = ZEDSMSG "-- A PAIR OF LABELS OR",
            """ENTIRE"" IS REQUIRED"
          Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
          Exit 12
    END
    /************** END OF LABEL REQUIREMENTS *******************/
    /******************** CODE FOR  TAGX     COMMANDS ************/
    /******************** CODE FOR  TAGX     COMMANDS ************/
    /******************** CODE FOR  TAGX     COMMANDS ************/
    IF TAG1  = "" THEN  TAG1 = "%B%"
    IF TAG2  = "" THEN  TAG2 = "%A%"
    SITE = X||NX   /* could be one or the other */
    IF SITE  = "" THEN  SITE = "NX"
    IF "NX" = SITE THEN  OPPOSITE = "X"
    ELSE OPPOSITE = "NX"
    "SEEK X P'=' 1 FIRST" LABF   LABL
    IF RC \= 0 THEN call badx  /* this will exit*/
    "SEEK X P'=' 1 FIRST" LABF LABL
    IF rc \= 0 then call badx  /* this will exit */
    "CURSOR = 1 0"
    call note time("n") "TAGX" tokens
    call note tag1 "will be inserted before" site,
        " line groups within range"
    call note tag2 "will be inserted after" site,
       "line groups within range"
 LOOP:
    "SEEK NEXT 1 P'='" SITE   LABF   LABL
    IF RC \= "0" THEN  call done  /* exit */
    "LINE_BEFORE .ZCSR = DATALINE (TAG1)"
    "SEEK NEXT 1 P'='" OPPOSITE   LABF   LABL
    IF RC \= "0" THEN  call done  /* exit */
    "LINE_BEFORE .ZCSR = DATALINE (TAG2)"
    signal LOOP
 DONE:
  "(VAR075) = XSTATUS" LABL
  IF VAR075 = SITE THEN  DO
     "(VAR037) = LINENUM" LABL
     VAR037 = VAR037  + 1
     "LINE_AFTER" LABL "= DATALINE (tag2)"
     IF Substr(LABL,1,2) \= ".Z" THEN
         "LABEL" VAR037 "=" LABL "0"
  END
  exit 0

  BADX:
    ZEDSMSG = "SETUP ERROR"
    ZEDLMSG = ZEDSMSG. -- REQUIRES BOTH X AND NX LINES
    call noteMSG "*ERROR**" ZEDLMSG
    call notemsg "Read documentation in IS03.SHARE.TEXT(TAGX)"
    call notemsg "  or enter  COMMAND ===> TSO CLIST TAGX HELP"
    Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
    Exit 12

note:  parse arg arg
    "LINE_BEFORE .ZFIRST = NOTELINE (arg)"
  return
noteMSG:  parse arg arg
    "LINE_BEFORE .ZFIRST = MSGLINE (arg)"
  return