/*HTMLOL    AUTHOR: DAVID MCRITCHIE, CREATED 1995/05/30 IS03 -REXX-  */
/*          "THE REXX MACROS TOOLBOX"                                */
/*          ORIG.   1988/02/25 WAS EDITOL UPON WHICH THIS IS MODIFIED*/
/*          UPDATED 1992/04/13 09:26 IS03 TO FIT IN 71 COLUMNS       */
/*          UPDATED 1995/05/30 10:00 CREATE HTMLOL FROM EDITOL       */
/*********************************************************************/
/* TITLE:       HTMLOL THE INCLUSIVE LINES BETWEEN TWO LABELS        */
/* USERS:       TSO ISPF EDIT USERS   | SCRIPT USERS                 */
/* CONTRIBUTED: 1987/02/19 DAVID MCRITCHIE                           */
/*                                                                   */
/* EXAMPLE:     HTMLOL   .ZFIRST .ZLAST                              */
/*                                                                   */
/* OPTIONS:                                                          */
/*     LPTR-RANGE | ENTIRE   (REQUIRED) LINE POINTER RANGE           */
/*  <<<ADDITIONAL OPERANDS>>>                                        */
/* PURPOSE -- CHECK   NESTING OF  <OL> </OL>, <MENU> </MENU>, 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:                                                 */
/*       ===> HTMLOL                                                 */
/*       ===> HTMLOL LVL2; LABNX; HTMLOL LVL1                        */
/*       ===> HTMLOL NEST                                            */
/*  ...............................................                  */
/*  NEED TO OBTAIN STARTING LABELS OF REFBEG REFEND                  */
/*  ...............................................                  */
/*********************************************************************/
   ADDRESS "ISREDIT"; "MACRO (TOKEN)"
   TOKEN = TRANSLATE(' '||TOKEN||' ')
   LABF='.ZFIRST';LABL='.ZLAST';NOGOOD=''
   R. = ""; RCNT=0;
   LVLXX=0
   ECTL = '**ERROR** ATTEMPTING TO USE      ==>',
         'HTMLOL' 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 HTMLOL, REMOVE OR CORRECT'
     /*ADDRESS*/ "ISPEXEC" " SETMSG MSG(ISRZ000)"
     RETURN 12
   END
 END_TOK:
 /****************************************************************/
  /****************** CODE FOR  HTMLOL COMMANDS ***************/
  /****************** CODE FOR  HTMLOL COMMANDS ***************/
  /****************** CODE FOR  HTMLOL COMMANDS ***************/
  ERROR=0; LEVEL=0; LVLDL=0; LVLGL=0; LVLOL=0; LVLSL=0; LVLUL=0;
  LVLMENU=0;LVLDIR=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"
  X4 = SUBSTR(VAR036,1,4)
  X4 = TRANSLATE(X4)
  X5 = SUBSTR(VAR036,1,5)
  X5 = TRANSLATE(X5)
  X6 = SUBSTR(VAR036,1,6)
  X6 = TRANSLATE(X6)
  X7 = SUBSTR(VAR036,1,7)
  X7 = TRANSLATE(X7)
  IF X6 = '<DIR>' THEN DO
        IF LVLDIR = 0 THEN "LABEL .ZCSR = .TDIR 0"
        LEVEL =  LEVEL  + 1
        LVLDIR = LVLDIR + 1
        CALL   NESTX DIR LVLDIR
  END
  IF X7 = '</DIR>' THEN DO
        LEVEL = LEVEL - 1
        LVLDIR = LVLDIR - 1
        IF LVLDIR = 0 THEN "RESET LABEL .TDIR .TDIR"
        CALL UNNESTX DIR LVLDIR
        SIGNAL TSTLVL
  END
  /* -----------*/
  IF X6 = '<MENU>' THEN DO
        IF LVLMENU = 0 THEN "LABEL .ZCSR = .TMENU 0"
        LEVEL =  LEVEL  + 1
        LVLMENU = LVLMENU + 1
        CALL   NESTX MENU LVLMENU
  END
  IF X7 = '</MENU>' THEN DO
        LEVEL = LEVEL - 1
        LVLMENU = LVLMENU - 1
        IF LVLMENU = 0 THEN "RESET LABEL .TMENU .TMENU"
        CALL UNNESTX MENU LVLMENU
        SIGNAL TSTLVL
  END
  /* -----------*/
  IF X4 = '<OL>' THEN DO
        IF LVLOL = 0 THEN "LABEL .ZCSR = .TAGOL 0"
        LEVEL =  LEVEL  + 1
        LVLOL =  LVLOL  + 1
        CALL   NESTX OL LVLOL
  END
  IF X5 = '</OL>' THEN DO
        LEVEL = LEVEL - 1
        LVLOL = LVLOL - 1
        IF LVLOL = 0 THEN "RESET LABEL .TAGOL .TAGOL"
        CALL UNNESTX OL LVLOL
        SIGNAL TSTLVL
  END
  /* -----------*/
  IF X4 = '<SL>' THEN DO
        IF LVLSL = 0 THEN "LABEL .ZCSR = .TAGSL 0"
        LEVEL = LEVEL + 1
        LVLSL = LVLSL + 1
        CALL   NESTX SL LVLSL
  END
  IF  X5   = '</SL>' THEN DO
        LEVEL =  LEVEL - 1
        LVLSL =  LVLSL - 1
        IF  LVLSL = 0 THEN "RESET LABEL .TAGSL .TAGSL"
        CALL UNNESTX SL LVLSL
        SIGNAL TSTLVL
  END
  /* -----------*/
  IF  X4   = '<UL>' THEN DO
        IF LVLUL = 0 THEN "LABEL .ZCSR = .TAGUL 0"
        LEVEL = LEVEL + 1
        LVLUL = LVLUL + 1
        CALL   NESTX UL LVLUL
  END
  IF  X5   = '</UL>' THEN DO
        LEVEL = LEVEL - 1
        LVLUL = LVLUL - 1
        IF LVLUL = 0 THEN "RESET LABEL .TAGUL .TAGUL"
        CALL UNNESTX UL LVLUL
        SIGNAL TSTLVL
  END
  /* -----------*/
  IF  X4   = '<DL>' THEN DO
        IF LVLDL = 0 THEN "LABEL .ZCSR = .TAGDL 0"
        LEVEL = LEVEL + 1
        LVLDL = LVLDL + 1
        CALL   NESTX DL LVLDL
  END
  IF X5 = '</DL>' THEN DO
        LEVEL = LEVEL - 1
        LVLDL = LVLDL - 1
        IF LVLDL = 0 THEN "RESET LABEL .TAGDL .TAGDL"
        CALL UNNESTX DL LVLDL
        SIGNAL TSTLVL
  END
  /* -----------*/
  IF X4 = '<GL>' THEN DO
        IF LVLGL = 0 THEN "LABEL .ZCSR = .TAGGL 0"
        LEVEL = LEVEL + 1
        ERROR =  ERROR + 1
        IF ERROR = 1 THEN DO
           "LINE_AFTER .ZCSR = MSGLINE 'ERROR=1 "X4" NOT IN HTML'"
        END
        LVLGL = LVLGL + 1
        CALL   NESTX GL LVLGL
  END
  IF X5 = '</GL>' THEN DO
        LEVEL = LEVEL - 1
        LVLGL = LVLGL - 1
        ERROR =  ERROR + 1
        IF ERROR = 1 THEN DO
           "LINE_AFTER .ZCSR = MSGLINE 'ERROR=1 "X5" NOT IN HTML'"
        END
        IF LVLGL = 0 THEN "RESET LABEL .TAGGL .TAGGL"
        CALL UNNESTX GL LVLGL
        SIGNAL TSTLVL
  END
  /* -----------*/
  IF X4 \= '<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')""""
     "LINE_AFTER .ZCSR = NOTELINE",
         """<LI> ERROR -- LEVEL ="LEVEL,
         "MENU="LVLMENU" DIR="LVLDIR" GL="LVLGL"" 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 X4 = '<H1>' | X4 = '<H2>' | X4 = '<H3>' | X4 = '<H4>' |,
      X4 = '<H5>' | X4 = '<H6>',
  THEN DO
        DO WHILE RCNT > 0
           IF RCNT \= 0 THEN DO
              "LINE_BEFORE .ZCSR = NOTELINE """,
                 R.RCNT "HAS NOT BEEN TERMINATED BEFORE" X4""""
              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" MENU="LVLMENU,
              ||" -- "TIME('N')""""
           "LINE_BEFORE .ZCSR = NOTELINE """,
             "OPEN OR INVALID LIST STATUS ENCOUNTERED AT" X4 """"
           "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"
           IF LVLMENU > 0 THEN "RESET .TMENU .TMENU"
           LVLOL = 0; LVLSL=0; LVLUL=0; LVLDL=0; LVLGL=0; LEVEL=0;
           LVLMENU=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 END OF HTML"""
        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 ""HTMLOL 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
  I = POS(" ",R.RCNT)
  X2=SUBSTR(R.RCNT,2,I-3)
  IF TYPE /= X2 THEN
    "LINE_AFTER .ZCSR = NOTELINE ""EXPECTING </"X2"> FOUND </"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