C-------------------------------------------------------------------C
C Fix_CRT:  Fix back up screen.                                     C
C-------------------------------------------------------------------C
       Subroutine Fix_CRT
       Implicit Integer*4 (A - Z)
       Include 'common.include'
       Call Writel(LargeScreen, 21, 1)
       Call Writel(Reterminal, 22, 1)
       Call Lib$Erase_Page(23,1)
       Return    ! Exit when return
       End
C-------------------------------------------------------------------C
C Wanna do DCL command.  Let them try.                              C
C-------------------------------------------------------------------C
       Subroutine DCL(Startover, Exit_Com) 
       Implicit Integer*4 (A - Z)
       Integer*2 Nbytes
       Character*80 Temp_Line
       Character*80 DCL_LINE
       Character*70 Exit_Com
       Character*1 C1
       Include 'common.include'
C-------------------------------------------------------------------C
       Startover = 0 ! assume they will change their minds
       DCL_Line = ' '
       Call Writel(LargeScreen, 21, 1)
       Call Writel(Reterminal, 22, 1)
       Call Lib$Erase_Page(23,1)
       Call Lib$Put_Screen('Type DCL Command:', 23, 1)
       Call Lib$Put_Screen('(Wildcards: "\" = Current file,',
     -   23, 20)
       Call Lib$Put_Screen('"\\" = All Included files)', 23, 52)
       Call Lib$Put_Screen('$ ', 24, 1)
       Call KBDName(Temp_Line, Nbytes)
       If (Nbytes .EQ. 0) then 
         Call Fix23
         Goto 8000
       End If
       Show_EM = 0 ! don't show them the DCL they typed
       Ti = 0
	if (temp_line( nbytes:nbytes) .eq. '/') then
	  temp_line( nbytes:nbytes) = '\'
	end if
       Di = 1
