C*****************************************************************************
C
C  Revisions (Version 6.x)            August, 1986
C	Dale E. Coy
C	Los Alamos National Laboratory
C	(505) 667-7159
C
C*****************************************************************************
C-------------------------------------------------------------------C
C Purge the default dir, or selected subset. 
C-------------------------------------------------------------------C
       Subroutine DM_Purge
       Implicit Integer*4 (A - Z)
       Integer LastFileLen, ThisFileLen, FixLen, Save_Current, Purged	    
       Integer QP_Limit, NS_Limit
       Character*1 Maybe
       Character*4 Char4
       Character*30 FixWild	
       Character*80 LastFileName,ThisFileName,PurgeLine
       Character*80 PMsg
       Include 'Common.Dat'

	Parameter (QP_Limit =  8)
	Parameter (NS_Limit = 12)
        Integer Quick_Purge (NS_Limit)	

C-------------------------------------------------------------------C

	If (NumFiles .LE. 1) GoTo 9000
	ToPurge = 0

	Call GetName (First_File,LastFileName,Itsa_Dir)
	LastFileLen  = Lib$Matchc(';',LastFileName) -1	
                
	Do 10 K = First_File+1, Last_File
		Call GetName (K,ThisFileName,Itsa_Dir)
		ThisFileLen  = Lib$Matchc(';',ThisFileName) -1
		If ((ThisFileLen .EQ. LastFileLen) .AND.
	1	    (ThisFileName(:ThisFileLen) .EQ.
	2	     LastFileName(:LastFileLen)))  then
			ToPurge = ToPurge+1
			If (ToPurge .LE. NS_Limit) 
	1			Quick_Purge(ToPurge) = K
		End If
		LastFileName = ThisFileName
		LastFileLen  = ThisFileLen
10	Continue

  	If (ToPurge .LE. 0) GoTo 9000

C	We do have something to purge.

	If (WildCard(:WildCard_Length) .EQ. '*') then

	       PurgeLine = 'PURGE'	
	       PMsg = 
	1	' Are you sure you want to Purge This Directory?'//
	2  		' (Y/N) [N]   ' 

	Else

	       If (Lib$Matchc('.',Wildcard).GT.0) then
		FixWild = WildCard(:WildCard_Length)
		FixLen = WildCard_Length
	       Else
		FixWild = WildCard(:WildCard_Length)//'.*'
		FixLen = WildCard_Length+2
	       End If		

	       PurgeLine = 'PURGE '//FixWild(:FixLen)	

	       PMsg = 
	1 	' Are you sure you want to Purge '//
	2	FixWild(:FixLen)//' ?'//
	3  		' (Y/N) [N] '
                                                 

	End If


1004	Format(I4)
	       Write(Char4,1004) ToPurge
	Call SMG$Put_Chars (Purge_Display,Char4(2:),1,3)
	       Write(Char4,1004) NumFiles
	Call SMG$Put_Chars (Purge_Display,Char4,1,9)

	Call SMG$Put_Line(Line23MSG_Display,PMsg,0)

	Call SMG$Paste_Virtual_Display
	1	 (Line23MSG_Display,Pasteboard_ID,23,1)
	Call SMG$Paste_Virtual_Display
	1	 (Purge_Display,Pasteboard_ID,23,61)
	Purge_On = .TRUE.

	Call SMG$Set_Cursor_Abs(Line23_Display,1,1)

	Call WriteTerm (Cursor_Off)

        Maybe = 'N'	
       	Call Get1Char (Maybe)

	Call SMG$UnPaste_Virtual_Display
	1	 (Line23MSG_Display,Pasteboard_ID)


        If ((Maybe .EQ. 'y') .OR. (Maybe .EQ. 'Y')) then

	    Call Make_Dull	

	    If ((ToPurge .LE. QP_Limit) .OR.
	1	((ToPurge .LE. NS_Limit) .AND.
	2	 (.NOT.Have_SubProcess))) then
C			PROGRAMMER NOTE:
C			BE EXTREMELY CAREFUL WITH THIS CODE.  IT CAN
C			BLOW AWAY THE WRONG FILES IF IT'S WRONG!!!!
		Save_Current = Current_Line
		Purged = ToPurge

		Do 5 K = ToPurge,1,-1
			Current_Line = Quick_Purge (K)
			Call Delete_One_File (Didit)
			If (.NOT.Didit) then
				Purged = Purged - 1
			End If
5		Continue

		If (Save_Current .GE. First_File) then
		    Current_Line = MIN( Save_Current-Purged, Last_File)
		    Current_Line = MAX( Current_Line, First_File)
		Else
		    Current_Line = Save_Current
		End If

	    Else
C			THIS CODE IS MUCH LESS DANGEROUS THAN THE ABOVE.
		Exit_Com = PurgeLine
		Call SMG$Paste_Virtual_Display (Working_Display,
	1		Pasteboard_ID,1,1)

		Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)
      		Call Do_NoShow_DCL
		Call SMG$UnPaste_Virtual_Display (Working_Display,
	1		Pasteboard_ID)
		ReLoad = .TRUE.
	    End If
        End If
	
	Call SMG$UnPaste_Virtual_Display
	1	 (Purge_Display,Pasteboard_ID)
	Purge_On = .FALSE.

       	Call WriteTerm (Cursor_On)

        Return 

9000	Call Mess_Wait (' Nothing to Purge')
	Return

       End

