SUBROUTINE VPW_HELP(CString,Iflag) C C This subroutine will parse the HELP command and convert C it into a form suitable for using VAX HELP. The program will C look up HELP information in SYS$VPWFILES:VPW.HLB C and display it. If Iflag >0, no key level identifiers will C be displayed and messages relating to additional HELP C information also will not be displayed. C IMPLICIT INTEGER*4 (A - Z) LOGICAL*1 String(1) INTEGER*2 INDEX,I,J INTEGER*4 Print_Help EXTERNAL Print_Help INTEGER*4 Length INTEGER*4 KEY_LEN(9), 1 LBR$C_READ /1/ CHARACTER*(*) Cstring CHARACTER*32 KEY(9) C ... Initialize all key lengths to zero and key fields to blank C CALL STRING_LENGTH(Cstring,Length) ! get string length DO I=1,9 ! KEY_LEN(I)=0 ! Zero length KEY(I)= ' ' ! Fill with blanks END DO ! C Initialize the librarian STATUS = LBR$INI_CONTROL (LIB_INDEX, LBR$C_READ)! IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) ! Abort on err C Open HELP library STATUS = LBR$OPEN (LIB_INDEX, ! Open library - 'SYS$VPWFILES:VPW.HLB') ! for HELP IF(.NOT. STATUS) THEN ! If fail print msg TYPE *,'VPW -- Error opening SYS$VPWFILES:VPW.HLB'! TYPE *,' Report this problem AT ONCE!!' RETURN ! and return END IF ! C C ... Parse HELP input line to find all possible keys C IF(Length.EQ.0) GOTO 1000! No keywords, Jpos=1 ! Start with first char DO J=1,80 IF(Cstring(J:J) .EQ. ' ')Jpos = Jpos+1! Find 1st non space and use IF(Cstring(J:J) .NE. ' ') GOTO 50 ! it as start of search END do GOTO 1000 ! No keywords 50 DO 100, Ikey=1,9 ! Parse up to 8 keys Jspace = INDEX(Cstring(Jpos:Length),' ')! Find first space or end IF(Jspace.EQ.0) THEN ! If space not found (EOL) Imax=Length-Jpos+1 ! Max string length KEY(Ikey)(1:Imax)=Cstring(Jpos:Length)! KEY_LEN(Ikey)=Imax c write(*,200)Ikey,key_LEN(Ikey),KEY(Ikey)!****** c200 format(' ',i2,2x,i2,2x,a) !****** GOTO 1000 ! Go process HELP END IF ! Jspace=Jspace+Jpos ! Position at space Imax=Jspace ! Gets all the keyword KEY(Ikey)(1:Imax)=Cstring(Jpos:Jspace-1)! Fill help keys Jpos=Jspace ! KEY_LEN(Ikey)=Imax ! C write(*,200)Ikey,key_LEN(Ikey),KEY(Ikey) IF(Jpos.EQ.Length) GOTO 1000! All done 100 CONTINUE ! 1000 CONTINUE IF(Iflag.GT.0) THEN ! If inhibit flag set STATUS = LBR$GET_HELP (LIB_INDEX,,PRINT_HELP,, - KEY(1) (1:KEY_LEN(1)), - KEY(2) (1:KEY_LEN(2)), - KEY(3) (1:KEY_LEN(3)), - KEY(4) (1:KEY_LEN(4)), - KEY(5) (1:KEY_LEN(5)), - KEY(6) (1:KEY_LEN(6)), - KEY(7) (1:KEY_LEN(7)), - KEY(8) (1:KEY_LEN(8)), - KEY(9) (1:KEY_LEN(9))) ELSE ! STATUS = LBR$GET_HELP (LIB_INDEX,,,, - KEY(1) (1:KEY_LEN(1)), - KEY(2) (1:KEY_LEN(2)), - KEY(3) (1:KEY_LEN(3)), - KEY(4) (1:KEY_LEN(4)), - KEY(5) (1:KEY_LEN(5)), - KEY(6) (1:KEY_LEN(6)), - KEY(7) (1:KEY_LEN(7)), - KEY(8) (1:KEY_LEN(8)), - KEY(9) (1:KEY_LEN(9))) END IF IF (.NOT. STATUS) THEN ! TYPE *,'VPW -- Call to LBR$GET_HELP failed' TYPE *,' Report this problem AT ONCE!!' CALL LIB$STOP (%VAL(STATUS)) END IF C Close the library STATUS = LBR$CLOSE (LIB_INDEX) ! IF (.NOT. STATUS) THEN ! TYPE *,'VPW -- Can not close SYS$VPWFILES:VPW.HLB' TYPE *,' Report this problem AT ONCE!!' CALL LIB$STOP (%VAL(STATUS)) ! Die if fails END IF RETURN ! Back home to mama END C C+ C Print_Help is included to format the help display printed out. C Since we do not want the text indented, or headed with help C keys, or have information relating to additional help C information printed out at the end, the flag word is examined C each time prior to printing. If it is not zero, an immediate C return to the caller is made. In each case, success is always C returned to the caller (that's why this is a function C subprogram). C- INTEGER FUNCTION PRINT_HELP(Cstring,Iflag,Idata,Ikeylvl) CHARACTER*(*) Cstring ! These parameters are INTEGER*4 Iflag ! required by LIB$GET_HELP INTEGER*4 Idata ! INTEGER*4 Ikeylevl ! IF(Iflag.NE.0) GOTO 9999! Only Print Text WRITE(*,10)Cstring ! to SYS$OUTPUT 10 Format(' 'A) ! 9999 PRINT_HELP=1 ! Show success RETURN ! END