C-------------------------------------------------------------------C C SHOWFILE January 1983 C C Originally written by Denny Thury of Texas Instruments. C C Modified and added to Directory Managment (DM) by John C. Hayre, C C Texas Instruments. C C Send suggestions and/or complaints to: C C C C Texas Instruments C C P.O. Box 225012, MS 3618 C C Dallas, Texas 75265 C C (Attention John Hayre) C C C C Phone: 214-995-3575 C C-------------------------------------------------------------------C C modified for version 4 by RTGregory 4/10/85 C-------------------------------------------------------------------C Subroutine SHOWFILE(SfFile, SRCHPAT1, SRCHSIZ1, GENSRCH1) IMPLICIT INTEGER*4 (A-Z) C CHARACTER*(*) K0,K1,K2,K3,K4,K5,K6,K7,K8,K9,GOLD,HELP CHARACTER*(*) UAK,DAK,RST,ENT,PF3,ESC,PCSTBM,PCSCLR CHARACTER*(*) PCOMS,PCOMR,ERR,SGROFF,REVON,ERR1,ERR2 CHARACTER*(*) BLDON,PF4,MKEY,CKEY C Character*128 SFFile Character*80 SrchPat1 Integer*4 SrchSiz1 Logical*1 GenSrch1 C CHARACTER*2 LN /'TT'/ CHARACTER*12 DEVCHR,MSG C LOGICAL*1 RESP,CMND_ERR C INCLUDE 'SFCOMS.FOR' C DATA CODE /0/ C EXTERNAL IO$_WRITEVBLK,DT$_VT100 EXTERNAL IO$M_PURGE,IO$_READVBLK,IO$M_NOECHO EXTERNAL STEXIT C C DEFINE SYMBOLIC NAMES FOR ALLOWABLE OPTIONS FOR THIS UTILITY - which C allows you to look at the contents of files C C K0..K9 = KEYPAD KEY NOS. '0'..'9' C GOLD = KEYPAD KEY 'PF1' C HELP = KEYPAD KEY 'PF2' C PF3 = KEYPAD KEY 'PF3' C PF4 = KEYPAD KEY 'PF4' C RST = KEYPAD KEY '.' C ENT = KEYPAD KEY 'ENTER' C MKEY = KEYPAD KEY '-' C CKEY = KEYPAD KEY ',' C UAK = UP ARROW KEY C DAK = DOWN ARROW KEY C PARAMETER (ESC=CHAR(27)) PARAMETER (K0=ESC//'Op',K1=ESC//'Oq',K2=ESC//'Or') PARAMETER (K3=ESC//'Os',K4=ESC//'Ot',K5=ESC//'Ou') PARAMETER (K6=ESC//'Ov',K7=ESC//'Ow',K8=ESC//'Ox') PARAMETER (K9=ESC//'Oy') parameter (UAK=ESC//'[A',DAK=ESC//'[B') c RTG PARAMETER (K0='0', K1='1', K2='2', K3='3', K4='4') c PARAMETER (K5='5', K6='6', K7='7', K8='8', K9='9') PARAMETER (GOLD=ESC//'OP',HELP=ESC//'OQ',RST=ESC//'On') PARAMETER (PF3=ESC//'OR',ENT=ESC//'OM',PF4=ESC//'OS') PARAMETER (MKEY=ESC//'Om',CKEY=ESC//'Ol') PARAMETER (PCOMS=ESC//'[?6h',PCOMR=ESC//'[?6l') PARAMETER (PCSCLR=ESC//'[r',PCSTBM=ESC//'[1;23r') PARAMETER (REVON=ESC//'[7m',SGROFF=ESC//'[0m') PARAMETER (BLDON=ESC//'[1m',BLNKON=ESC//'[5m',UNDON=ESC//'[4m') PARAMETER (ERR1=REVON//'Invalid command - Hit PF2') PARAMETER (ERR2=ERR1//' on keypad for list of valid commands') PARAMETER (ERR=ERR2//SGROFF) C C Put the passed parameters into common C GenSrch = GenSrch1 SrchSiz = SrchSiz1 SrchPat = SrchPat1 C C REDEFINE TERMINATOR CHARACTER MASK, SO AS NOT TO TERMINATE ON ESCAPE C CHARACTER. TERMINATATION CHARACTERS ARE NOW ALL CHARACTERS WHOSE C ASCII CODE IS IN THE RANGE 0..31 (0..1F HEX), EXCEPT "BS","TAB","LF", C "VT","FF", AND "ESC". C Type *,Char(27)//'(B'//Char(27)//')B'//Char(15) TERMCH(1) = 0 TERMCH(2) = 'F7FFE0FF'X C C DEFINE EXIT HANDLER TO ENSURE STANDARD EXIT PROCEDURE, ESPECIALLY C DURING ERRORS. C PROCEDURE STEXIT IS THE STANDARD EXIT HANDLER. C STAT = LIB$ESTABLISH (STEXIT) STAT = SYS$ASSIGN (LN,CH1,,) ! Open channel to local terminal Call OpenFile(SFFile) ! Open file to be displayed C C SET TERMINAL CHARACTERISTICS (VT100 AND NOWRAP) AND C SAVE THE CURRENT CHARACTERISTICS FOR LATER RESTORATION C IF "SETTERM" RETURNS, THEN TERMINAL IS OK. C CALL SETTERM(%VAL(CH1)) TOPLINE = PCOMR//PCSCLR//PCSTBM C RTG CALL WRITELN (ESC//'='//TOPLINE) ! Defind keypad mode PAGESIZE = 23 ! Set page size C C Build Fname = 'File : XXXXXX.XXX' to be put on bottom of CRT C Fillen = Index(SFFile, ' ') - 1 DO 1, I=1,LEN(FNAME) FNAME(I:I) = ' ' 1 CONTINUE CENTER = (LEN(FNAME)-(FILLEN))/2 FILLEN = FILLEN + 7 + LEN(BLDON) + LEN(SGROFF) POS = CENTER+FILLEN FNAME(CENTER:POS)='File : '//BLDON//SFFILE(1:FILLEN)//SGROFF FNAME(1: 9) = 'PF2=Help ' FILLEN = POS EOF = .FALSE. ! Initialize common variables HIGHREC = 0 CURREC = 1 DIREC = 1 ! Initial direction forward (backward = -1) This_Cmd = 'O' ! This_Cmd = 'O'ther (not 'F'ind or 'N'ext) CALL LIB$ERASE_PAGE (1,1) ! Read and display 1st page CALL NPAGE(CURREC) CALL MESSAGE (FNAME(1:FILLEN),1) C C MODIFY FUNCTION CODES TO NOT ECHO THE COMMAND CHARACTERS AND PURGE THE C TYPE AHEAD BUFFER. C F1 = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_NOECHO) C C PROCESS REST OF FILE AT USER'S REQUEST C FOLLOWS IS A DO FOREVER LOOP WHICH ACCEPTS USER'S COMMANDS C (FROM THE KEYPAD) AND PERFORMS THE APPROPRIATE ACTIONS C DO WHILE (.TRUE.) 10 Continue Hl_String = .False. ! Highlight string flag Last_Cmd = This_Cmd ! This_Cmd = 'O' ! Assume not FIND or FINDNX CMND = ' ' ! Clear command buffer C C QUE AN IO REQUEST FOR THE COMMAND C J = 1 11 CONTINUE STAT = SYS$QIOW(%VAL(3),%VAL(CH1),%VAL(F1),%REF(IOSB), 1,,%REF(CMND(J:J)),%VAL(1),,%REF(TERMCH),,) IF (.NOT. STAT) CALL LIB$STOP(%VAL(STAT)) IF (.NOT. IOSB(1)) CALL LIB$STOP (%VAL(IOSB(1))) IF (CMND(1:1) .EQ. ESC) THEN J = J + 1 IF (J .EQ. 4) GOTO 12 END IF GOTO 11 C 12 IF (CMNDERR .OR. DERR) THEN CALL LIB$ERASE_LINE (24,1) CALL MESSAGE (FNAME(1:FILLEN),1) CALL MESSAGE (WINDOW_MSG,65) CMNDERR = .FALSE. DERR = .FALSE. END IF C F1 = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_NOECHO) C-----------------------------------------------------------------C 15 IF (CMND .EQ. GOLD) THEN ! Gold key?? CALL GOLDKEY (RESP) IF (.NOT. RESP) GOTO 10 F1 = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_NOECHO) C 1 .OR. %LOC(IO$M_PURGE) Goto 9989 End If C-----------------------------------------------------------------C IF (CMND .EQ. HELP) THEN ! Help Key? CALL SHELP CALL LIB$ERASE_LINE (24,1) CALL MESSAGE (FNAME(1:FILLEN),1) CALL MESSAGE (WINDOW_MSG,65) Goto 9989 End If C-----------------------------------------------------------------C IF (CMND .EQ. PF3) THEN ! Next occurence of string?? IF (SRCHSIZ .LE. 0) THEN CALL MESSAGE(ESC//'[7mString undefined'//ESC//'[0m',1) DERR = .TRUE. ELSE C = (80-SRCHSIZ)/2 CALL LIB$ERASE_LINE (24,1) CALL MESSAGE ('Searching for: '//ESC//'[1m'//ESC//'[5m' - //SRCHPAT(1:SRCHSIZ)//ESC//'[0m',2) C------------------------------------------------------------------- C WHEN SEARCHING FOR A STRING, where to start the search C is dependent on several things: C-------------------------------------------------------------------- If (Direc .GT. 0) then ! If going forward direction If ((Last_Cmd .EQ. 'F') .OR. (Last_Cmd .EQ. 'N')) then FREC = Currec + 18 ! Start at next screen Else ! last command wasn't a find type command FRec = Currec ! Start here End If Else ! Reverse direction If (Currec .GT. 1) then FRec = Currec - 1 Else GOTO 760 End If End If CALL FINDSTRING (SRCHPAT(1:SRCHSIZ),FREC,PATFOUND) CALL LIB$ERASE_LINE (24,1) IF (PATFOUND) THEN Hl_String = .TRUE. ! Highlight the found string This_Cmd = 'N' ! Search for next occurance If (FRec .GT. 1) FRec = Frec - 1 IF ((EOF) .AND. ((HIGHREC-FREC) .LT. PAGESIZE)) THEN CURREC=FREC CALL NPAGE(CURREC) ELSE CALL NPAGE(FREC) END IF CALL MESSAGE (FNAME(1:FILLEN),1) ELSE 760 CALL LIB$ERASE_LINE (24,1) CALL MESSAGE(ESC//'[7mString not found'//ESC//'[0m',1) DERR = .TRUE. END IF END IF Goto 9989 End If C-----------------------------------------------------------------C IF (CMND .EQ. K8) THEN ! Move a page NREC = CURREC+(DIREC*PAGESIZE) IF (NREC .LE. 0) NREC=1 CALL NPAGE (NREC) Goto 9989 End If C-----------------------------------------------------------------C IF (CMND(1:1) .EQ. Char(1)) then ! One Page forward Savedirec = Direc Direc = 1 NREC = CURREC+(DIREC*PAGESIZE) IF (NREC .LE. 0) NREC=1 CALL NPAGE (NREC) Direc = Savedirec GOTO 9989 End If C-----------------------------------------------------------------C IF (CMND(1:1) .EQ. Char(2)) then ! One Page backward Savedirec = Direc Direc = -1 NREC = CURREC+(DIREC*PAGESIZE) IF (NREC .LE. 0) NREC=1 CALL NPAGE (NREC) Direc = Savedirec Goto 9989 End If C-----------------------------------------------------------------C IF (CMND .EQ. K0) THEN ! Move a line CALL NPAGE (CURREC+DIREC) Goto 9989 End If C-----------------------------------------------------------------C IF (CMND .EQ. K4) THEN ! Set direction forward DIREC = 1 Goto 9989 End If C-----------------------------------------------------------------C IF (CMND .EQ. K5) THEN ! Set direction backward DIREC = -1 Goto 9989 End If C-----------------------------------------------------------------C IF (CMND .EQ. PF4) THEN ! generic (caseless) search GENSRCH = .TRUE. Goto 9989 End If C-----------------------------------------------------------------C IF (CMND .EQ. DAK) THEN ! Down arrow CALL NPAGE (CURREC+1) Goto 9989 End If C-----------------------------------------------------------------C IF (CMND .EQ. UAK) THEN ! Up arrow CALL NPAGE (CURREC-1) Goto 9989 End If C-----------------------------------------------------------------C IF (CMND .EQ. MKEY) THEN ! set screen to 80 columns CALL WRITELN (ESC//'[?3l') CALL NPAGE (CURREC) CALL MESSAGE (FNAME(1:FILLEN),1) Goto 9989 End If C-----------------------------------------------------------------C IF ((CMND .EQ. K3) .OR. (CMND(1:1) .EQ. Char(26))) THEN GOTO 800 ! Exit End If C-----------------------------------------------------------------C CALL MESSAGE (ERR,1) ! Invalid command= NOP- Purge buffer CMNDERR = .TRUE. F1 = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_NOECHO) C 1 .OR. %LOC(IO$M_PURGE) C 9989 Continue END DO C------------------------------------------------------------------- 800 CALL LIB$ERASE_LINE (24,1) TYPE *,Char(27)//'G'//CHAR(27)//'='//CHAR(27)//'[r' Type *,Char(27)//'(B'//Char(27)//')B'//Char(15) CALL LIB$SET_CURSOR (23,1) C CALL RSTTERM CALL CLOSEFIL STAT = SYS$dassgn (%val(CH1)) ! Close channel to local terminal Return End !SHOWFILE