C-------------------------------------------------------------------C
C Print one file.                                                   C
C-------------------------------------------------------------------C
       Subroutine Prn(Namez, Stat)
       Implicit Integer*4 (A - Z)
       Character*128 Namez
       Include 'common.include'
C-------------------------------------------------------------------C
       Stat = 0 ! Assume can't open file
       Open(Unit=14, File=Namez, Status='OLD', READONLY, ERR=1400) 
       Stat = 1 ! Good open, will print
       Close(Unit=14,Dispose='Print')   !Print the file
1400   Return
       End
C-------------------------------------------------------------------C
C Delete file(S) or Dir(S) or both.                                 C
C-------------------------------------------------------------------C
       Subroutine Delit
       Implicit Integer*4 (A - Z)
       Character*128 Namex
       Character*1 Debug,Query
       Include 'common.include'
C-------------------------------------------------------------------C
       Only1 = 0
       Pur = 1 ! Purge the type ahead buffer when return to main too
       If (IncluCount .LT. 1) then  ! Make delete 1 same as del many
         Call GetName(Ld(TopLine+CursorLine-1), Namex, Type)
         If (Type .EQ. 2) Return
         If (Type .EQ. 0) then 
           Only1 = 1 ! Flag as only file to delete
           J = 1
           Do I = 1,80
             If (Namex(I:I) .NE. ' ') J = I
           End Do
           Call Mess('Really want to delete '//Namex(1:J)//'?')
           call purgechar
           Call Get1Char(Query, 1)
           Call Fix23
           If ((Query .NE. 'Y') .AND. (Query .NE. 'y')) Return
         End If
         Call Include(TopLine+CursorLine-1, 0)
         Rewrite24 = 0 ! don't rewrite screen for one file only
       Else
         Call Mess('Really want to delete the marked files?')
         call purgechar
         Call Get1Char(Query, 1)
         Call Fix23
         If ((Query .NE. 'Y') .AND. (Query .NE. 'y')) Return
         Rewrite24 = 1 ! rewrite screen since don't know about cursor
         Call Writel(Epage, 1, 1)
       End If
       Do I = IncluCount, 1, -1 ! start main loop to call delline
         Call GetName(Ld(IncluLines(I)), Namex, Type)
         If (Type .LT. 2) then
           If (Type .EQ. 1) Rewrite24 = 1 ! Screen to be changed
           Call Delline(Namex, Type, Stat, Req24, Abort)
           If (Req24 .EQ. 1) Rewrite24 = 1
           If (Abort .EQ. 1) Goto 200     ! Premature exit
           If (Stat .EQ. 1) then  ! File or dir was deleted
             If (Type .EQ. 1) then
               NumDirs = NumDirs - 1
               FileLine = FileLine - 1
               Encode (6, 400, Ld(4)(33 : 33 + 6)) NumDirs
             Else
               NumFiles = NumFiles - 1
               Encode (6, 400, Ld(FileLine)(33 : 33 + 6)) NumFiles
400            Format(I6)
               If (Rewrite24 .EQ. 1) then
                 Print *, 'Deleted ', Namex
               End If
             End If
             Do J = IncluLines(I), LastLine + 1
    	       ldattributes (j) = ldattributes (j + 1)
               Ld(J) = Ld(J + 1)  ! scoot the array up 
             End Do
    	     if (cursorline .gt. 2) cursorline = cursorline - 1
             LastLine = LastLine - 1
           End If
         End If
       End Do
       if (only1 .eq. 1) call dnarrow
200    Continue
C-------------------------------------------------------------------C
C Get rid of '*' s.                                                 C
C-------------------------------------------------------------------C
       Do I = 1, LastLine
         Ld(I)(2:2) = ' '
       End Do
       IncluCount = 0     ! Zero the include array index
C-------------------------------------------------------------------C
C Rewrite all or part of the screen.                                C
C-------------------------------------------------------------------C
       If (Rewrite24 .EQ. 1) then 
         Call Write24
         TTTT = Cursorline + Topline
         Call UpArrow
         If (TTTT .NE. Cursorline + Topline) Call DnArrow
       Else
        If ((Stat .EQ. 0) .AND. (Only1 .EQ. 1)) then
          Call Mess('Cannot delete this file ')
        Else
460      If ((CursorLine + TopLine - 1) .GT. LastLine) then
           If (CursorLine .GT. 1) then
             CursorLine = CursorLine - 1
           Else
             If (TopLine .GT. 1) TopLine = TopLine - 1
             Call Write24
             Goto 600
           End If
         End If           
         If ((CursorLine + TopLine - 1) .GT. LastLine) Goto 460
         Do I = CursorLine, 22
           If ((TopLine + I - 1) .LE. LastLine) then 
             Call Writel(Ld(TopLine + I - 1), I, 1)
    	     if (fast .eq.0)then
             Call Writel(Ldattributes(TopLine + I - 1), I, 
     -         file_attr_pos)
    	     end if !FAST = 0
           End If
           Call Writel(Char(27)//'[2K', I + 1, 1) !Erase the line
         End Do
         Call Fix23
         Call SetChoices(Fast)
         Call Lib$Put_Screen(Choices, 24, 1)
         If (TopLine .LT. 5) then ! display the number of Dirs
           Call Writel(Ld(4), 4 - TopLine + 1, 1)
         End If
         If ((TopLine .LT. FileLine) ! display the number of files
     -   .AND. (TopLine + 21 .GT. FileLine)) then 
           Call Writel(Ld(FileLine),FileLine-TopLine+1,1)
         End If
         TTTT = Cursorline + Topline
         Call UpArrow
         If (TTTT .NE. Cursorline + Topline) Call DnArrow
        End If
       End If
600    Return 
       End
C-------------------------------------------------------------------C
C Delete the file or directory.                                     C
C   Inputs : Nam - Name of file to delete                           C
C            Type - Type of file (0=file, 1=dir)                    C
C   Outputs: Sta - status = 1 if it was deleted                     C
C            Rereq - This program has determined that the screen    C
C               will need to be rewritten after the call            C
C            Exitreq - The user has requested that the 'DELETE'     C
C               Command be aborted (Don't call me anymore!)         C
C-------------------------------------------------------------------C
C There are three arrays associated with this routine and Dfile.    C
C   DoneDirs indexed by Dindex is all the directories that have beenC
C     processed so far.  When a directory is found if it's name is  C
C     not in DoneDirs then it is processed.  After being processed  C
C     Dindex is bumped, and DoneDirs(Dindex) <-- The Directory name.C
C   CurrDirs indexed by Cindex is a stack of the directories as     C
C     they are encountered.  If the user requests that a file not   C
C     be deleted then the entire stack is put into UnDirs.          C
C   UnDirs indexed by Uindex is a list of files and directories thatC
C     the user has chosen not to delete.  When the file or dir is   C
C     encountered again the user will not be asked again but rather C
C     the file or directory will be ignored.                        C
C-------------------------------------------------------------------C
       Subroutine DelLine(Nam, Type, Sta, Rereq, Exitreq)
       Implicit Integer*4 (A - Z)
       Character*128 FullName,Nam
       Character*1 Query
       Include 'common.include'
C-------------------------------------------------------------------C
       TempName = Nam ! Get passed file name to delete
       HoldName = Nam ! For single file delete's
       ReReq = 0      ! don't request a screen rewrite yet.
       Sta = 0        ! haven't deleted anything yet!
       ExitReq = 0    ! don't request a premature exit yet.
       If (Type .EQ. 1) then ! what type of file was passed?
         Call RealDir(TempName, HoldName)
         ReReq = 1           ! dir - must query user -please rewrite
         Call Writel(Epage, 1, 1)
         Print *, 'Enter - "D" to Delete with NO Verify'
         Print *, '        "A" to Abort this command'
         Print *, '        "V" to Verify each delete'
         Pur = 1 ! Purge type ahead buffer when return to main too
         Call Get1Char(Query, 1)
         If ((Query .EQ. 'A') .OR. (Query .EQ. 'a')) then
           ExitReq = 1
           Return       ! premature exit, changed their mind
         Else 
           If ((Query .EQ. 'D') .OR. (Query .EQ. 'd')) then 
             Verify = 0  ! don't verify each file before delete
           Else
             Verify = 1  ! verify is the default
           End If
         End If
         Dindex = 0
         Uindex = 0   
100      TempName = HoldName
         Cindex = 1
         CurrDirs(Cindex) = TempName   ! Put in current dir stack
200      Open(Unit=1, File=TempName, Status='OLD', READONLY,
     -     ERR= 210)  
         GoTo 300
210      Continue
C           Call Lib$Set_Prot(TempName, A2, B2, Returnpro)!so can open
         Open(Unit=1, File=TempName, Status='OLD', READONLY,
     -     ERR= 215)  
         GoTo 300
215      Print *, 'Cannot open : ',TempName
         Sta = 0
         Return
300      Read(1, 400, End=500) RecSize, Size, 
     &     BigRec(1:RecSize-4)
400      Format(Q, 3X, A1, A) 
C-------------------------------------------------------------------C
C Get the full name (ie dir + filename) into FullName               C
C-------------------------------------------------------------------C
         FullName = TempName
         NHold = ' '
         NHold(1 : Size) = BigRec(1 : Size)
         G = Lib$Matchc('.DIR', FullName)
         FullName(G:G) = ']'  ! Insert another ']' into string
         FullName(G+1:G+6) = '      '  ! clear off the 'DIR'
         Do I = 1, 80
           If (NHold(I:I) .EQ. ' ') Goto 451
           FullName(G+I:G+I) = NHold(I:I)
         End Do
451      Continue
         G = Lib$Matchc(']', FullName)  ! Find the 1st ']' in string
         FullName(G:G) = '.'            ! and replace with '.'
C-------------------------------------------------------------------C
C Fullname is now in 'FULLNAME'                                     C
C-------------------------------------------------------------------C
         G = Lib$Matchc('.DIR', FullName) ! Is the name a 'dir'?
         If (G .EQ. 0) then               ! No.  Attempt a delete.
           Do I = 1, Uindex
             If (UnDirs(I) .EQ. FullName) Goto 300
           End Do
           Close(1)
           Call DFILE(FullName, Verify, 1, Exitreq, Sta, 1)
           If (ExitReq .EQ. 1) Return
           Goto 200
         Else                             ! It is a 'dir'.
           Do I = 1, Dindex ! Have we already done this one?
             If (FullName .EQ. DoneDirs(I)) Goto 300 
           End Do
           Close(1)
           Cindex = Cindex + 1
           CurrDirs(Cindex) = FullName  ! Put in current dir stack
           TempName = FullName
           Goto 200
         End If
500      Close(1)
         Dindex = Dindex + 1
         DoneDirs(Dindex) = TempName  ! Mark it as done
         Do I = 1, Uindex
           If (UnDirs(I) .EQ. TempName) Goto 520
         End Do
         Call DFILE(TEMPNAME, Verify, 1, Exitreq, Sta, 1)
         If (ExitReq .EQ. 1) Return
520      If (TempName .NE. HoldName) Goto 100
         If (Uindex .NE. 0) Sta = 0
         Return
C-------------------------------------------------------------------C
C Delete a single file, not a dir.                                  C
C-------------------------------------------------------------------C
       Else ! delete a single file, not a 'dir'
         Call DFILE(HoldName, 0, 0, Exitreq, Sta, 1)
       End If
       Return
       End 
C-------------------------------------------------------------------C
C Routine that deletes one file                                     C
C-------------------------------------------------------------------C
       Subroutine DFILE(NAMEX, Verify, Listx, ExitReq, Gone, P)
       Implicit Integer*4 (A - Z)
       Integer*2 A2,B2,ReturnPro
       Character*4 C
       Character*1 Query
       Character*128 NAMEX,NameTmpx,NameTmpx2
       Include 'common.include'
C-------------------------------------------------------------------C
       Gone = 0    ! Assume I will not get it deleted
       Do I = 1, UnIndex
         If (Namex .EQ. UnDelete(I)) Return
       End Do
       Query = 'Y'
       If (Verify .EQ. 1) then 
         Print *, ' '
         Print *, 'Do you want to delete ', Namex
         Print *, '   "Y" for YES'
         Print *, '   "N" for NO'
         Print *, '   "A" to ABORT command'
         Pur = 1 ! Purge type ahead buffer when return to main too
         Call Get1Char(Query, 1)
       End If
       If ((Query .EQ. 'A') .OR. (Query .EQ. 'a')) then 
         ExitReq = 1
         Return
       Else
         ExitReq = 0
       End If
       If ((Query .EQ. 'Y') .OR. (Query .EQ. 'y')) then
         A2 = 0
         B2 = 0
C           If (P .EQ. 1) Call Lib$Set_Prot(Namex,A2,B2,Returnpro)
         If (Fast .EQ. 0) Call Flook(Namex)
         If (First_Free .EQ. 0) File_Siz = File_Siz - 1
         Call DelFile(%DESCR(NAMEX))  ! Delete the file
         If (DError .EQ. 0) then
           Gone = 1   ! The file has been deleted
           Total_Blks = Total_Blks - File_Siz
         Else 
           Gone = 0   ! File has not been deleted
         End If
700      Continue
         If (Listx .EQ. 1) then 
           If (Gone .EQ. 1) then 
             Print *, 'Deleted File: ', Namex
           Else
             Print *, 'Cannot delete file: ', Namex
           End If
         End If
       Else
         Print *, 'Did NOT delete file: ', Namex
         Gone = 0
       End If
       If (Gone .EQ. 0) then 
         Do I = 1, Cindex
           If (CurrDirs(I) .EQ. Namex) Goto 95
         End Do
         Uindex = Uindex + 1
         UnDirs(Uindex) = Namex
95       Continue
         Do I = 1, Cindex
           T = 0
           Do J = 1, Uindex
             If (CurrDirs(I) .EQ. UnDirs(J)) T = 1
           End Do
           If (T .EQ. 0) then
             Uindex = Uindex + 1
             UnDirs(Uindex) = CurrDirs(I)
           End If
         End Do
       End If
       Return
       End