50     Continue
       Ti = Ti + 1
       If (Ti .GT. Nbytes) Goto 100
       If (Temp_Line(Ti : Ti) .NE. '\') then
         DCL_Line(Di : Di) = Temp_Line(Ti : Ti) ! Normal character.
         Di = Di + 1
         If (Di .GT. 80) goto 7000 ! error
       Else ! backslash = special char-intercept and change
         Show_EM = 1 ! Since they are fancy show them the new DCL
         If (Temp_Line(Ti+1 : Ti+1) .NE. '\') then
           Call GetName(Ld(TopLine+CursorLine-1),TempName, Type)
           Do J = 1, Lib$Matchc('  ', TempName) - 1
             DCL_Line(DI:DI) = TempName(J:J)
             DI = DI + 1
             If (Di .GT. 80) goto 7000 ! error
           End Do 
         Else ! handle two backslashes
           Ti = Ti + 1
           If (IncluCount .LT. 1) Goto 6000
           Do I = 1, IncluCount ! start main loop to call print
             If (I .GT. 1) then
               DCL_Line(DI:DI) = ',' ! insert a comma for them
               DI = DI + 1
               If (Di .GT. 80) goto 7000 ! error
             End If
             Call GetName(Ld(IncluLines(I)), TempName, Type)
             Do J = 1, Lib$Matchc('  ', TempName) - 1
               DCL_Line(DI:DI) = TempName(J:J)
               DI = DI + 1
               If (Di .GT. 80) goto 7000 ! error
             End Do 
           End Do
           Do I = 1, LastLine
             Ld(I)(2:2) = ' ' ! Undelet all
           End Do
           IncluCount = 0
         End If
       End If
       Goto 50
100    Continue
       If (Show_EM .EQ. 1) then
         Print *, '$ '//DCL_Line ! show them the DCL line
         Print *, 'Enter "A" to abort, another key to continue' 
         Call Get1Char(C1, 1) !------- debug line ---------!
         If ((C1 .EQ. 'A') .OR. (C1 .EQ. 'a')) Goto 8000
       End If
       Print *, 'Doing the DCL command...'
       Exit_Com = DCL_Line
       Call Save_Stack('D') !say I'm doing Dcl
       Startover = 1 ! they decided to go ahead and do it
       goto 8000
6000   Continue
       Print *, 'No files included.  "\\" doesn''t make sense'
       Goto 7010
7000   Continue
       Print *, 'Too many characters on DCL line'
7010   Print *, '**** Type any character to continue ****'
       Call Get1Char(C1, 1)
8000   Continue
       If (startover .NE. 1) Call Write24 ! fix 23, 24th line
       Pur = 1 ! purge the type ahead buffer!
       Return
       End
C-------------------------------------------------------------------C
C Purge the default dir. 
C-------------------------------------------------------------------C
       Subroutine Purge(Startover)
       Implicit Integer*4 (A - Z)
       Character*1 Maybe
       Character*128 Def128,Real128,NH128
       Character*128 Bar(1000)
       Include 'common.include'
       integer name_size  !RTG
c      SEARCH AND SRCHSIZE ARE IN common.include
C-------------------------------------------------------------------C
       name_size = 78  
       Startover = 0
       BarIn = 0
       Call Mess('Are you sure you want to Purge This Directory?')
       Pur = 1 ! Purge the type ahead buffer when return to main too
       call purgechar
       Call Get1Char(Maybe, 1)
       If ((Maybe .EQ. 'y') .OR. (Maybe .EQ. 'Y')) then
    	 call getname(ld(CursorLine), search, nametype)
    	 srchsize = lib$matchc ('.', search) - 1
    	 search = search(1:srchsize)
         Call Writel(Epage, 1, 1)
         Startover = 1
         Do I = 1, IncluCount ! start main loop to copy file
           Ld(IncluLines(I))(2:2) = ' ' ! Remove the asterik
         End Do
         IncluCount = 0
         Call Sys$SetdDir(%Val(0),%Val(0),Def128)  !Get Default dir
         Call RealDir(Def128, Real128)  ! [aaa.bbb] --> [aaa]bbb.DIR
         Open(Unit=1,File=Real128,Status='OLD',READONLY,ERR=40)  
         Goto 50
40       Print *, epage,'Cannot open directory file: ',Real128
         Print *, '****Type any key to continue***'
         Call Get1Char(Maybe, 1)
         Goto 1100  ! Early exit 
50       Continue
100      Read(1, 200, End=900) RecSize, Size, BigRec(1:RecSize-4)
200      Format(Q, 3X, A1, A) ! Read Variable sized rec from dir file
         Nh128 = ' ' 
         NH128(1 : Size) = BigRec(1 : Size)
         Semi = Size + 1
         NH128(Semi : Semi) = ';' ! Put in semicolon 
         T = Size + 1             ! Point to 1st version number
         T = (T/2)*2 + 1          ! Ensure it is an odd number
         FirstVer = 1             ! Flag it as the 1st version
300      Continue                 ! Encode version number into string
         Temp = IChar(BigRec(T:T)) + 256 * IChar(BigRec(T+1:T+1))
         Encode (6, 400, NH128(Size + 2 : Size + 6)) Temp
400      Format(I6)
500      I = Lib$Matchc('; ',NH128) ! Take out the blanks
         If (I .NE. 0) then
           Do J = I + 1, I + 7
             NH128(J:J) = NH128(J+1:J+1)
           End Do
         End If
         If (I .NE. 0) Goto 500 
         If (FirstVer .NE. 1) then
c          Print *, 'About to Delete ', Nh128(1:name_size)
           BarIn = BarIn + 1
           Bar(BarIn) = Nh128(1:name_size)
         End If
         FirstVer = 0                        ! no longer on 1st ver.
         T = T + 8                           ! Version #'s are 8 apart
         If (T .LT. RecSize - 4) goto 300 !Done all versions?
         Goto 100                            ! YES-get next record
900      Close(1)
         Do I = name_size + 1, 128
           Nh128(I:I) = ' '
         End Do
         Do I = 1, BarIn
           Nh128(1:name_size) = Bar(I)
           Call DFile(Nh128, 0, 1, ExitReqx, Gone, 0)
         End Do
1100     Continue
    	 cursorline = cursorline + 1 - barin 
	   !return to the line you were displaying
	 if (cursorline .lt. 1) then cursorline = 1
    	 call showsrch
       Else
         Call Fix23
       End If
       Return 
       End
C-------------------------------------------------------------------C
C Rename a file.                                                    C
C-------------------------------------------------------------------C
       Subroutine Rename(Startover)
       Implicit Integer*4 (A - Z)
       Integer*2 Nbytes
       Integer*4 stat, cl
       Character*80 NewName
       Character*1 Maybe
       Character*128 TN
       Include 'common.include'
C-------------------------------------------------------------------C
       StartOver = 0
       Cl = topline + CursorLine - 1
       Call GetName(Ld(Cl),TN, Type)
       If (Type .EQ. 0) then  ! rename files only
         Call Mess('Are you sure you want to rename '//tn)
         Pur = 1 ! Purge type ahead buffer when return to main too
         Call Get1Char(Maybe, 1)
         Call Fix23
         If (lib$matchc (Maybe, 'Yy') .gt. 0) then
           Call Mess('Enter new file name: ')
           Call KBDName(NewName, NBytes)
           Call Fix23
           If (NBytes .EQ. 0) goto 9999 ! get out if no name entered
    	   stat = lib$rename_file (tn, newname)
    	   if (stat .ne. 1) then
    	     call mess('Error on rename')
    	     startover = 0
    	   else
             StartOver = 1
    	   end if
    	 end if ! Yes entered
       end if ! file type is right
9999   return 
       End
C-------------------------------------------------------------------C
C Copy files to a file                                              C
C-------------------------------------------------------------------C
       Subroutine Copy(Over)
       Implicit Integer*4 (A - Z)
       Integer*2 Nbytes
       Character*80 NewName,CC
       Character*128 Namex
       Character*1 Maybe,X
       Include 'common.include'
C-------------------------------------------------------------------C
       Over = 0
       If (IncluCount .LT. 1) then  ! Make Copy 1 same as copy many
         If ((CursorLine .EQ. 1) .AND. (TopLine .EQ. 1)) Goto 8000
         Call GetName(Ld(TopLine+CursorLine-1),Namex,Type)
         If (Type .EQ. 0) then 
           Call Include(TopLine+CursorLine-1, 0)
         Else 
           Goto 8000
         End If
       End If
       Temp = 0
       Do I = 1, IncluCount ! Make sure there is a file to copy
         Call GetName(Ld(IncluLines(I)), Namex, Type)
         If (Type .EQ. 0) Temp = 1
       End Do
       If (Temp .Eq. 0) goto 8000
       Call Mess('Are you sure you want to Copy the file(s)?')
       Pur = 1 ! Purge the type ahead buffer when return to main too
       Call Get1Char(Maybe, 1)
       If ((Maybe .NE. 'Y') .And. (Maybe .NE. 'y')) then 
         Call Fix23
         Goto 8000
       End If
       Over = 1  ! get all files in dir when done
       Call Mess('Enter new file name: ')
       Call KBDName(NewName, Nbytes)
       If (Nbytes .EQ. 0) then 
         Call Fix23
         Goto 8000
       End If
50     Format(A)
       Call GetName(Ld(IncluLines(1)), Namex, Type)
       If (Type .NE. 0) GOTO 60
       Inquire(File=Namex, CarriageControl = CC)
       Open(Unit=12, CarriageControl = CC, File=NEWNAME, 
     -   Status='NEW', ERR=60)
       Goto 70
60     Call Mess('Cannot open file '//NEWNAME(1:30)//'Type any Character
     - to continue')
       Call Get1Char(X, 0)
       Goto 8000
70     Continue
       Do I = 1, IncluCount ! start main loop to copy file
         Call GetName(Ld(IncluLines(I)), Namex, Type)
         If (Type .EQ. 0) then
           Open(Unit=14,File=Namex,Status='OLD',READONLY,Err=100)
           Call Mess('Copying file '//Namex(1:30))
           Goto 200
100        Call Mess('Unable to open file '//Namex(1:30))
           Goto 300
200        Read(14, 2000, End=250, Err=240) RecSize, 
     1       BigRec(1:RecSize)
           Goto 245
240        Call Mess('Error in read - File: '//Namex(1:30))
2000       Format(Q, A)
245        Write(12, 3000, Err=700) BigRec(1:RecSize)
           Goto 200
700        Call Mess('Error in write - File: '//Namex(1:30))
3000       Format(A)
250        Close(14)
300        Continue
         End If
       End Do
       Close(12)
8000   Continue
       Do I = 1, IncluCount ! start main loop to copy file
         Ld(IncluLines(I))(2:2) = ' ' ! Remove the asterik
       End Do
       IncluCount = 0
       If (Over .NE. 1) Call Write24  ! Get asteriks off screen too
       Return 
       End
C-------------------------------------------------------------------C
C Show the file or go to the directory and 'show it'                C
C-------------------------------------------------------------------C
       Subroutine Showit
       Implicit Integer*4 (A - Z)
       Character*128 Dname2,RealName2,PreName2,TEMPXX
       Character*1 C
       Include 'common.include'
C-------------------------------------------------------------------C
       Pur = 1 ! Purge type ahead keys after this command
       Dir = 0
       Call GetName(Ld(TopLine+CursorLine-1), TempName, Type)
       If (Type .NE. 0) then  ! 'DIR' type
         Dname2 = Dname
         PreName2 = PreName
         RealName2 = Realname
         Call Sys$SetdDir(TempName,%Val(0),%Val(0)) !New Default
         Call Sys$SetdDir(%Val(0),%Val(0),DName)   !Get Default dir
         Call RealDir(Dname, RealName) ! [aaa.bbb] --> [aaa]bbb.DIR
         Call PreDir(RealName, PreName)
         StkIndex = StkIndex + 1       ! push stack
         CStack(StkIndex) = Cursorline ! push stack
         TStack(StkIndex) = TopLine    ! push stack
         FStack(StkIndex) = Forward    ! push stack
         FastStack(StkIndex) = Fast    ! push stack 
         SaveFirst = FirstUsed
         Fast = 1
         Temp = IncluCount
         IncluCount = 0
         Call GetLd(RealName, Err)
         If (Err .EQ. 1) then 
           IncluCount = Temp
           FirstUsed = SaveFirst
           StkIndex = StkIndex - 1 ! Pop stack (error)
           Dname = Dname2
           PreName = PreName2
           Realname = Realname2
           Call Sys$SetdDir(Dname, %Val(0), %Val(0)) ! old default
         Else
           TopLine = 1
           Cursorline = FirstUsed
           Forward = 1
           DownLast = 1
         End If
       Else            !Type = 0 --- file not 'DIR' or 'Previous Dir'
         Open(Unit=17, File=TempName, Status='OLD', 
     -     READONLY, ERR=100)
         Close(17)
         Tempxx = TempName
         Gensrch = .TRUE. ! %%%%%% It changes to EXACT sometimes!!!
         Call SHOWFILE(Tempxx, Srchpat, Srchsiz, GenSrch)
       End If
       Call Write24
       Goto 9999
C------------------------------------------------------------------C
C Error opening the file.
C------------------------------------------------------------------C
100    Continue
       Call Mess('Cannot open the file! ')
9999   Continue
       Return
       End 
C-------------------------------------------------------------------C
C Print file(S).                                                    C
C-------------------------------------------------------------------C
       Subroutine Prnt
       Implicit Integer*4 (A - Z)
       Character*128 Namex,Name128
       Character*1 Tchr
       Include 'common.include'
C-------------------------------------------------------------------C
       If ((Cursorline + topline .EQ. 2) 
     1   .And. (IncluCount .EQ. 0)) Goto 200
       If (IncluCount .LT. 1) then  ! Make 1 same as many
         Call Include(TopLine+CursorLine-1, 0)
       End If
       Temp = 0
       Do I = 1, IncluCount
         Call GetName(Ld(IncluLines(I)), Namex, Type)
         If (Type .Eq. 0) Temp = 1
       End Do
       If (Temp .Eq. 0) Goto 200
       Call Mess('Are you sure you want to print file(s)? ')
       Pur = 1 ! Purge the type ahead buffer when return to main too
       Call Get1Char(Tchr, 1)
       Call Fix23
       If ((Tchr .NE. 'y') .AND. (Tchr .NE. 'Y')) Goto 200
       Do I = 1, IncluCount ! start main loop to call print
         Call GetName(Ld(IncluLines(I)), Namex, Type)
         If (Type .EQ. 0) then
           Call Prn(Namex, Sta)
           If (Sta .EQ. 1) then
             Call Mess('Queued : '//Namex(1:30))
           Else
             Call Mess('Could not open : '//Namex(1:30))
           End If
         Else
           Call Mess('Cannot Print directory : '//Namex(1:30))
         End If
       End Do
200    Continue
       Do I = 1, LastLine
         Ld(I)(2:2) = ' ' ! Undelet all
       End Do
       Call Write24
       IncluCount = 0
9999   Return
       End
