      SUBROUTINE PLZ.1(L,O,R.ERR)
*PIC-LAN
*
*ALL
*PC
*N
*
*
*
*
******************************************************************************
******************************************************************************
***                                                                        ***
*** (C) Copyright 1990-2005 Doug Dumitru, All Rights Reserved.             ***
***                                                                        ***
*** This program is licensed under the terms of the GNU General Public     ***
*** License, version 2.0 with attached notices.                            ***
***                                                                        ***
*** The full text can be found in the LICENSE.TXT file in the              ***
*** PLIP.BP database file (the /usr/qmweb/PLIP.BP/PLIP.BP directory).      ***
***                                                                        ***
******************************************************************************
******************************************************************************
*
      INCLUDE SYS.TYPE.INCLUDE
*
      INCLUDE PL.COMMON
      INCLUDE PL.COMMON.DEFS
      INCLUDE PL.DEFS
      INCLUDE PLIP.COMMON
      INCLUDE PLW.COMMON
*
      INCLUDE PLZ.COMMON
*
      EQUATE JSTR1 TO '<script language="JavaScript">'
      EQUATE JSTR2 TO '  javascript:window.history.forward(1);'
      EQUATE JSTR3 TO '</script>'
*
      O = ''
*
      CMD = ''
      LL = TRIM(L)
      IF LL[1,1] = '_' THEN
         CMD = FIELD(LL,' ',1)
         LAB = ''
         W = OCONV(LL,'G1 999')
      END ELSE
         LAB = FIELD(LL,' ',1)
         IF FIELD(LL,' ',2)[1,1] = '_' THEN
            CMD = FIELD(LL,' ',2)
            W = OCONV(LL,'G2 999')
         END
      END
*
      T = INDEX(L,CMD,1)
      IF T > 1 THEN
         FMT.STR = 'L#' : ( T - 1 )
         LAB = LAB FMT.STR
      END
      IF LAB[LEN(LAB),1] <> ' ' THEN
         LAB = LAB : ' '
      END
*
      BEGIN CASE
         CASE LAB[1,1] = '*'
         CASE LAB[1,3] = 'REM'
         CASE CMD = '_INCLUDE'
            IF NOT(INDEX(W,'/',1)) AND NOT(INDEX(W,' ',1)) AND SRC.FILE <> '' THEN
               W = SRC.FILE : ' ' : W
            END
            CALL PLZ.SUB(W,1,T,R.ERR)
            LAB.N = LAB.N + 1
            T = ( 9000000 + LAB.N ) : ' T$$$ = 0' : AM : LAB : ' REM' : AM : T
            IF R.ERR <> '' THEN RETURN
            PRINT LAB.N 'R#3' : ' INCLUDE - ' : W
            ID = '__' : APP.NAME : '.' : LAB.N
            WRITE T ON DST.FD , ID
*$*         O = ( 9000000 + LAB.N ) : ' T$$$ = 0 ; ' : LAB : 'INCLUDE ' : APP.FILE : ' ' : ID : '    ;* INCLUDE ' : W
            O = 'INCLUDE ' : APP.FILE : ' ' : ID : '    ;* INCLUDE ' : W
         CASE CMD = '_TIMEOUT'
            O = LAB : 'APP$TIMEOUT = ICONV(' : W : ',"MTS")'
         CASE CMD = '_BASE'
            PG.BASE = TRIM(W)
            O = LAB : ' REM'
         CASE CMD = '_PVAR'
            W = PL_REPL(W,',',' ')
            W = TRIM(W)
            W = PL_REPL(W,' ',AM)
            LOCATE(W,P.VARS;L) THEN
               PRINT '*** Persistent Variable "' : W : '" appears more than once ***'
            END ELSE
               P.VARS<-1> = W
            END
            IF LAB <> '' THEN
               O = LAB : 'REM'
            END ELSE
               O = LAB : 'REM'
            END
         CASE CMD = '_CVAR'
            W = PL_REPL(W,',',' ')
            W = TRIM(W)
            W = PL_REPL(W,' ',AM)
            LOCATE(W,C.VARS;L) THEN
               PRINT '*** Common Variable "' : W : '" appears more than once ***'
            END ELSE
               C.VARS<-1> = W
            END
            IF LAB <> '' THEN
               O = LAB : 'REM'
            END ELSE
               O = LAB : 'REM'
            END
         CASE CMD = '_FILE'
            F.LIST<-1> = W
            O = LAB : 'REM'
         CASE CMD = '_PAGE'
            LAB.N = LAB.N + 1
            ID = '__' : APP.NAME : '_PG' : LAB.N : '.HTM'
