PROGRAM WORIDX C C Routine to produce a full index of a Word-11 account. C The account can be specified or allowed to default to the users C account. The index is much like the WORD-11 Index, but with C the following additional information: C C Number of disk blocks C Total number of files C Total number of disk blocks C C Compile and task build commands C FORTRAN/F77 WORINDEX/TRACEBACK:NONE C WORINDEX=WORINDEX C LB:[1,24]CHSLIB/LB C / C UNITS=4 C ASG=TI:4 C MAXBUF=512 C SUPLIB=FCSFSL:SV C // C C To get WORD-11 to print the output from this program: C C T Transfer Utility (from Main Menu) C WD Text file conversion C DN index Document name of index (up to you) C FI WORINDEX.LST The file to be converted (this output) C DE yes Delete the text file after conversion C go Go do the conversion (goes to Main Menu after) C P index Print the WORD-11 index just created C TM 1 Top margin of 1 (64 lines of text per page) C BM 1 Bottom margin of 1 C DE yes Delete the document after printing C go Print it and return to Main Menu C C This should all go into a UDK, but I had troubles the first time C I tried it. C C Modifications: C C 6-JUN-83 The revision dates and creation dates are not really C valid since those are RSX file creation dates. WORD-11 C works on temporary files and renames these, thereby C invalidating the dates. This is also true of number C of revisions. These features are now removed. Removed C the calls to DSP, it took too long to cycle through C each one. Use instead SRD to retrieve ordered file C list. Store in BLOCKS array - should be faster C But it requires that SRD be installed! C Also added VT100 goodies. BLT C IMPLICIT INTEGER (A-Z) C PARAMETER (MAXFIL=1000) C CHARACTER FILNAM*32,CMDLIN*80,UFD*9 CHARACTER ADATE*9,ATIME*8 BYTE DUM(4),TSKUIC(2),BYTBUF(512),NAME(51),TYPE,CURENT,FF,ESC DIMENSION STATS(8),GTSKBF(16),WRDBUF(256),BLOCKS(MAXFIL) REAL TSKNAM LOGICAL VT100 EQUIVALENCE (GTSKBF(8),TSKUIC(1)),(BYTBUF(1),WRDBUF(1)) C PARAMETER (LST=1,IDX=2,AUX=3,CRT=4,FF="14,ESC="33) C DATA TSKNAM/6RMCR.../,BLOCKS/MAXFIL*0/ CALL DATE(ADATE) CALL TIME(ATIME) C CALL GETTSK(GTSKBF) ! Get UIC from task parameters GROUP = TSKUIC(2) MEMBER = TSKUIC(1) ENCODE (9,5,UFD) GROUP,MEMBER 5 FORMAT ('[',O3.3,',',O3.3,']') UFDLEN = 9 CALL COMUFD(UFD,UFDLEN) C C Get the UFD from the command line C CALL GETMCR(CMDLIN,N) IF (N.LE.0) GO TO 15 I = INDEX(CMDLIN,'[') J = INDEX(CMDLIN,']') LEN = J-I+1 IF (LEN.LE.4) THEN WRITE (CRT,10) CMDLIN 10 FORMAT (' ** ',A,' is not legal account syntax **',/) GO TO 15 ELSE UFD = CMDLIN(I:J) UFDLEN = LEN ENDIF GO TO 40 C C Get the UFD from the user C 15 WRITE (CRT,20) UFD 20 FORMAT ('$Enter the Word-11 account ( for ', $ A,') : ') READ (CRT,25,END=135,ERR=15) LEN,CMDLIN 25 FORMAT (Q,A9) IF (LEN.EQ.0) THEN GO TO 40 ELSEIF (INDEX(CMDLIN,'[').EQ.0.OR.INDEX(CMDLIN,']').EQ.0 $ .OR.LEN.LE.4) THEN WRITE (CRT,30) 30 FORMAT (' ** Not valid account syntax **') GO TO 15 ELSE I = INDEX(CMDLIN,'[') J = INDEX(CMDLIN,']') UFD = CMDLIN(I:J) UFDLEN = J-I+1 ENDIF 40 CALL COMUFD(UFD,UFDLEN) ! Remove leading zeroes in UFD C C Get the List of documents using SRD. Read through list and C put the Number of blocks for that document number in the array C BLOCKS. C CMDLIN = 'SRD TEMPSRD.TMP=SY:' CMDLIN(20:19+UFDLEN) = UFD CMDLEN = UFDLEN+32 CMDLIN(20+UFDLEN:CMDLEN) = 'WPS%%%.WPS/LI' CALL SPAWN(TSKNAM,GROUP,MEMBER,5,,STATS,,CMDLIN,CMDLEN,,,IDSW) CALL STOPFR(5) STATUS = STATS(1) IF (STATUS.NE.1) THEN WRITE (CRT,45) 45 FORMAT (' ** System error, Could not spawn SRD **') CALL EXIT ENDIF OPEN(UNIT=AUX,FILE='TEMPSRD.TMP',DISPOSE='DELETE',STATUS='OLD') 50 READ (AUX,55,END=70) N,CMDLIN 55 FORMAT (Q,A80) IF (CMDLIN(3:5).NE.'WPS') GO TO 50 DECODE (3,60,CMDLIN(6:8)) DOC 60 FORMAT (I3) J = INDEX(CMDLIN,'./') IF (J.EQ.0) GO TO 50 CMDLIN = CMDLIN(J+2:N) J = INDEX(CMDLIN,'.')-1 DECODE (J,65,CMDLIN(1:J)) BLOCKS(DOC) 65 FORMAT (I) GO TO 50 70 CLOSE (UNIT=AUX) C C Now that we have the target UFD, open up the list file C OPEN (UNIT=LST,FILE='WORINDEX.LST',CARRIAGECONTROL='LIST', $ STATUS='NEW') PAGE = 1 NLINES = 6 WRITE (LST,75) FF,UFD,ADATE,ATIME,PAGE 75 FORMAT (1A1,7X,'Document Index',T30,A, $ T44,A9,2X,A8,5X,'Page',I3,//, $ 74('-'),/, $ ' Type Number Document name',T69,'Blocks',/, $ 74('-')) C C Open up the STORED.WPS file to do two things: C 1) Determine if WORD-11 has an account on that UFD C 2) Pick out the current document number C FILNAM(1:UFDLEN) = UFD FILNAM(UFDLEN+1:UFDLEN+10) = 'STORED.WPS' FILLEN = UFDLEN+10 FILNAM = FILNAM(1:FILLEN) OPEN (UNIT=IDX,FILE=FILNAM,STATUS='OLD',READONLY,ERR=115) CALL GETBUF(IDX,11,WRDBUF) ! Get current document number CURDOC = WRDBUF(34) CLOSE (UNIT=IDX) C C Open up the INDEX.WPS file. This file contains a linked list of C the documents in the account. This list contains the document numbers C and their names. Also a flag byte for Wide documents is there. C We will follow the backward pointers (offset word 0 in each 64 C byte logical record) - LIFO order. The forward pointers (offset word 1) C are not used here. Both linked lists are terminated with a pointer = -1 C FILNAM(1:UFDLEN) = UFD FILNAM(UFDLEN+1:UFDLEN+9) = 'INDEX.WPS' FILLEN = UFDLEN+9 FILNAM = FILNAM(1:FILLEN) OPEN (UNIT=IDX,FILE=FILNAM,STATUS='OLD',READONLY,ERR=115) TOTBLK = 0 TOTFIL = 0 CALL GETBUF(IDX,2,WRDBUF) DOCNUM = WRDBUF(1) IF (DOCNUM.EQ.-1) GO TO 115 C C Set up special goodies if VT100 C CALL SETVID(CRT,VT100,DUM,DUM,DUM,DUM) IF (VT100) THEN WRITE (CRT,80) ESC,ESC,ESC,ESC,ESC 80 FORMAT (1X,1A1,'[2J',1A1,'[H',1A1,'[?4h',1A1,'[5;23r', $ 1A1,'[?6l') ENDIF WRITE (CRT,85) UFD,ADATE,ATIME 85 FORMAT (7X,'Document Index',T36,A, $ T56,A9,2X,A8,//, $ ' Type Number Document name',T69,'Blocks') C C Now lets loop through all the goodies C 90 BLKNUM = DOCNUM/8+2 ! Get next disk block number WRDOFS = MOD(DOCNUM,8)*32+1 ! Get the offset within the BYTOFS = WRDOFS*2-1 ! block CALL GETBUF(IDX,BLKNUM,WRDBUF) ! Get the block IF (BYTBUF(BYTOFS+12).EQ.0) THEN ! Wide document? TYPE = ' ' ! No ELSE TYPE = 'W' ! Yes ENDIF IF (DOCNUM.EQ.CURDOC) THEN ! Is this the current document CURENT = '*' ! Yes ELSE CURENT = ' ' ! No ENDIF DO 95 I=1,51 ! Get document name J = I+12+BYTOFS ! Index to next name character IF (BYTBUF(J).EQ.0) GO TO 100 ! Done name? NAME(I) = BYTBUF(J) 95 CONTINUE I = I+1 100 NAMLEN = I-1 NLINES = NLINES+1 IF (MOD(NLINES,65).EQ.0) THEN PAGE = PAGE+1 NLINES = 6 WRITE (LST,105) FF,UFD,ADATE,ATIME,PAGE 105 FORMAT (1A1,7X,'Document Index',T30,A, $ T44,A9,2X,A8,5X,'Page',I3,//, $ 74('-'),/, $ ' Type Number Document name',T69,'Blocks',/, $ 74('-')) ENDIF WRITE (LST,110) TYPE,DOCNUM,CURENT,(NAME(I),I=1,NAMLEN), $ BLOCKS(DOCNUM) WRITE (CRT,110) TYPE,DOCNUM,CURENT,(NAME(I),I=1,NAMLEN), $ BLOCKS(DOCNUM) 110 FORMAT (3X,1A1,I6,3X,1A1,A1,T70,I4) TOTBLK = TOTBLK+BLOCKS(DOCNUM) TOTFIL = TOTFIL+1 DOCNUM = WRDBUF(WRDOFS) ! Get next document number IF (DOCNUM.NE.-1) GO TO 90 GO TO 125 C C Missing files C 115 WRITE (CRT,120) 120 FORMAT (' ** Word-11 does not have an account on this UFD **') GO TO 135 C C That's all folks C 125 WRITE (CRT,130) TOTFIL,TOTBLK WRITE (LST,130) TOTFIL,TOTBLK 130 FORMAT (/,4X,I6,' Files using ',I5,' disk blocks') 135 CLOSE (UNIT=IDX) CLOSE (UNIT=LST) IF (VT100) THEN WRITE (CRT,140) ESC,ESC,ESC 140 FORMAT (1X,1A1,'[;r',1A1,'[?4l',1A1,'[24;1H') ENDIF END SUBROUTINE GETBUF(LUN,BLOCK,BUFFER) C C Get a 512 byte buffer into (BUFFER) from the specified LUN from C the specific BLOCK number. C IMPLICIT INTEGER (A-Z) BYTE BUFFER(512) DIMENSION ISB(2),DPB(6) C CALL GETADR(DPB,BUFFER) DPB(2) = 512 DPB(4) = 0 DPB(5) = BLOCK CALL WTQIO("10400,LUN,1,,ISB,DPB) RETURN END SUBROUTINE COMUFD(UFD,UFDLEN) C C Routine to remove any leading zeroes from a UFD string C IMPLICIT INTEGER (A-Z) CHARACTER*9 UFD C 5 I = INDEX(UFD,'[0') IF (I.NE.0) THEN UFD(I+1:) = UFD(I+2:UFDLEN) UFDLEN = UFDLEN-1 GO TO 5 ENDIF 10 I = INDEX(UFD,',0') IF (I.NE.0) THEN UFD(I+1:) = UFD(I+2:UFDLEN) UFDLEN = UFDLEN-1 GO TO 10 ENDIF RETURN END