C===================================================================
C===================================================================
C===================================================================
C===================================================================
C---------------------------------------------------------------------
C
	SUBROUTINE GOLDKEY (RESP)
C
C  PROCEDURE TO ACCEPT COMMANDS FROM THE USER AFTER THE "GOLD" KEY HAS
C  BEEN PRESSED.
C
	IMPLICIT INTEGER*4 (A-Z)
	CHARACTER*(*) K0,K1,K2,K3,K4,K5,K6,K7,K8,K9,GOLD,HELP
        CHARACTER*(*) UAK,DAK,RST,ENT,PF3,ESC,PF4,MKEY,CKEY
C
        CHARACTER*6 BUFF
        Character*1 Tempy
C
	LOGICAL*1 RESP
C
  	INCLUDE 'sfcommon.include'
C
	EXTERNAL IO$M_PURGE,IO$_READVBLK,IO$M_NOECHO,IO$M_TIMED
	EXTERNAL SS$_NORMAL,SS$_TIMEOUT
C
C  DEFINE SYMBOLIC NAMES FOR ALLOWABLE OPTIONS FOR THIS UTILITY
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	MKEY = KEYPAD KEY '-'
C	CKEY = KEYPAD KEY ','
C	RST = KEYPAD KEY '.'
C       ENT = KEYPAD KEY 'ENTER'
C       UAK = UP ARROW KEY
C       DAK = DOWN ARROW KEY
C
	PARAMETER (ESC=CHAR(27))
