      PROGRAM ADVHLP
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 ADVHLP.
C      The output will be written to a file named ADVHLP.OUT.
C-----------------------------------------------------------------------
      CHARACTER INLINE*100, OUTLIN*24, INFIL*48, OUTFIL*48, LFIL*48,
     *   SUBNAM*12, ADVNAM*10, SYM*12
      INTEGER   IOERR, BUFFER(512), LUNI, LUNO, FINDI, FINDO, LUNL,
     *   FINDL, JTRIM, JT, J, IERR, NP
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DMSG.INC'
      DATA LUNI, LUNO, LUNL /16, 17, 18/
C-----------------------------------------------------------------------
C                                       AIPS system start up stuff
      TSKNAM ='ADVHLP'
      NPOPS = 1
      MSGKIL = 32000
      MSGSUP = 32000
      CALL ZDCHIN (.FALSE., BUFFER)
      MSGKIL = 32000
      DEVTAB(LUNI) = 3
      DEVTAB(LUNO) = 3
      DEVTAB(LUNL) = 3
C                                       Get list of routines
      LFIL = 'MYDIR:HLPA.LIST'
      CALL ZTXOPN ('READ', LUNL, FINDL, LFIL, .FALSE., IOERR)
      IF (IOERR.NE.0) GO TO 999
C                                       Open output file
      OUTFIL = 'MYDIR:ADVHLP.OUT'
      CALL ZTXOPN ('WRIT', LUNO, FINDO, OUTFIL, .TRUE., IOERR)
      IF (IOERR.NE.0) GO TO 900
C                                       Begin looping over files
 100     CALL ZTXIO ('READ', LUNL, FINDL, INLINE, IOERR)
         IF (IOERR.NE.0) GO TO 900
         JT = JTRIM (INLINE)
         IF (INLINE.EQ.' ') GO TO 900
         IF (INLINE(JT-3:JT).EQ.'.HLP') JT = JT - 4
         SUBNAM = INLINE(:JT)
C                                       Form input names etc
         INFIL = 'HLPFIL:' // SUBNAM(:JT) // '.HLP'
C                                       Open input file
         CALL ZTXOPN ('QRED', LUNI, FINDI, INFIL, .FALSE., IOERR)
         IF (IOERR.NE.0) GO TO 100
C                                       Digest file:
C                                       Read line loop
 200        CALL ZTXIO ('READ', LUNI, FINDI, INLINE, IOERR)
C                                       End of file?
            IF (IOERR.EQ.2) GO TO 600
C                                       Error?
            IF (IOERR.GT.0) GO TO 590
            J = JTRIM (INLINE)
C                                       Categories
            IF (INLINE(:2).NE.';#') GO TO 200
            NP = 3
            CALL CHLTOU (J, INLINE)
            CALL GETSYM (INLINE, NP, SYM, IERR)
            IF ((IERR.NE.0) .AND. (IERR.NE.3)) THEN
               WRITE (6,1200) IERR, SUBNAM(:JT), INLINE(:20)
               GO TO 600
               END IF
            IF (SYM.EQ.'ADVERB') GO TO 600
            IF (SYM.EQ.'OBSOLETE') GO TO 600
            IF (SYM.EQ.'INFORMATION') GO TO 600
            IF ((SYM.NE.'PROCEDURE') .AND. (SYM.NE.'PSEUDOVERB') .AND.
     *         (SYM.NE.'TASK') .AND. (SYM.NE.'RUN') .AND.
     *         (SYM.NE.'VERB')) THEN
               WRITE (6,1205) SUBNAM(:JT), SYM
               GO TO 600
               END IF
C                                       skip copyleft
 210        CALL ZTXIO ('READ', LUNI, FINDI, INLINE, IOERR)
C                                       End of file?
            IF (IOERR.EQ.2) GO TO 600
C                                       Error?
            IF (IOERR.GT.0) GO TO 590
            IF (INLINE(:1).EQ.';') GO TO 210
C                                       next 2 lines
            CALL ZTXIO ('READ', LUNI, FINDI, INLINE, IOERR)
C                                       End of file?
            IF (IOERR.EQ.2) GO TO 600
C                                       Error?
            IF (IOERR.GT.0) GO TO 590
            IF (INLINE(:4).EQ.'----') GO TO 600
C                                       read for adverbs
 220        CALL ZTXIO ('READ', LUNI, FINDI, INLINE, IOERR)
C                                       End of file?
            IF (IOERR.EQ.2) GO TO 600
C                                       Error?
            IF (IOERR.GT.0) GO TO 590
            IF (INLINE(:1).EQ.';') GO TO 210
            IF (INLINE(:4).NE.'----') THEN
               ADVNAM = INLINE(:9)
               OUTLIN = SUBNAM // '  ' // ADVNAM
               IF (ADVNAM.NE.' ') THEN
                  CALL ZTXIO ('WRIT', LUNO, FINDO, OUTLIN, IERR)
                  IF (IERR.NE.0) THEN
                     WRITE (6,1220) IERR, SUBNAM, ADVNAM
                     GO TO 600
                     END IF
                  END IF
               GO TO 220
               END IF
            GO TO 600
C                                       Error - close file
 590     WRITE (6,1590) SUBNAM
C                                       End - close file
 600     CALL ZTXCLS (LUNI, FINDI, IOERR)
         IF (IOERR.NE.0) GO TO 900
C                                       Next file
         GO TO 100
C                                       Done - close files
 900  CALL ZTXCLS (LUNO, FINDO, IOERR)
      CALL ZTXCLS (LUNL, FINDL, IOERR)
 999  STOP
C-----------------------------------------------------------------------
 1200 FORMAT (' ERROR',I3,' ON ',A,1X,A)
 1205 FORMAT (' UNKNOWN TYPE ON ',A,' = ',A)
 1220 FORMAT (' ERROR',I4,' ON ',A,' ',A)
 1590 FORMAT (' ERROR READING FILE ',A)
      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*80  Loose packed card image
C      NPNT   I     Pointer to first character
C   Output:
C      NPNT   I     Pointer value after getting symbol
C      SYM    C*8   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                      3--> Found legal symbol with no '='
C                           or SYM is HISTORY or COMMENT
C                      4--> Found a '/' symbol
C                      5--> Symbol contains an illegar char
C-----------------------------------------------------------------------
      CHARACTER LBUFF*(*), SYM*(*)
      INTEGER   NPNT, IERR
C
      CHARACTER LCH*1, TSYM*20
      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
