LOCAL INCLUDE 'CHKERR.INC'
      INTEGER   NERRS
      CHARACTER ERRNAM(4,1000)*10
      COMMON /ERRINT/ NERRS
      COMMON /ERRCHR/ ERRNAM
LOCAL END
      PROGRAM ADVCHK
C-----------------------------------------------------------------------
C! Extracts adverbs from help files
C# Utility
C-----------------------------------------------------------------------
C;  Copyright (C) 2025
C;  Associated Universities, Inc. Washington DC, USA.
C;
C;  This program is free software; you can redistribute it and/or
C;  modify it under the terms of the GNU General Public License as
C;  published by the Free Software Foundation; either version 2 of
C;  the License, or (at your option) any later version.
C;
C;  This program is distributed in the hope that it will be useful,
C;  but WITHOUT ANY WARRANTY; without even the implied warranty of
C;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C;  GNU General Public License for more details.
C;
C;  You should have received a copy of the GNU General Public
C;  License along with this program; if not, write to the Free
C;  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,
C;  MA 02139, USA.
C;
C;  Correspondence concerning AIPS should be addressed as follows:
C;         Internet email: aipsmail@nrao.edu.
C;         Postal address: AIPS Project Office
C;                         National Radio Astronomy Observatory
C;                         520 Edgemont Road
C;                         Charlottesville, VA 22903-2475 USA
C-----------------------------------------------------------------------
C   Program to extract the adverb list from all task, verb, proc, etc
C   help files.  It writes a text file of the task name and the adverb
C   in 2 columns.
C      A logical or enviroment variable named MYDIR must be defined
C   before running ADVCHK.
C      The output will be written to a file named ADVCHK.OUT.
C-----------------------------------------------------------------------
      CHARACTER INLINE*100, LFIL*48, SUBNAM*12, ADVNAM*10,
     *   SUBS(1000)*12, LNAME*10
      INTEGER   IOERR, BUFFER(512), LUNL, FINDL, NCHK, I, LUNO, FINDO,
     *   IRET
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'CHKERR.INC'
      DATA LUNL, LUNO /18,11/
C-----------------------------------------------------------------------
C                                       AIPS system start up stuff
      TSKNAM ='ADVCHK'
      NPOPS = 1
      MSGKIL = 32000
      MSGSUP = 32000
      CALL ZDCHIN (.FALSE., BUFFER)
      MSGKIL = 32000
      MSGSUP = 32000
      DEVTAB(LUNL) = 3
      NLUSER = 1
      NERRS = 0
C                                       Get list of routines
      LFIL = 'MYDIR:ADVHLP.SRT'
      CALL ZTXOPN ('READ', LUNL, FINDL, LFIL, .FALSE., IOERR)
      IF (IOERR.NE.0) GO TO 999
      LFIL = 'MYDIR:ADVCHK.chk'
      CALL ZTXOPN ('WRIT', LUNO, FINDO, LFIL, .TRUE., IOERR)
      IF (IOERR.NE.0) GO TO 999
      NCHK = 0
      LNAME = ' '
C                                       Begin looping over files
 100     CALL ZTXIO ('READ', LUNL, FINDL, INLINE, IOERR)
         IF ((IOERR.NE.0) .AND. (IOERR.NE.2)) GO TO 890
         IF (INLINE.EQ.' ') GO TO 100
         SUBNAM = INLINE(:12)
         ADVNAM = INLINE(15:24)
         IF (IOERR.EQ.2) ADVNAM = ' '
         IF ((NCHK.GT.0) .AND. (ADVNAM.EQ.LNAME) .AND.
     *      (SUBNAM.EQ.SUBS(NCHK))) GO TO 100
         IF ((ADVNAM.NE.LNAME) .AND. (NCHK.GT.0)) THEN
            CALL CHKIT (LNAME, NCHK, SUBS, LUNO, FINDO, IRET)
            NCHK = 0
            END IF
         IF (IOERR.EQ.2) GO TO 900
         NCHK = NCHK + 1
         LNAME = ADVNAM
         SUBS(NCHK) = SUBNAM
         GO TO 100
C
 890  WRITE (6,1890) IOERR
C                                       Done - close files
 900  CALL ZTXCLS (LUNL, FINDL, IOERR)
      CALL ZTXCLS (LUNO, FINDO, IOERR)
      DO 910 I = 1,NERRS
         WRITE (MSGTXT,1900) ERRNAM(1,I), ERRNAM(2,I), ERRNAM(3,I),
     *      ERRNAM(4,I)
         CALL MSGWRT (5)
 910     CONTINUE
C
 999  STOP
C-----------------------------------------------------------------------
 1890 FORMAT (' ERROR READING FILE ',A)
 1900 FORMAT ('MISSING FILE ',A,' FROM',3(1X,A))
      END
      SUBROUTINE CHKIT (ADVNAM, NCHK, TASKS, LUNO, FINDO, IRET)