*
            BEGIN CASE
               CASE INDEX(PG.BASE,'/',1)
                  W = PG.BASE : W
               CASE PG.BASE <> ''
                  W = PG.BASE : ' ' : W
            END CASE
*
            CALL PLZ.PARSE.FILENAME(W,TP,P1,P2)
            W = TRIM(TP : ' ' : P1 : ' ' : P2)
*
            PRINT LAB.N 'R#3' : ' PAGE    - ' : W
*
            CALL PLU.READ.FILE(W,'A',SRC)
            IF SRC = '' THEN
               PRINT
               PRINT 'Error reading page ' : W
               PRINT
               STOP
            END
*      
            CALL PLZ.PARSE.PAGE(SRC,W,DST.FD,DST,DST2,DST3,FV.LST,R.ERR)
            IF R.ERR <> '' THEN
               PRINT
               PRINT 'Error generating HTML page:'
               PRINT
               PRINT '   ' : R.ERR
               PRINT
               STOP
            END
*
            NO.FV = DCOUNT(FV.LST,AM)
            FOR FV.CNT = 1 TO NO.FV
               FV.NAME = FV.LST<FV.CNT>
               IF INDEX(FV.NAME,'<',1) THEN
                  FV.NAME = FIELD(FV.NAME,'<',1)
                  LOCATE(FV.NAME,PG.VARS;L) ELSE
                     PG.VARS<-1> = FV.NAME
                  END
               END
            NEXT FV.CNT
*
            IF J.OPT THEN
               IF NOT(INDEX(OCONV(DST,'MCL'),JSTR2,1)) THEN
                  T = INDEX(OCONV(DST,'MCL'),'</head',1)
                  IF T > 2 THEN
                     DST = DST[1,T-1] : AM : JSTR1 : AM : JSTR2 : AM : JSTR3 : AM : DST[T,BIG.STR]
                  END
               END
            END
*
            WRITE DST ON DST.FD , ID
*
            READ T FROM BP.FD , 'PLZ.PAGE.TEMPLATE' ELSE CALL PLXX.STOP(202,'PLZ.PAGE.TEMPLATE')
*
            S = ''
            S<-1> = DST3
            S<-1> = '*'
*$*         S<-1> = '      L$STK<1,1,2> = ' : LAB.N
*$*         S<-1> = '      GOSUB 9900200'
            S<-1> = '      L$STK = INSERT(L$STK,1,1,0,"' : A.NAME : '":SVM:' : LAB.N : ')'
            S<-1> = '      L$STK = INSERT(L$STK,1,1,0,"' : ID : '")'
*$*         S<-1> = '*'
*$*         S<-1> = '      CALL PLW.PAGE("' : ID : '","",R.ERR)'
            S<-1> = '*'
            S<-1> = '*'
            S<-1> = '      RETURN'
            S<-1> = '*'
            S<-1> = ( 9000000 + LAB.N ) : ' REM'
            S<-1> = DST2
*
            T = PL_REPL(T,'###NAME###',W)
            T = PL_REPL(T,'###CODE###',S)
*
            ID = '__' : APP.NAME : '.' : LAB.N
            WRITE T ON DST.FD , ID
            O = LAB : 'INCLUDE ' : APP.FILE : ' ' : ID : '    ;* Calling page ' : W
         CASE CMD = '_CALL'
            LAB.N = LAB.N + 1
*
            PRINT LAB.N 'R#3' : ' CALL    - ' : W
*
            READ T FROM BP.FD , 'PLZ.CALL.TEMPLATE' ELSE CALL PLXX.STOP(202,'PLZ.CALL.TEMPLATE')
*
            S.ID = '$' : FIELD(W,' ',1) : '.HTM'
            V.NAMES = FIELD(W,' ',2)
*
            S = ''
            S<-1> = '      S.ID$$$ = "$" : ' : FIELD(W,' ',1) : ' : ".HTM"'
            S<-1> = '      L$STK = INSERT(L$STK,1,1,0,"' : A.NAME : '":SVM:' : LAB.N : ')'
            S<-1> = '      L$STK = INSERT(L$STK,1,1,0,"$":' : FIELD(W,' ',1) : ':".HTM")'
*$*         S<-1> = '      L$STK<1,1,2> = ' : LAB.N
*$*         S<-1> = '      N$STK = INSERT(L$STK,1,1,0,S.ID$$$:SVM:0)'
*$*         S<-1> = '      WRITE "" ON PL$APP.FD , L$ID : "*" : DCOUNT(N$STK,VM)'
            S<-1> = '*'