c    	parameter (UAK=ESC//'[A',DAK=ESC//'[B')
c    	parameter (k0='0', k1='1', k2='2', k3='3', k4='4')
c    	parameter (k5='5', k6='6', k7='7', k8='8', k9='9')
    	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',UAK=ESC//'[A',DAK=ESC//'[B')
	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')
C
C INITIALIZE PARAMETER (RESP)
C
	RESP = .TRUE.
C
C CLEAR COMMNAD BUFFER (CMND) 
C
10	CMND = '   '
C
C QUE AN IO REQUEST FOR THE COMMAND
C
        J = 1
11      CONTINUE
        F1 = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_NOECHO)
  	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 15    
        END IF
        GOTO 11
C--------------------------------------------------------------------
15	IF (CMND .EQ. GOLD) goto 10 ! Gold Key?
C--------------------------------------------------------------------
	IF (CMND .EQ. HELP) then 
          CALL SHELP ! Help key?
          GOTO 9989
        End If
C--------------------------------------------------------------------
	IF (CMND .EQ. K4) then 
          CALL NPAGE (-1) ! Bottom of file?
          GOTO 9989
        End If
C--------------------------------------------------------------------
	IF (CMND .EQ. K5) then 
          CALL NPAGE(1) ! Top Of file
          GOTO 9989
        End If
C--------------------------------------------------------------------
C MOVE 'N' LINES ??  THE USER MAY HIT EITHER THE ADVANCE KEY OR
C                     THE BACKUP KEY.  IN EITHER CASE, THE DIRECTION
C                     SHOULD BE SET ACCORDINGLY.  IF ANY OTHER
C      		      TERMINATOR IS HIT, NO ACTION IS TAKEN.
C--------------------------------------------------------------------
  	IF (CMND .EQ. K0) THEN
	  CALL LIB$ERASE_LINE (24,1)
  	  CALL PROMPTIN(ESC//'[1mNo. of lines : '//ESC//'[0m',BUFF,JJ)
          If (JJ .EQ. 0) Goto 9989
  	  DECODE (6,999,BUFF) TREC
  	  NREC = DIREC*TREC + CURREC
	  IF (NREC .LE. 0) THEN NREC = 1
	  CALL LIB$ERASE_LINE (24,1)
  	  CALL NPAGE (NREC)
C
          F1 = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_NOECHO)
C     1          .OR. %LOC(IO$M_PURGE)
          GOTO 9989
        End If
C--------------------------------------------------------------------
	IF (CMND .EQ. PF3) THEN ! Search for a string
	  CALL LIB$ERASE_LINE (24,1)
 	  CALL PROMPTIN (ESC//'[1mSearch for : '//ESC//'[0m',SRCHPAT,JJ)
          If (JJ .EQ. 0) GOTO 9989
	  SRCHSIZ = IPMAX(SRCHPAT)
	  CALL LIB$ERASE_LINE (24,1)
          CALL MESSAGE ('Searching for: '//ESC//'[1m'//ESC//'[5m'
     -//SRCHPAT(1:SRCHSIZ)//ESC//'[0m',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 .EQ. K8) THEN ! Go to line 'N'
	  CALL LIB$ERASE_LINE (24,1)
 	  CALL PROMPTIN (ESC//'[1mLine no. : '//ESC//'[0m',BUFF,JJ)
          If (JJ .EQ. 0) Goto 9989
  	  DECODE (6,999,BUFF) TREC
	  IF (TREC .LE. 0) TREC = 1
	  CALL LIB$ERASE_LINE (24,1)
	  CALL NPAGE (TREC)
C
          F1 = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_NOECHO)
C     1          .OR. %LOC(IO$M_PURGE)
          GOTO 9989
        End If
C--------------------------------------------------------------------
	IF (CMND .EQ. PF4) then 
          GENSRCH = .FALSE.  ! Search exact
          GOTO 9989
        End If
C--------------------------------------------------------------------
	IF (CMND .EQ. MKEY) THEN ! Screen to 132 columns
	  CALL WRITELN (ESC//'[?3h')
	  CALL NPAGE (CURREC)
          GOTO 9989
        End If
C--------------------------------------------------------------------
	RESP = .FALSE. ! Screwed up
        F1 = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_NOECHO)
C     1          .OR. %LOC(IO$M_PURGE)
C--------------------------------------------------------------------
9989    Continue
	IF ((CMND .EQ. K4) .OR. (CMND .EQ. K8) .OR.
     1          (CMND .EQ. HELP) .OR. (CMND .EQ. K0) .OR.
     1          ( (CMND .EQ. PF3) .AND. (.NOT. DERR)) .OR. 
     1          (CMND .EQ. MKEY)                           ) THEN 
	  CALL MESSAGE (FNAME(1:FILLEN),1)
	END IF
C
        RETURN 
999	FORMAT (BN,I6)
	END 
C
C-----------------------------------------------------------------------
C
	SUBROUTINE SHELP
C
  	IMPLICIT INTEGER*4 (A-Z)
        INTEGER*2 Sizey
        CHARACTER*132 BUFF
        CHARACTER*1 C
        CHARACTER*1 ESC
	CHARACTER*4 BLDON,SGROFF
C
  	EXTERNAL IO$_READVBLK,IO$M_NOECHO,IO$M_PURGE
C
  	INCLUDE 'sfcommon.include'
C
	PARAMETER (ESC=CHAR(27),BLDON=ESC//'[1m',SGROFF=ESC//'[0m')
C
  	STAT = LIB$ERASE_PAGE (1,1)
C------------------------------------------------------------------
        C = Char(27)
        Buff = C//'(0lqqqqqqqwqqqqqqqwqqqqqqqwqqqqqqqk'//C//'(B   '//C//
     -'(B'//C//'[7mGOLD'//C//'[0m - Use lower function of keys'
        Call Writel(Buff, 1, 1)
        BUFF = C//'(0x'//C//'[7m       '//C//'[0mx       xFND NXTx      
     - x   '//C//'(BHELP - Display this screen'
        Call Writel(Buff, 2, 1)
        Buff = C//'(0x'//C//'[7m GOLD  '//C//'[0mx HELP  x       x      
     - x   '//C//'(BFND NXT - Find next occurence of string'
        Call Writel(Buff, 3, 1)
        Buff = C//'(0x'//C//'[7m       '//C//'[0mx       x'//C//'[7m  FI
     -ND '//C//'[0mx       '//C//'[0mx   '//C//'(B'//C//'[7m  
     -FIND '//C//'[0m - Search for String'
        Call Writel(Buff, 4, 1)
        Buff = C//'(0tqqqqqqqnqqqqqqqnqqqqqqqnqqqqqqqu   '//C//'(B'
        Call Writel(Buff, 5, 1)
        Buff = C//'(0x       x  PAGE x       x  80   x   '//C//'(BPAGE -
     - Go to next page (in current direc)'
        Call Writel(Buff, 6, 1)
        Buff = C//'(0x       x       x       x       x   '//C//'(B'//C//
     -'[7mLINE N'//C//'[0m - Display beginning at line ''N'''
        Call Writel(Buff, 7, 1)
        Buff = C//'(0x       x '//C//'[7mLINE N'//C//'[0mx       x '//C/
     -/'[7m 132 '//C//'[0m x   '//C//'(B80 / '//C//'[7m 132 '//C//'[0m -
     -Set screen width'
        Call Writel(Buff, 8, 1)
        Buff = C//'(0tqqqqqqqnqqqqqqqnqqqqqqqnqqqqqqqu    '//C//'(B'
        Call Writel(Buff, 9, 1)
        Buff = C//'(0xADVANCEx BACKUPx       x       x   '//C//'(BADVANC
     -E - Set direc to advance thru file'
        Call Writel(Buff, 10, 1)
        Buff = C//'(0x       x       x       x       x   '//C//'(B'//C//
     -'[7mBOTTOM'//C//'[0m - Go to bottom of file'
        Call Writel(Buff, 11, 1)
        Buff = C//'(0x'//C//'[7m BOTTOM'//C//'[0mx'//C//'[7m  TOP  '//C/
     -/'[0mx       x       x   '//C//'(BBACKUP - Set direc to backup thr
     -u file'
        Call Writel(Buff, 12, 1)
        Buff = C//'(0tqqqqqqqnqqqqqqqnqqqqqqqnqqqqqqqu   '//C//'(B'//C//
     -'[7mTOP'//C//'[0m - Go to top of file'
        Call Writel(Buff, 13, 1)
        Buff = C//'(0x       x       x       x       x   '//C//'(B'
        Call Writel(Buff, 14, 1)
        Buff = C//'(0x       x       x EXIT  x       x   '//C//'(BEXIT -
     - Return to DCL'
        Call Writel(Buff, 15, 1)
        Buff = C//'(0x       x       x       x       x   '//C//'(B'
        Call Writel(Buff, 16, 1)
        Buff = C//'(0tqqqqqqqvqqqqqqqnqqqqqqqu ENTER x   '//C//'(BENTER 
     -- Terminate input to prompts'
        Call Writel(Buff, 17, 1)
        Buff = C//'(0x    1 LINE     x       x       x   '//C//'(B'
        Call Writel(Buff, 18, 1)
        Buff = C//'(0x               x       x       x   '//C//'(B1 LINE
     - - Move 1 lines in the current direc'
        Call Writel(Buff, 19, 1)
        Buff = C//'(0x'//C//'[7m    N LINES    '//C//'[0mx       x      
     - x   '//C//'(B'//C//'[7mN LINE'//C//'[0m - Move N lines in the cur
     -rent direc'
        Call Writel(Buff, 20, 1)
        Buff = C//'(0mqqqqqqqqqqqqqqqvqqqqqqqvqqqqqqqj'//C//'(B'
        Call Writel(Buff, 21, 1)
C---------------------------------------------------------------------
	BUFF(1:36) = 'Hit '//BLDON//'RETURN'//SGROFF//
     1          ' to resume display'
        STAT = LIB$PUT_SCREEN (BUFF(1:36), 24, 1)
C
        F1 = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_NOECHO)
C     1          .OR. %LOC(IO$M_PURGE)
C
	STAT = SYS$QIOW(%VAL(3),%VAL(CH1),%VAL(F1),%REF(IOSB),
     1,,%REF(C),%VAL(1),,%REF(TERMCH),,)
C
  	CALL DISP_PAGE(CURREC,LAST)
C
	RETURN
	END
C
C------------------------------------------------------------------------
C
	INTEGER FUNCTION STEXIT (SIGARGS,MECHARGS)
C
	IMPLICIT INTEGER*4 (A-Z)
C
	DIMENSION SIGARGS(4),MECHARGS(5)
C
	INCLUDE 'SYS$LIBRARY:SIGDEF'
	INCLUDE 'sfcommon.include'
C
	TYPE *,'EXECUTE EXIT ROUTINE'
  	CALL LIB$ERASE_LINE (24,1)
        TYPE *,CHAR(27)//'='//CHAR(27)//'[r'
  	CALL LIB$SET_CURSOR (23,1)
C
	CALL RSTTERM
	STEXIT = SS$_RESIGNAL
  	CALL SYS$EXIT(%VAL(SIGARGS(2)))
  	END
C
C------------------------------------------------------------------------
C
  	SUBROUTINE NPAGE (RECNUM)
C
  	IMPLICIT INTEGER*4 (A-Z)
C
	LOGICAL*1 DONE
C
  	CHARACTER*15 MSG
	CHARACTER*35 PASTBUFF
  	CHARACTER*(*) ESC,RI,NEL,REVON,BLNKON,SGROFF,PCSTBM
C
	INCLUDE 'sfcommon.include'
C
  	PARAMETER (ESC=CHAR(27),REVON=ESC//'[7m',BLNKON=ESC//'[5m')
  	PARAMETER (SGROFF=ESC//'[0m',NEL=ESC//'E')
  	PARAMETER (RI=ESC//'M',PCSTBM=ESC//'[1;23r')
C
  	SREC = RECNUM ! Set local var -- where to start display
  	ELEN = 0
        Done = False
  	IF (SREC .EQ. -1) THEN ! Find end of file?
C
C FIND END OF SOURCE FILE, COPYING ALL RECORDS INTO THE RELATIVE RECORD
C BUFFER.  ABNORMALLY EXIT DO WHILE LOOP ON END OF FILE.
C
	  IF (.NOT. EOF) THEN
  	    CALL LIB$ERASE_LINE (24,1) ! Find end of file
	    DO WHILE (.NOT. DONE)
	      CALL READSEQ (DONE)
	      IF (.NOT. DONE) HIGHREC = HIGHREC + 1
	      IF ( JMOD(HIGHREC,100) .EQ. 0) THEN
		STAT=LIB$SYS_FAO('RECORD !UL',LENG,MSG,%VAL(HIGHREC))
  		CALL MESSAGE (MSG(1:LENG),34)
	      END IF
	    END DO
  	    CALL LIB$ERASE_LINE (24,1)
	  END IF
C
C NOW DISPLAY LAST PAGE
C
  	  CURREC = HIGHREC-PAGESIZE+1
	  CALL DISP_PAGE(CURREC,LAST)
C
C DISPLAY PAGE
C
	ELSE IF (SREC .EQ. CURREC) THEN
	  CALL DISP_PAGE(SREC,LAST)
C
C SCROLL OR CREATE NEW PAGE??
C
	ELSE
          If (This_Cmd .EQ. 'F') goto 100 !All occurences this page
          If ((This_Cmd .EQ. 'N') .AND. (Last_Cmd .EQ. 'O')) goto 100
          Count = Srec - Currec ! Scroll if going little ways
	  IF (COUNT) 30,400,20
C
C NEW PAGE OR SCROLL UP??
C
20	  CONTINUE
          If (Count - 8) 200,200,100 ! Scroll if 8 away
C
C NEW PAGE OR SCROLL DOWN??
30	  CONTINUE
  	  COUNT = 0-COUNT
          If (Count - 8) 300,300,100 ! Scroll if 8 away
C
C  DISPLAY NEXT PAGE OF FILE
C
100	  CONTINUE
	  CALL DISP_PAGE(SREC,LAST)
   	  GOTO 400
C
C SCROLL SCREEN UP FROM BOTTOM
C
200	  CONTINUE
	  IF (EOF .AND. ((HIGHREC-CURREC) .LT. PAGESIZE)) GOTO 290
	  SREC = CURREC + PAGESIZE
  	  CALL WRITELN (ESC//'[23;1H')
	  DO 240, I=1,COUNT
	    CALL GETREC (SREC,DONE)
	    IF (DONE) GOTO 290
   	    CALL WRITELN (NEL)
	    CALL WRITELN (BUFFER)
	    SREC = SREC+1
  	    CURREC = CURREC+1
	    LAST = LAST+1
240	  CONTINUE
	  GOTO 400
290	  CONTINUE
          ELEN = 32
	  PASTBUFF(1:ELEN)=REVON//'Advance past end of file'//SGROFF
  	  GOTO 400
C
C SCROLL SCREEN DOWN FROM TOP
C
300	  CONTINUE
C
	  SREC = CURREC-1
	  DO 340 I=1,COUNT
	    IF (SREC .LE. 0) GOTO 390
	    CALL GETREC (SREC,DONE)
	    IF (DONE) GOTO 390
	    CALL WRITELN (PCSTBM//RI)
	    CALL WRITELN (BUFFER)
	    SREC = SREC-1
	    CURREC = CURREC-1
	    IF ((LAST-CURREC) .GE. PAGESIZE) LAST = LAST-1
340	  CONTINUE
	  GOTO 400
390	  CONTINUE
	  ELEN = 31
	  PASTBUFF(1:ELEN) = REVON//'Backup past top of file'//SGROFF
	  GOTO 400
C
C COMMON EXIT/RETURN
C
400	  CONTINUE
	  IF (ELEN .GT. 0) THEN
  	    CALL MESSAGE (PASTBUFF(1:ELEN),1)
    	    DERR = .TRUE.
          END IF
  	END IF
C
	STAT = LIB$SYS_FAO('T=!UL:B=!UL',LENG,WINDOW_MSG,
     1                        %VAL(CURREC),%VAL(LAST))
	CALL MESSAGE (WINDOW_MSG,65)
C
  	RETURN
  	END
C
C-----------------------------------------------------------------------]
C
	SUBROUTINE WRITELN (STRNG)
C
	IMPLICIT INTEGER*4 (A-Z)
	CHARACTER*(*) EL,ESC,STRNG
	CHARACTER*132 BUFF
        Character*1188 BigB
        Character*132 LocBuf
        Character*80 LocPat
C
  	PARAMETER (ESC=CHAR(27),EL=ESC//'[0K')
C
  	EXTERNAL IO$_WRITEVBLK
C
	INCLUDE 'sfcommon.include'
C
C MAKE A LOCAL COPY OF THE TEXT BUFFER
C
	CALL STR$COPY_DX(%DESCR(BUFF),%DESCR(STRNG))!CLEAR LINE FIRST
	MAX = IPMAX(BUFF)
  	IF (BUFF(1:1) .EQ. CHAR(27)) GOTO 10
C
	STAT = SYS$QIO(%val(4),%VAL(CH1),IO$_WRITEVBLK,%REF(IOSB),
	1,,%REF(EL),%VAL(4),,%VAL(0),,)
	IF (.NOT. STAT) CALL LIB$STOP(%VAL(STAT))
C
C OUTPUT BUFFER
C
        If (Hl_String) goto 30
10	CONTINUE
	STAT = SYS$QIO(%val(5),%VAL(CH1),IO$_WRITEVBLK,%REF(IOSB),
	1,,%REF(BUFF),%VAL(MAX),,%VAL(0),,)
	IF (STAT .NE. 1) CALL LIB$STOP(%VAL(STAT))
        GOTO 4000
C------------------------------------------------------------------
30      Continue
	IF (GENSRCH) THEN
	  CALL STR$UPCASE(%DESCR(LOCPAT),%DESCR(SrchPat))
          CALL STR$UPCASE(%DESCR(LOCBUF),%DESCR(BUFF))
	ELSE
	  CALL STR$COPY_DX(%DESCR(LOCPAT),%DESCR(SrchPat))
          CALL STR$COPY_DX(%DESCR(LOCBUF),%DESCR(BUFF))
	END IF
        Lx = 1 ! Buff's index
        Bx = 1 ! BIGB's index
40      Continue
        G = INDEX (LOCBUF(Lx:Max),LOCPAT(1:SRCHSIZ))
        If (G .LE. 0) goto 300
        If (G .GT. 1) BigB(Bx :Bx+(G-2)) = Buff(Lx :Lx+(G-2))
        Lx = Lx + (G - 1)
        Bx = Bx + (G - 1)
        BigB(Bx : Bx + 3) = Esc//'[7m'
        Bx = Bx + 4
        BigB(Bx : Bx + (SrchSiz - 1)) = Buff(Lx : Lx + (SrchSiz-1))
        Bx = Bx + SrchSiz
        Lx = Lx + SrchSiz
        BigB(Bx : Bx + 3) = Esc//'[0m'
        Bx = Bx + 4
        GOTO 40
300     Continue ! Copy rest of buffer into BigB and display line
        Maxy = Bx + (Max - Lx)
        BigB(Bx : Maxy) = Buff(Lx:Max) ! copy rest
        STAT = SYS$QIO(%val(6),%VAL(CH1),IO$_WRITEVBLK,%REF(IOSB),
     1  ,,%REF(BigB),%VAL(MAXY),,%VAL(0),,)
	IF (STAT .NE. 1) CALL LIB$STOP(%VAL(STAT))
C-----------------------------------------------------------------
4000     Continue
  	RETURN
        END
C
C-----------------------------------------------------------------------
C
	SUBROUTINE DISP_PAGE (RECN,LAST_LINE)
C
	IMPLICIT INTEGER*4 (A-Z)
C
	INCLUDE 'sfcommon.include'
C
	SREC = RECN
	IF (SREC .LE. 0) SREC = 1
	IF ((EOF) .AND. (SREC .GT. HIGHREC)) SREC = HIGHREC
  	CALL WRITELN (CHAR(27)//'[1;23r')
C
  	J = 0
	CALL GETREC(SREC,DONE)
  	IF (DONE) GOTO 50
	CALL WRITELN (BUFFER)
  	J = 1
	CURREC = SREC
  	LAST_LINE = CURREC
  	SREC = CURREC+1
C
	DO 10 I=1,PAGESIZE-1
	  CALL GETREC(SREC,DONE)
	  IF (DONE) GOTO 50
  	  J=I+1
  	  CALL WRITELN (CHAR(27)//'E')
	  CALL WRITELN (BUFFER)
	  SREC = SREC + 1
  	  LAST_LINE = LAST_LINE+1
10	CONTINUE
C
C ERASE REMAINDER OF SCREEN
C
50	CONTINUE
	DO 55 I=J,PAGESIZE-1
C	  CALL LIB$ERASE_LINE ( J,1 )
	CALL WRITELN (CHAR(27)//'E'//CHAR(27)//'[2K')
55	CONTINUE
	RETURN
	END
C
C-----------------------------------------------------------------------
C
	SUBROUTINE GETREC (RECN,DONE)
C
	IMPLICIT INTEGER*4 (A-Z)
  	CHARACTER*(*) ESC
	CHARACTER*40 TMP
	CHARACTER*62 PROMPT
	CHARACTER*2 DUMBUFF
C
	LOGICAL*1 DONE
C
	INCLUDE 'sfcommon.include'
C
	PARAMETER (ESC=CHAR(27))
C
  	DONE = .FALSE.
	RECNO = RECN
C
  	IF (RECN .GT. 0) GOTO 10
	DONE = .TRUE.
	GOTO 20
C
10  	DO WHILE ((.NOT. EOF) .AND. (RECN .GT. HIGHREC) .AND. 
	1         (HIGHREC .LT. 20000))
  	  CALL READSEQ(EOF)
	  IF (.NOT. EOF) HIGHREC = HIGHREC + 1
	  DONE = EOF
  	END DO
C
	IF (RECN .GT. 20000) THEN
C
C  USER HAS EXCEEDED MAXIMUM FILE LIMIT.  NOTIFY USER, AND WAIT
C    FOR ACKNOWLEDGEMENT.
C
	  
	  TMP = ESC//'[7mmaximum of 20,000 lines exceeded'//ESC//'[0m'
	  PROMPT = TMP//ESC//'[1m (hit RETURN)'//ESC//'[0m'  
	  CALL LIB$ERASE_LINE (24,1)
	  CALL PROMPTIN (PROMPT,DUMBUFF,JJ)
	  CALL LIB$ERASE_LINE (24,1) 
C
	  EOF = .TRUE.
	  DONE = .TRUE.
	  RECNO = 20000
	ENDIF
C
C DO NOT READ RANDOM IF 'DONE' IS SET, AN ERROR OCCURRED OR END OF FILE
C  ENCOUNTERED.
C
	IF (.NOT. DONE) CALL READRAN (RECNO,BUFFSIZE,DONE)
C
20	CONTINUE
	RETURN
C
999	FORMAT (A) 
	END
C
C-----------------------------------------------------------------------
C
C  FUNCTION WHICH DETERMINES THE LAST PRINTABLE CHARACTER IN A STRING.
C  ALSO STRIPS ANY LEADING NON-PRINTABLE CHARACTERS
C
	INTEGER FUNCTION IPMAX(CVAR)
C
	CHARACTER*(*) CVAR
	CHARACTER*132 LOCBUF
	BYTE TRANSBUF(256)
C
	DATA TRANSBUF /0,0,0,0,0,0,0,7,0,9,0,0,0,0,14,15,
     1                 0,0,0,0,0,0,0,0,0,0,0,27,0,0,0,0,
     1	               ' ','!','"','#','$','%','&','''','(',')',
     1	               '*','+',',','-','.','/','0','1','2','3',
     1	               '4','5','6','7','8','9',':',';','<','=',
     1	               '>','?','@','A','B','C','D','E','F','G',
     1	               'H','I','J','K','L','M','N','O','P','Q',
     1	               'R','S','T','U','V','W','X','Y','Z','[',
     1	               '\',']','^','_','`','a','b','c','d','e',
     1	               'f','g','h','i','j','k','l','m','n','o',
     1	               'p','q','r','s','t','u','v','w','x','y',
     1	               'z','{','|','}','~',0,
     1                 0,0,0,0,0,0,0,0,0,9,0,0,0,0,0,0,
     1                 0,0,0,0,0,0,0,0,0,0,0,27,0,0,0,0,
     1	               ' ','!','"','#','$','%','&','''','(',')',
     1	               '*','+',',','-','.','/','0','1','2','3',
     1	               '4','5','6','7','8','9',':',';','<','=',
     1	               '>','?','@','A','B','C','D','E','F','G',
     1	               'H','I','J','K','L','M','N','O','P','Q',
     1	               'R','S','T','U','V','W','X','Y','Z','[',
     1	               '\',']','^','_','`','a','b','c','d','e',
     1	               'f','g','h','i','j','k','l','m','n','o',
     1	               'p','q','r','s','t','u','v','w','x','y',
     1	               'z','{','|','}','~',0/
C
C
C
	CALL LIB$MOVTC (%DESCR(CVAR), %DESCR(' '),%DESCR(TRANSBUF),
     1                  %DESCR(LOCBUF))
C
C
	CALL STR$TRIM (%DESCR(CVAR), %DESCR(LOCBUF), %REF(I))
C
C
C	I = LEN(CVAR)
C	DO WHILE ( (I .GT. 0 ) .AND.
C     1             ( (CVAR(I:I) .EQ. ' ') .OR.
C     2               (CVAR(I:I) .EQ. CHAR(127)) .OR.
C     3               ( (CVAR(I:I) .LE. CHAR(6)) .OR. 
C     5                  ( (CVAR(I:I) .GE. CHAR(10)) .AND.
C     6                     (CVAR(I:I) .LE. CHAR(13)) ))))
C          CVAR(I:I) = ' '
C	  I = I - 1
C	END DO
C	IF (I .LE. 0) I = 1
C	IF ( CVAR(I:I) .LT. ' ') CVAR(I:I) = ' '
C	J = 1
C	DO WHILE ((J .LT. I) .AND. (CVAR(J:J) .LT. ' ') 
C     1 .AND. ((CVAR(J:J) .EQ. CHAR(0)) .OR. (CVAR(J:J) .EQ. CHAR(1))
C     2 .OR. (CVAR(J:J) .EQ. CHAR(2)) .OR. (CVAR(J:J) .EQ. CHAR(3))
C     3 .OR. (CVAR(J:J) .EQ. CHAR(4)) .OR. (CVAR(J:J) .EQ. CHAR(5))
C     4 .OR. (CVAR(J:J) .EQ. CHAR(6)) .OR. (CVAR(J:J) .EQ. CHAR(10))
C     5 .OR. (CVAR(J:J) .EQ. CHAR(11)) .OR. (CVAR(J:J) .EQ. CHAR(12))
C     6 .OR. (CVAR(J:J) .EQ. CHAR(13))))
C          CVAR(J:J) = CHAR(0)
C	  J = J + 1
C	END DO
	IPMAX = I
	RETURN 
	END
C
C-----------------------------------------------------------------------
C
	SUBROUTINE PROMPTIN (PROMPT,BUFF,JJ)
C
	IMPLICIT INTEGER*4 (A-Z)
	CHARACTER*(*) PROMPT,BUFF,K4,K5,ESC
  	CHARACTER*80 TMPBUFF
	CHARACTER*3 SEQ
	CHARACTER*1 Tempy
C
	EXTERNAL IO$_READPROMPT,IO$M_PURGE,IO$M_TRMNOECHO
C
	INCLUDE 'sfcommon.include'
C
	PARAMETER (ESC=CHAR(27),K4=ESC//'Ot',K5=ESC//'Ou')
C
	F1 = %LOC(IO$_READPROMPT) .OR. %LOC(IO$M_TRMNOECHO)
C     1         .OR. %LOC(IO$M_PURGE)
C
	STAT = SYS$QIOW(%VAL(3),%VAL(CH1),%VAL(F1),%REF(IOSB),,,
	1  %REF(TMPBUFF),%VAL(80),,,%REF(PROMPT),%VAL(LEN(PROMPT)))
C
	IF (.NOT. STAT) CALL LIB$STOP(%VAL(STAT))
	IF (.NOT. IOSB(1)) CALL LIB$STOP (%VAL(IOSB(1)))
	X = IOSB(2)
        JJ = X
        If (X .EQ. 0) Return
	BUFF = TMPBUFF(1:X)
C
C CHECK TERMINATOR CHARACTER:  IF IT IS AN ESCAPE SEQUENCE, CHECK
C  FOR EXACT NATURE OF ESCAPE SEQUENCE.
C
	IF (IOSB(4) .GT. 1 ) THEN
	  DO 10,I=1,IOSB(4)
	    SEQ(I:I) = TMPBUFF(X:X)
	    X = X + 1
10	  CONTINUE
	  IF (SEQ .EQ. K4) THEN
	    DIREC = +1
	  ELSE IF (SEQ .EQ. K5) THEN
C  	    IF (DIREC .EQ. 1) CURREC = CURREC+1
  	    DIREC = -1
	  END IF
	END IF
	RETURN
	END
C
C-----------------------------------------------------------------------
C
 	SUBROUTINE MESSAGE (TEXT,COL)
C
	IMPLICIT INTEGER*4 (A-Z)
  	CHARACTER*(*) TEXT
C
  	EXTERNAL IO$_WRITEVBLK
C
  	INCLUDE 'sfcommon.include'
C
  	CALL LIB$SET_CURSOR(24,COL)
  	CALL WRITELN (CHAR(27)//'[1m')
C  	MAX = IPMAX(TEXT)
  	MAX = LEN(TEXT)
	STAT = SYS$QIO(%val(7),%VAL(CH1),IO$_WRITEVBLK,%REF(IOSB),
	1,,%REF(TEXT),%VAL(MAX),,%VAL(0),,)
	IF (STAT .NE. 1) CALL LIB$STOP(%VAL(STAT))
  	CALL WRITELN (CHAR(27)//'[m')
  	CALL LIB$SET_CURSOR (1,1)
  	RETURN
  	END 
C
C-----------------------------------------------------------------------
C
	SUBROUTINE FINDSTRING (PATRN, RECN, FOUND)
C
	IMPLICIT INTEGER*4 (A-Z)
	CHARACTER*(*) PATRN
	CHARACTER*132 LOCPAT,LOCBUF
	LOGICAL*1 FOUND,DONE
C
  	INCLUDE 'sfcommon.include'
C
C  The following line will force all searches to be generic.
C  There was a bug in the program that caused it to sometimes switch
C  to exact searche mode when the user didn't tell it to.
C 
        GENSRCH = .TRUE. !Force a generic search - !!!!!!!!!!!
C
C
	FOUND = .FALSE.
	DONE = .FALSE.
	SREC = RECN
	IF (SREC .LE. 0) SREC = 1
C
C IF GENERIC SEARCH THEN FORCE SEARCH STRING TO UPPER CASE
C
	IF (GENSRCH) THEN
	  CALL STR$UPCASE(%DESCR(LOCPAT),%DESCR(PATRN))
	ELSE
	  CALL STR$COPY_DX(%DESCR(LOCPAT),%DESCR(PATRN))
	END IF
C
	DO WHILE ((.NOT. FOUND) .AND. (.NOT. DONE))
	  CALL GETREC(SREC, DONE)
	  IF (.NOT. DONE) THEN
	    IF (GENSRCH) THEN
	      CALL STR$UPCASE(%DESCR(LOCBUF),%DESCR(BUFFER))
	    ELSE
	      CALL STR$COPY_DX(%DESCR(LOCBUF),%DESCR(BUFFER))
	    END IF
D	TYPE *,'Search pattern = "',LOCPAT(1:SRCHSIZ),'"'
D	TYPE *,'Source string = ',LOCBUF

            Hl_Pos = INDEX (LOCBUF,LOCPAT(1:SRCHSIZ))
	    FOUND = (Hl_Pos .NE. 0)
	    IF (.NOT. FOUND) SREC = SREC + DIREC
	  END IF
	END DO
C
	IF (FOUND) RECN = SREC
	RETURN
        END

