C*DOCUMENT C+ PROGRAM DOCUME C C DOCUMENT extracts documentation from Fortran source code files. C Documentation information is flagged by special characters in C columns 1--3: C C C+ Start of documentation block (this line C is not part of the block) C C C-- End of documentation block (this line C is not part of the block) C C C* Start of a new module; the rest of line C (up to first blank) is the module name. If no such delimiter C is encountered, the module name is the file name (excluding C disk, directory, type, version, etc.) C C Usage: C DOCUMENT uses standard KEYIN control parameters: C INPUT: the name of the input disk file(s), which may include C VMS wild-cards; must be specified. C LISTFILE: the name for the output listing; default |SYS$OUTPUT|. C TYPE: specify the format for the output file as C `LIST' (default) C `INDEX' for index of modules only C `HELP' for a VMS help file C `TEX' for TeX code. C C History: C 1.0: 1985 May 21 -- (T. J. Pearson, VAX-11 Fortran). C 1.1: 1985 Oct 8 -- change delimiters to VLBA standard. C 1.2: 1985 Oct 8 -- add TYPE parameter. C 1.4: 1987 May 19 -- add TeX option. C 1.5: 1987 Nov 12 -- add INDEX option. C C Subroutines required: C |ISTERM| (VLB) is device a terminal? C |KEYIN| (VLB) parameter input. C |LEN1| (VLB) length of string less trailing blanks. C |LIB$FIND_FILE| (VMS) wild-card expansion. C |LIB$SYS_GETMSG| (VMS) system error message. C---------------------------------------------------------------------- C C Constants. C CHARACTER*(*) VERSN INTEGER INC,OUTC,INDAT,PR,NPARS INTEGER RMS$_NMF PARAMETER (VERSN='1.5 - 1987 Nov 12') PARAMETER (INC=5,OUTC=6,INDAT=1,PR=2) C ! I/O unit numbers PARAMETER (NPARS=22) C ! number of KEYIN parameters PARAMETER (RMS$_NMF = '000182CA'X) C ! VMS code C C Variables. C CHARACTER INPFIL*128, INDSN*128, LISFIL*128 CHARACTER TEXT*128, TYPE*16, DEFNAM*32 CHARACTER LFMT*16 INTEGER L1, LINP, LLIS, NFIL INTEGER CONTXT, I, IER, J, L, LDSN, MODE, NREC LOGICAL PROPEN, COPY, HELP, TEX, INDEX REAL*8 ENDMRK, PARS(NPARS), VALS(NPARS) C C External functions. C INTEGER LIB$FIND_FILE, LEN1 LOGICAL ISTERM C C Initialize KEYIN parameters. C DATA ENDMRK/'/'/ DATA PARS/ 'Input', 9*' ', 1 'Listfile', 9*' ', 2 'Type', ' '/ DATA VALS/ '***UNSET', 9*' ', 1 'SYS$OUTP','UT',8*' ', 2 'LIST', ' ' / C C Formats. C 600 FORMAT(' DOCUMENT extracts documentation from source code'/ 1 ' (Version ',A,')'/) 605 FORMAT(' Control parameters (INPUT, LISTFILE, TYPE;', 1 ' end with /):') 610 FORMAT(1X,A,T20,A) 620 FORMAT(72('-')) 650 FORMAT(' ++WARNING++ No documentation found in input file(s).') C----------------------------------------------------------------------- C C Introduction. C WRITE (OUTC,600) VERSN C C Control parameters. C WRITE (OUTC,605) 10 MODE = 1 IF (ISTERM('SYS$INPUT')) MODE = 2 CALL KEYIN(PARS,VALS,NPARS,ENDMRK,MODE,INC,OUTC) IF (MODE.NE.0) GOTO 80 WRITE (INPFIL,'(10A8)') (VALS(I),I=1,10) LINP = LEN1(INPFIL) WRITE (LISFIL,'(10A8)') (VALS(I),I=11,20) LLIS = LEN1(LISFIL) WRITE (TYPE,'(2A8)') (VALS(I),I=21,22) HELP = TYPE(1:1).EQ.'H' .OR. TYPE(1:1).EQ.'h' TEX = TYPE(1:1).EQ.'T' .OR. TYPE(1:1).EQ.'t' INDX = TYPE(1:1).EQ.'I' .OR. TYPE(1:1).EQ.'i' IF (HELP) THEN DEFNAM = 'DOCUMENT.HLP' LFMT = '(2X,A)' ELSE IF (TEX) THEN DEFNAM = 'DOCUMENT.TEX' LFMT = '(A)' ELSE DEFNAM = 'DOCUMENT.DOC' LFMT = '(A)' END IF C C Expand wild cards and open input file. C PROPEN = .FALSE. CONTXT = 0 NFIL = 0 20 NFIL = NFIL+1 IER = LIB$FIND_FILE(INPFIL(1:LINP),INDSN,CONTXT) IF (IER.EQ.RMS$_NMF) GOTO 80 IF (.NOT.IER) THEN CALL LIB$SYS_GETMSG(IER,L,TEXT) WRITE (OUTC,'(1X,A)') TEXT(1:L) GOTO 10 END IF OPEN (UNIT=INDAT, FILE=INDSN, STATUS='OLD', READONLY, 1 FORM='FORMATTED', ERR=10) INQUIRE (UNIT=INDAT, NAME=INDSN) LDSN = MIN(132,LEN1(INDSN)) C C Open output file (first time only). C IF (.NOT.PROPEN) THEN OPEN (UNIT=PR, FILE=LISFIL(1:LLIS), STATUS='NEW', 1 CARRIAGECONTROL='LIST', IOSTAT=IER, 2 DEFAULTFILE=DEFNAM, FORM='FORMATTED') IF (IER.NE.0) THEN WRITE (OUTC,'(1X,2A)') 'Cannot open LISTFILE, ', 1 LISFIL(1:LLIS) CLOSE (UNIT=INDAT) GOTO 10 END IF PROPEN = .TRUE. END IF C C Write out file name. C IF (INDX) THEN WRITE (PR, '(/A/)') INDSN(1:LDSN) END IF C C Read input file and look for flags. C NREC = 0 COPY = .FALSE. 30 READ (INDAT,END=70,ERR=70, FMT='(Q,A)') L,TEXT IF (L.GE.3 .AND. TEXT(1:3).EQ.'C--') THEN IF (COPY.AND.TEX) WRITE (UNIT=PR, FMT='(A)') '\endtt}' COPY = .FALSE. END IF IF (COPY) THEN L1 = 1 IF (TEXT(1:2).EQ.'C ') L1 = 3 IF (L1.GT.L) L = L1 WRITE (UNIT=PR, FMT=LFMT) TEXT(L1:L) END IF IF (L.GE.2 .AND. TEXT(1:2).EQ.'C+') THEN IF ((.NOT.COPY).AND.TEX) 1 WRITE (UNIT=PR, FMT='(A)') '{\eightpoint\begintt' COPY = .TRUE. .AND. (.NOT.INDX) END IF IF (L.GT.2 .AND. TEXT(1:2).EQ.'C*') THEN IF (HELP) THEN WRITE (UNIT=PR, FMT='(I1,1X,A)') 2,TEXT(3:L) ELSE IF (TEX) THEN WRITE (UNIT=PR, FMT='(/3A)') '\module{',TEXT(3:L),'}' ELSE IF (INDX) THEN WRITE (UNIT=PR, FMT='(A)') TEXT(3:L) ELSE WRITE (UNIT=PR, FMT='(/)') WRITE (UNIT=PR, FMT=620) WRITE (UNIT=PR, FMT='(2A)') 'Module: ',TEXT(3:L) * WRITE (UNIT=PR, FMT='(2A)') 'File: ',INDSN(1:LDSN) WRITE (UNIT=PR, FMT=620) WRITE (UNIT=PR, FMT='(:)') END IF END IF NREC = NREC+1 GOTO 30 C C End of file: go and find another one. C 70 CLOSE (UNIT=INDAT) GOTO 20 C C End of job: close output file if open, else give message. C 80 IF (PROPEN) THEN CLOSE (UNIT=PR) ELSE WRITE (UNIT=OUTC,FMT=650) END IF C END