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 logical (A-Z)
C
	CHARACTER*(*) K0,K1,K2,K3,K4,K5,K6,K7,K8,K9,GOLD,HELP
        CHARACTER*(*) RST,ENT,PF3,ESC,PCSTBM,PCSCLR
  	CHARACTER*(*) PCOMS,PCOMR,ERR,SGROFF,REVON,ERR1,ERR2
  	CHARACTER*(*) UAK,DAK,BLDON,PF4,MKEY,CKEY
  	CHARACTER*4   find_key, prev_screen, next_screen
C
        Character*128 SFFile
        Character*80 SrchPat1
        Integer*4 SrchSiz1, i
        Logical*1 GenSrch1
C
	CHARACTER*2 LN /'TT'/
	CHARACTER*12 DEVCHR,MSG
C
  	LOGICAL*1 RESP,CMND_ERR
C
  	INCLUDE 'sfcommon.include'
C
        DATA CODE /0/
C
  	EXTERNAL IO$_WRITEVBLK 
	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 (Prev_Screen=ESC//'[5~')
	PARAMETER (Next_Screen=ESC//'[6~')
	PARAMETER (Find_key=ESC//'[1~')

    	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) .and. (cmnd(2:3) .eq. '[A')) GOTO 12
          IF ((J .EQ. 4) .and. (cmnd(2:3) .eq. '[B')) GOTO 12
          IF ((J .EQ. 4) .and. (cmnd(2:2) .ne. '[')) GOTO 12
          IF ((J .EQ. 5) .and. (cmnd(2:2) .eq. '[')) GOTO 12
        END IF
	IF (lib$matchc( CMND(1:1), 'xXqQ3') .gt. 0) THEN
	  GOTO 800 ! Exit
	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(1:4) .EQ. Find_key) THEN ! Search for a string
	  CALL LIB$ERASE_LINE (24,1)
          F1 = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_NOECHO)
 	  CALL PROMPTIN (' Search for :  ',SRCHPAT,JJ)
	  F1 = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_NOECHO)
          If (JJ .EQ. 0) GOTO 9989
	  F1 = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_NOECHO)
	  SRCHSIZ = IPMAX(SRCHPAT)
	  CALL LIB$ERASE_LINE (24,1)
          CALL MESSAGE ('Searching for: '//SRCHPAT(1:SRCHSIZ),2)
          If (Direc .GT. 0) then
            FREC = Currec
          Else
            If (Currec .GT. 1) then 
              FREC = Currec - 1
            Else
              FRec = 1
              Currec = 1 ! (Just in case)
            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 = 'F'     ! Find string flag
            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
            CALL MESSAGE (ESC//'[7mString not found'//ESC//'[0m',1)
            DERR = .TRUE.
          END IF
         GOTO 9989
        END IF
C--------------------------------------------------------------------
	  IF (CMND(1:3) .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(1:4) .EQ. Next_Screen) THEN ! Move a page
	    temp = direc
	    direc = 1
	    NREC = CURREC+(DIREC*PAGESIZE)
	    IF (NREC .LE. 0) NREC=1
    	    CALL NPAGE (NREC)
	    direc = temp 
            Goto 9989
          End If
	  IF (CMND(1:4) .EQ. Prev_Screen) THEN ! Move a page
	    temp = direc
	    direc = -1
	    NREC = CURREC+(DIREC*PAGESIZE)
	    IF (NREC .LE. 0) NREC=1
    	    CALL NPAGE (NREC)
	    direc = temp 
            Goto 9989
          End If
	  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  (1:3).EQ. K0) THEN ! Move a line
	    CALL NPAGE (CURREC+DIREC)
            Goto 9989
          End If
C-----------------------------------------------------------------C
	  IF (CMND  (1:3).EQ. K4) THEN ! Set direction forward
	    DIREC = 1
            Goto 9989
          End If
C-----------------------------------------------------------------C
	  IF (CMND  (1:3).EQ. K5) THEN ! Set direction backward
    	    DIREC = -1
            Goto 9989
          End If
C-----------------------------------------------------------------C
	  IF (CMND  (1:3).EQ. PF4) THEN ! generic (caseless) search
	    GENSRCH = .TRUE.
            Goto 9989
          End If
C-----------------------------------------------------------------C
	  IF (CMND (1:3).EQ. DAK) THEN ! Down arrow
	    CALL NPAGE (CURREC+1)
            Goto 9989
          End If
C-----------------------------------------------------------------C
	  IF (CMND(1:3) .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(1:3) .EQ. K3) 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        
	  cmnd = '    '
        END DO
C-------------------------------------------------------------------
800  	CALL LIB$ERASE_LINE (24,1)
	CALL WRITELN (ESC//'[?3l')
        TYPE *, esc//'G'//CHAR(27)//'='//CHAR(27)//'[r'
        Type *, esc//'(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