C-----------------------------------------------------------------------
C   check adverb help file ADVNAM for all tasks (verbs, procs,...)
C   in list
C   Inputs
C      ADVNAM   C*(*)      Adverb name
C      NCHK     I          Number of tasks
C      TASKS    C(*)*(*)   Task list
C-----------------------------------------------------------------------
      INTEGER   NCHK, LUNO, FINDO, IRET
      CHARACTER ADVNAM*(*), TASKS(*)*(*)
C
      INCLUDE 'INCS:DMSG.INC'
      INTEGER   LUNI, FINDI, J, JTRIM, IERR, K, I, L
      CHARACTER INLINE*100, LFIL*48, SYM*10, OUTLIN*512, LTASKS*400
      INCLUDE 'CHKERR.INC'
C-----------------------------------------------------------------------
      LUNI = 3
      J = JTRIM (ADVNAM)
      LFIL = 'HLPFIL:' // ADVNAM(:J) // '.HLP'
      CALL ZTXOPN ('QRED', LUNI, FINDI, LFIL, .FALSE., IERR)
      IF (IERR.NE.0) THEN
         NERRS = NERRS + 1
         ERRNAM(1,NERRS) = ADVNAM
         ERRNAM(2,NERRS) = TASKS(1)
         ERRNAM(3,NERRS) = TASKS(2)
         ERRNAM(4,NERRS) = TASKS(3)
         GO TO 999
         END IF
 10   CALL ZTXIO ('READ', LUNI, FINDI, INLINE, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR, 'READING ' // ADVNAM(:J)
         GO TO 990
         END IF
      IF (INLINE(:1).EQ.';') GO TO 10
      CALL GETADV (INLINE, SYM)
      IF (SYM.NE.' ') THEN
         K = JTRIM (SYM)
         DO 20 I = 1,NCHK
            IF (SYM(:K).EQ.TASKS(I)(:K)) THEN
               TASKS(I) = ' '
               GO TO 10
               END IF
 20         CONTINUE
         WRITE (MSGTXT,1020) ADVNAM(:J), SYM(:K)
         CALL MSGWRT (5)
         END IF
      GO TO 10
C
 990  IF (IERR.NE.2) THEN
         CALL MSGWRT (8)
      ELSE
         L = 0
         LTASKS = ' '
         DO 995 I = 1,NCHK
            WRITE (MSGTXT,1990) ADVNAM(:J), TASKS(I)
            IF (TASKS(I).NE.' ') THEN
               CALL MSGWRT (5)
               IF (L.GT.0) THEN
                  LTASKS(L+1:) = ','
                  L = L + 1
               END IF
               K = JTRIM (TASKS(I))
               LTASKS(L+1:) = TASKS(I)
               L = L + K
               END IF
 995        CONTINUE
         IF (L.GT.0) THEN
            WRITE (OUTLIN,1995) LTASKS(:L), ADVNAM(:J)
            K = JTRIM (OUTLIN)
            CALL ZTXIO ('WRIT', LUNO, FINDO, OUTLIN(:K), IRET)
            END IF
         END IF
      CALL ZTXCLS (LUNI, FINDI, I)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('CHKIT ERROR',I4,' ON ',A)
 1020 FORMAT (A,' has symbol ',A,' not in task list')
 1990 FORMAT (A,' has task ',A,' not in help file')
 1995 FORMAT ('echo "',A,'" | chkout $HLPFIL/',A,'.HLP')
      END
      SUBROUTINE GETADV (INLINE, SYM)
C-----------------------------------------------------------------------
C   Looks for listing if task et al in adverb help file
C   Input
C      INLINE   C*(*)   line from help file
C   Output
C      SYM      C(*)   the task
C-----------------------------------------------------------------------
      CHARACTER INLINE*(*), SYM*(*)
C
      INTEGER   I, I1, IC
      CHARACTER LCH*1
C-----------------------------------------------------------------------
      SYM = ' '
C                                       find first non-blank
      DO 10 I = 1,2
         IF (INLINE(I:I).NE.' ') GO TO 999
 10      CONTINUE
      DO 15 I = 3,6
         IF (INLINE(I:I).NE.' ') GO TO 20
 15      CONTINUE
      GO TO 999
 20   I1 = I
      DO 30 I = I1,I1+9
         LCH = INLINE(I:I)
         IF (LCH.EQ.'.') THEN
            IF (I.GT.I1) SYM = INLINE(I1:I-1)
            GO TO 900
            END IF
         IC = ICHAR(LCH)
         IF ((IC.GE.ICHAR('A')) .AND. (IC.LE.ICHAR('Z'))) GO TO 30
         IF ((IC.GE.ICHAR('0')) .AND. (IC.LE.ICHAR('9'))) GO TO 30
         GO TO 999
 30      CONTINUE
      GO TO 999
C
 900  IC = ICHAR(SYM(1:1))
      IF ((IC.GE.ICHAR('0')) .AND. (IC.LE.ICHAR('9'))) SYM = ' '
C
 999  RETURN
      END
      SUBROUTINE GETSYM (LBUFF, NPNT, SYM, IERR)
C-----------------------------------------------------------------------
C   GETSYM scrutinizes a card image to look for the next symbol.  A
C   symbol begins with a letter and contains up to eight alpha-numeric
C   characters (A-Z,0-9,_).  This routine is used for interpreting a
C   FITS tape and for interpreting the HI files.
C   Inputs:
C      LBUFF  C*)*)   Loose packed card image
C      NPNT   I       Pointer to first character
C   Output:
C      NPNT   I       Pointer value after getting symbol
C      SYM    C*(*)   Symbol, padded with blanks
C      IERR   I       Return code
C                      0--> Found legal symbol followed by '='
C                      1--> Ran off the end of the card
C                      2--> Symbol had too many characters
C                      4--> Found a '/' symbol
C                      5--> Symbol contains an illegar char
C-----------------------------------------------------------------------
      CHARACTER LBUFF*(*), SYM*(*)
      INTEGER   NPNT, IERR