*
            N = 490
            DST = ''
            J1 = DCOUNT(V.NAMES,',')
            FOR J = 1 TO J1
               V = TRIM(FIELD(V.NAMES,',',J))
               FLG = NO
               SS = '"' : "'" : '<>,:=-/*'
               K1 = LEN(SS)
               FOR K = 1 TO K1 UNTIL FLG
                  IF INDEX(V,SS[K,1],1) THEN FLG = YES
               NEXT K
               S<-1> = '      USER.COMMON(' : N : ') = ' : V
               IF NOT(FLG) THEN
                  DST<-1> = '      ' : V : ' = USER.COMMON(' : N : ')'
               END
               N = N - 1
            NEXT J
            S<-1> = '*'
*$*         S<-1> = '      GOSUB 9900200'
*$*         S<-1> = '*'
*$*         S<-1> = '      L$STK = N$STK'
*$*         S<-1> = '*'
*$*         S<-1> = '      CALL PLW.PAGE(S.ID$$$,"",R.ERR)'
*
*$*         S<-1> = '*'
*$*         S<-1> = '      IF APP$BASE THEN'
*$*         S<-1> = '         WRITEV L$STK ON PL$APP.FD , L$ID , APP$STK$N'
*$*         S<-1> = '         WRITE RESX ON PL$APP.FD , L$ID : "**"'
*$*         S<-1> = '      END'
            S<-1> = '*'
            S<-1> = '      RETURN'
            S<-1> = '*'
            S<-1> = ( 9000000 + LAB.N ) : ' REM'
            IF DST <> '' THEN
               S<-1> = '*'
               S<-1> = DST
            END
*
            T = PL_REPL(T,'###NAME###',W)
            T = PL_REPL(T,'###CODE###',S)
*
            ID = '__' : APP.NAME : '.' : LAB.N
            WRITE T ON DST.FD , ID
            O = LAB : 'INCLUDE ' : APP.FILE : ' ' : ID : '    ;* Calling subroutine ' : W
         CASE CMD = '_GOSUB'
            LAB.N = LAB.N + 2
*
            PRINT LAB.N 'R#3' : ' GOSUB   - ' : W
*
            READ T FROM BP.FD , 'PLZ.GOSUB.TEMPLATE' ELSE CALL PLXX.STOP(202,'PLZ.GOSUB.TEMPLATE')
*
            S.ID = A.NAME
*
            S = ''
            S<-1> = '      L$STK = INSERT(L$STK,1,1,0,"' : A.NAME : '":SVM:' : LAB.N : ')'
            S<-1> = '      L$STK = INSERT(L$STK,1,1,0,"' : A.NAME : '":SVM:' : (LAB.N-1) : ')'
*$*         S<-1> = '      L$STK<1,1,2> = ' : LAB.N
*$*         S<-1> = '      N$STK = INSERT(L$STK,1,1,0,L$STK<1,1,1>:SVM:' : (LAB.N-1) : ')'
*$*         S<-1> = '*'
*$*         S<-1> = '      GOSUB 9900200'
*$*         S<-1> = '*'
*$*         S<-1> = '      L$STK = N$STK'
*$*         S<-1> = '*'
*$*         S<-1> = '      CALL PLW.PAGE(L$STK<1,1,1>,"",R.ERR)'
*$*         S<-1> = '*'
*$*         S<-1> = '      IF APP$BASE THEN'
*$*         S<-1> = '         WRITEV L$STK ON PL$APP.FD , L$ID , APP$STK$N'
*$*         S<-1> = '         WRITE RESX ON PL$APP.FD , L$ID : "**"'
*$*         S<-1> = '      END'
            S<-1> = '*'
            S<-1> = '      RETURN'
            S<-1> = '*'
            S<-1> = ( 9000000 + LAB.N - 1 ) : ' GOTO ' : W
            S<-1> = '*'
            S<-1> = ( 9000000 + LAB.N ) : ' REM'
*
            T = PL_REPL(T,'###NAME###',W)
            T = PL_REPL(T,'###CODE###',S)
*
            ID = '__' : APP.NAME : '.' : LAB.N
            WRITE T ON DST.FD , ID
            O = LAB : 'INCLUDE ' : APP.FILE : ' ' : ID : '   ;* Calling local subroutine ' : W
         CASE CMD = '_RETURN'
            O = LAB : 'GOTO 9900300 ;* _RETURN'
      END CASE
*
      RETURN
   END
