c----------------------------------------------------------------------- c c Help subroutine c c part of VAX DTC program c c Inputs: c Iterminal Integer*2 Terminal type C Command Character*80 Help command line c c Output: c display screen (see below) C C Rewritten: James Downward Use VAX HELP, support C hard copy terminals, etc. C 6/12/84 C c c----------------------------------------------------------------------- c OPTIONS/NOI4 SUBROUTINE dhelp(Iterminal,Command) CHARACTER*1 Cesc,Cnull CHARACTER*3 Cupr,Clwr CHARACTER*4 Cbold,Cnorm CHARACTER*7 Clin1,Clin2 CHARACTER*80 Cbuf,Command byte buf(80) INTEGER*4 Iterminal DATA Cesc /27/ ! Escape DATA Cnull /0/ ! Null char to disable formatting c c Initialize: c IF (Iterminal.LT.96) THEN ! If not VT100 Cbold=Cnull//Cnull//Cnull//Cnull ! Set video attributes Cnorm=Cbold ! if any Clin1=Cbold//Cnull//Cnull//Cnull ! Clin2=Clin1 ! Cupr=Cbold(1:3) ! Clwr=Cupr ! ELSE ! Cbold=Cesc//'[1m' ! Cnorm=Cesc//'[0m' ! Clin1=Cesc//'[1;10H' Clin2=Cesc//'[2;10H' Cupr=Cesc//'#3' Clwr=Cesc//'#4' END IF ! IF(Iterminal .GE. 96) THEN ! If ansi terminal Cbuf=Cnull//Cesc//'[2J'//Cesc//'[1;0H' write(*,10) Cbuf(1:11) 10 FORMAT(A,$) WRITE(*,12) Cnull//Clin1//Cupr,Cbold,Cnorm,Cbold,Cnorm, - Cbold,Cnorm 12 FORMAT(A,A,'D',A,'esk ',A,'T',A,'op ',A,'C',A,'alendar') WRITE(*,12) Cnull//Clin2//Clwr,Cbold,Cnorm,Cbold,Cnorm, - Cbold,Cnorm Cbuf=Cnull//Cesc//'[4;22r'//Cesc//'[?4h'//Cesc//'[4;0H' WRITE(*,10)Cbuf(1:19) ELSE Cbuf=' DTC - Desk Top Calendar' WRITE(*,15)Cbuf(1:51) 15 FORMAT(' ',A) ! END IF ! call HELP(Command) WRITE(*,110) Cbold,Cnorm 110 FORMAT(/,' Press ',A,'RETURN',A,' when ready') IF(Iterminal.GE.96) THEN ! If ANSI Cbuf=Cnull//Cesc//'[0;0H'//Cesc//'[1;24r'// - Cesc//'[?4l'//Cesc//'[23;1H' WRITE(*,10) Cbuf(1:26) END IF return end SUBROUTINE HELP(Cstring) 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. IMPLICIT INTEGER*4 (A - Z) CHARACTER*32 KEY(9) CHARACTER*64 Chelp_File CHARACTER*80 Cstring INTEGER*2 INDEX,I,J INTEGER*4 KEY_LEN(9), - LBR$C_READ /1/ INTEGER*4 Ilen,Length C ... Initialize all key lengths to zero and key fields to blank C Chelp_File='SYS$VPWFILES:VPW.HLB' c Chelp_File='VPW.HLB' Status=String_Length(Chelp_File,Ilen) ! Status=String_Length(Cstring,Length) ! DO I=2,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,Chelp_File) ! Open library IF(.NOT. STATUS) THEN ! If fail print msg WRITE(*,40) Chelp_File(1:Ilen) 40 FORMAT(' VPW -- Error opening ',A,/, - ' 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=2,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 KEY(1)='DTC' KEY_LEN(1)=4 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))) IF (.NOT. STATUS) THEN ! TYPE *,'VPW -- Call to LIBR$GET_HELP failed' TYPE *,' Report this problem AT ONCE!!' CALL LIB$SIGNAL (%VAL(STATUS)) END IF C Close the library STATUS = LBR$CLOSE (LIB_INDEX) ! IF (.NOT. STATUS) THEN ! WRITE(*,1010) Chelp_File(1:Ilen) 1010 FORMAT(' VPW -- Can not close ',A,/, - ' Report this problem AT ONCE!!' ) CALL LIB$STOP (%VAL(STATUS)) ! Die if fails END IF RETURN ! Back home to mama END