C
      CHARACTER LCH*1, TSYM*8
      INTEGER   LPNT, LIMIT, IC, NKAR, NKL
      DATA LIMIT /80/
C-----------------------------------------------------------------------
C                                       Initialization
      LIMIT = LEN (LBUFF)
      NKL = LEN (SYM)
      NKAR = 0
      IERR = 0
      SYM = ' '
C                                       Check card limit
 10   IF (NPNT.GT.LIMIT) GO TO 980
C                                       Skip leading blanks
         LCH = LBUFF(NPNT:NPNT)
         IF (LCH.NE.' ') GO TO 20
            NPNT = NPNT + 1
            GO TO 10
C                                       Is the first character legal?
 20   IC = ICHAR(LCH)
      IF ((IC.GE.ICHAR('A')) .AND. (IC.LE.ICHAR('Z'))) GO TO 40
C                                       If we find a '/', good bye
         IF (LCH.EQ.'/') GO TO 940
C                                       Not legal.  Skip to next blank
 30      NPNT = NPNT + 1
         IF (NPNT.GT.LIMIT) GO TO 980
            LCH = LBUFF(NPNT:NPNT)
            IF (LCH.NE.' ') GO TO 30
C                                       Found another blank. begin
C                                       searching again
         NPNT = NPNT + 1
         GO TO 10
C                                       Find rest of symbol
 40   LPNT = NPNT
 50   NKAR = NKAR + 1
      IF (NKAR.LE.NKL) TSYM(NKAR:NKAR) = LCH
         NPNT = NPNT + 1
         IF (NPNT.GT.LIMIT) GO TO 980
         LCH = LBUFF(NPNT:NPNT)
         IC = ICHAR(LCH)
C                                       Is the character legal?
         IF ((IC.GE.ICHAR('A')) .AND. (IC.LE.ICHAR('Z'))) GO TO 50
         IF ((IC.GE.ICHAR('0')) .AND. (IC.LE.ICHAR('9'))) GO TO 50
         IF (LCH.EQ.'_') GO TO 50
         IF (LCH.EQ.'-') GO TO 50
C                                       Have we hit a ' ' or
C                                          a '='?
      IF (LCH.EQ.'=') GO TO 70
      IF (LCH.EQ.' ') GO TO 65
C                                       Illegal char.  Look for
C                                          the next space.
 62   NPNT = NPNT + 1
      IF (NPNT.GT.LIMIT) GO TO 980
      IF (LBUFF(NPNT:NPNT).NE.' ') GO TO 62
      GO TO 930
C                                       Look for an '='
C                                         or an end of card
 65   NPNT = NPNT + 1
      IF (NPNT.GT.LIMIT) GO TO 67
      IF (LBUFF(NPNT:NPNT).EQ.' ') GO TO 65
      IF (LBUFF(NPNT:NPNT).EQ.'=') GO TO 70
C                                       Legal symbol with no '='
 67   NPNT = NPNT - 2
C                                      Legal symbol with an '='
 70   NPNT = NPNT + 1
      IF (NKAR.GT.NKL) GO TO 970
C                                       Pack symbol
      SYM = TSYM(1:NKAR)
      IF (IERR.NE.0) GO TO 999
C                                       Check for HISTORY =, etc.
      IF (SYM.EQ.'HISTORY ') GO TO 999
      IF (SYM.EQ.'COMMENT ') GO TO 999
      IERR = 0
      GO TO 999
C
C-----------------------------------------------------------------------
C
C                                       Symbol contains illegal char
 930  IERR = 5
      GO TO 999
C                                       Found a '/' symbol
 940  IERR = 4
      NPNT = NPNT + 1
      GO TO 999
C                                       Symbol has more than 8 char
 970  IERR = 2
      GO TO 999
C                                       Ran out of card
 980  IERR = 1
C
 999  RETURN
      END
