C-------------------------------------------------------------------C C Print one file. C C-------------------------------------------------------------------C Subroutine Prn(Namez, Stat) Implicit Integer*4 (A - Z) Character*128 Namez Include 'Common.Dat' 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.Dat' 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 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.Dat' 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.Dat' 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