C*****************************************************************************
C
C  Revisions (Version 6.x)            July, 1986
C	Dale E. Coy
C	Los Alamos National Laboratory
C	(505) 667-3270
C
C*****************************************************************************
C-------------------------------------------------------------------C
C Save stacks, etc. in symbols DM$SYM1 and DM$SYM2.                 C
C-------------------------------------------------------------------C
       Subroutine Save_Stack
       Implicit Integer*4 (A - Z)
       Character*252 Symbol
       Include 'Common.Dat'
C-------------------------------------------------------------------C

       Symbol(1:1) = 'N'   ! signal this as not 1st time into dm
		Write (Symbol(5:9),2010) Current_Line
		Write (Symbol(10:14),2010) TopLine
		Write (Symbol(15:19),2010) StkIndex
		Write (Symbol(20:24),2010) Srchsize
		Write (Symbol(25:29),2010) Menu
		Write (Symbol(30:30),2012) Forward
		Write (Symbol(71:150),2011) Search
		Write (Symbol(151:170),2011) WildCard
		Write (Symbol(171:175),2010) WildCard_Length


       Stat = Lib$Set_Symbol('DM$SYM1', Symbol)
       If (.not. Stat) Call Lib$Stop(%Val(Stat))

C		Preserve the Directory Names for re-entry.
       Call Lib$Set_Symbol('DM$Current_Dir',  Current_Dir)
       Call Lib$Set_Symbol('DM$Original_Dir', Original_Dir)
       Call Lib$Set_Symbol('DM$Current_Dev',  Current_Device)
       Call Lib$Set_Symbol('DM$Original_Dev', Original_Device)

                               
       J = 1
       Do I = 1, StkIndex
		Write (Symbol(J:J),2012) FStack(I)
		Write (Symbol(J+1:J+1),2002) MenuStack(I)
		Symbol(J+2:J+2) = Char(CStack(I)/256)
		Symbol(J+3:J+3) = Char(MOD(CStack(I),256))

		Symbol(J+4:J+4) = Char(TStack(I)/256)
		Symbol(J+5:J+5) = Char(MOD(TStack(I),256))

         J = J + 6
       End Do
2002   Format(I1)
2010   Format( I5)
2011   Format(A)
2012   Format(L1)

       Stat = Lib$Set_Symbol('DM$SYM2', Symbol)
       If (.not. Stat) Call Lib$Stop(%Val(Stat))
       Return
       End

C-------------------------------------------------------------------C
C Get stacks, etc. from symbols DM$SYM1 and DM$SYM2.                 C
C-------------------------------------------------------------------C
	Subroutine Get_Stack (Who)
	Implicit Integer*4 (A - Z)
	Integer*2 K	
	Integer*4 Previous_Menu	
	Character*252 Symbol
	Character*1 Who
	Include 'Common.Dat'
	Include	'($LNMDEF)'
                                                
	Structure /TrnLnm_Item_List/
	  Integer*2 BufLen
	  Integer*2 Code		/LNM$_String/
	  Integer*4 Dst_Address
	  Integer*4 Length_Address
	  Integer*4 End_List		/0/
	End Structure

	Record /TrnLnm_Item_List/ T_ItmLst

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

       Stat = Lib$GET_Symbol('DM$SYM1', Symbol)
       If (.NOT. Stat) Call Lib$Stop(%Val(Stat))
                                       
       Who = Symbol(1:1)	
  	IF (Who .EQ. 'Y') then	  	!first time thru program           
C		 Handle DM Help command
	    If (Lib$MatchC('HELP',Symbol) .GT. 0) then 
		Call SMG$End_Pasteboard_Update (Pasteboard_ID)	
		Call DM_Help (3)
		Call Exit
	    End If

	         Symbol(1:1) = 'N'				    !point
        	 Call Lib$Set_Symbol('DM$SYM1', Symbol)

	         Current_Line = 4
        	 TopLine = 1
	         Forward = .TRUE. 
        	 Stkindex = 0             
	         SrchSize = 0                        
 		 Call SetChoices (Normal_Mode)
	      	 Call Sys$SetdDir( %Val(0), %Val(0), Original_Dir) 
		 Current_Dir = Original_Dir

C		 Call Lib$Sys_TrnLog('SYS$DISK',,Original_Device)

		 T_ItmLst.BufLen		=	LEN(Original_Device)
		 T_ItmLst.Dst_Address		=	%LOC(Original_Device)
		 T_ItmLst.Length_Address	=	%LOC(K)
	
		 Original_Device = ' '
		 Call SYS$TrnLnm(LNM$M_Case_Blind, 'LNM$FILE_DEV', 
	1		'SYS$DISK',, T_ItmLst)
	
		 K = Lib$MatchC(':',Original_Device)
		 If (K.GT.1) then
			Current_Device = Original_Device
		 Else
			Original_Device = 'SYS$DISK:'
		 End If

C			And, so the subprocess will know...
	       Call Lib$Set_Symbol('DM$Original_Dir', Original_Dir)
	       Call Lib$Set_Symbol('DM$Original_Dev', Original_Device)
                                                      
C	If (Symbol(1:1) .NE. 'Y') then ! Do this block on nth entry to dm
	ELSE

C			Get values of current and original directory symbols.
	       	Call Lib$Get_Symbol('DM$Current_Dir',  Current_Dir)
       		Call Lib$Get_Symbol('DM$Original_Dir', Original_Dir)
       		Call Lib$Get_Symbol('DM$Current_Dev',  Current_Device)
       		Call Lib$Get_Symbol('DM$Original_Dev', Original_Device)
C		  This is done in case a DCL process has changed directories.
C		  It puts us in the directory from which we exited (Save
C		     	Stack).

			Call Str$Trim (%Descr(Current_Device)
	1			,%Descr(Current_Device),%Ref(K))
			If (K.GT.1) Call Lib$Set_Logical
	1			('SYS$DISK',Current_Device(:K))
	      	 Call Sys$SetdDir( Current_Dir, %Val(0), %Val(0) ) 

C    	   Read where we are in file system
		 read(symbol(5:9),2010) Current_Line
		 read(symbol(10:14),2010) TopLine
		 read(symbol(15:19),2010) StkIndex
		 read(symbol(20:24),2010) Srchsize
	      	 read(symbol(25:29),2010) Previous_Menu
		 read(symbol(30:30),2012) Forward
		 read(symbol(71:150),2011)  Search
		 read(symbol(151:170),2011)  WildCard
		 read(symbol(171:175),2010)  WildCard_Length

		 Call SetChoices (Previous_Menu)


          Call Lib$GET_Symbol('DM$SYM2', Symbol)

          J = 1
          Do I = 1, StkIndex 
		 read(symbol(J:J),2012)  FStack(I)
		 read(symbol(J+1:J+1),2002)  MenuStack(I)
		 CStack(I) = 256*IChar(Symbol(J+2:J+2))
	1		       + IChar(Symbol(J+3:J+3))

		 TStack(I) = 256*IChar(Symbol(J+4:J+4))
	1		       + IChar(Symbol(J+5:J+5))

          J = J + 6 
          End Do
	END IF

2002     Format(I1)
2010	 Format(I5)
2011	 Format (A)
2012	 Format (L1)

        Call RealDir (Current_Dir, Current_Dir_FileName) 
C			 [aaa.bbb] --> [aaa]bbb.DIR
C	Call PurgeChar
   	Return
	End

C-------------------------------------------------------------------C
C Pop the stack (Go to the previous directory)                      C
C     Go "Up" in the directory structure: that is, go to the
C	directory of which this is a sub-directory.
C Note: We take information off of the stack until StkIndex = 0.
C-------------------------------------------------------------------C
       Subroutine POPSTACK
       Implicit Integer*4 (A - Z)
       Logical Did_Not_Load, NewDev
       Integer*2  NBytes, K 
       Integer*4 SaveMenu, Next_Menu
       Character*20 Old_Device	
       Include 'Common.Dat'
C-------------------------------------------------------------------C

	NewDev = .FALSE.

       I = Lib$Matchc(']',Current_Dir_FileName)
       TempName = Current_Dir_FileName(1:I)  
C			 Set TempName to the "previous" directory.
       Dname2    = Current_Dir
       RealName2 = Current_Dir_FileName
       Call Sys$SetdDir(TempName,%Val(0),%Val(0)) ! Set New Default Dir.
C						  !   to "TempName"
       Current_Dir = TempName	

C		GIVE THE OPERATOR A CHANCE TO CHANGE DEVICES IF
C			WE ARE AT THE TOP LEVEL
       	If (Current_Dir_FileName(1:18) .EQ. '[000000]000000.DIR') then
		Old_Device = Current_Device
		Call DM_NewDev (NewDev)
	End If

       Call RealDir (Current_Dir, Current_Dir_FileName)
C			 [aaa.bbb] --> [aaa]bbb.DIR

       Call Mess_Line(' Reading Directory '//Current_Dir_FileName(1:62))
       Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)	
       If (StkIndex .GT. 0) then 
         SaveMenu = Menu
         Next_Menu = MenuStack(StkIndex) ! GET_FILENAMES needs this info.
       Else
         SaveMenu = Normal_Mode
	 Next_Menu = Normal_Mode
       End If
       Temp = IncluCount
       IncluCount = 0

111    Call Get_FileNames ( Did_Not_Load, Next_Menu )
       If (Did_Not_Load) then 
		If (NewDev) then
			NewDev = .FALSE.
			Current_Device = Old_Device
		   	Call Str$Trim (%Descr(Current_Device)
	1			,%Descr(Current_Device),%Ref(K))
		   	Call Lib$Set_Logical('SYS$DISK'
	1			,Current_Device(:K))
       			Current_Dir = Dname2
       			Current_Dir_FileName = RealName2

			GoTo 111
		End If
         IncluCount = Temp
         Current_Dir          = Dname2
         Current_Dir_FileName = Realname2
         Call Sys$SetdDir (Current_Dir, %Val(0), %Val(0)) ! Set to old def. Dir.
       Else
	
       	 If (Have_SubProcess) then    ! Set Default Dir. for SubProcess
		Call Str$Trim (%Descr(Current_Device)
	1		,%Descr(Current_Device),%Ref(K))
		Exit_Com = 'SET DEFAULT '//
	1		Current_Device(:K)//Current_Dir
		Call Do_Immediate_DCL 
	 End If
	
	 If (NewDev) then
C		 Set to new default Dir.
            Call Sys$SetdDir (Current_Dir, %Val(0), %Val(0)) 
	 End If
	
         If (StkIndex .GT. 0) then 
           TopLine = TStack(StkIndex)
           Current_Line = CStack(StkIndex)
           Forward = FStack(StkIndex)
           StkIndex = StkIndex - 1     ! Pop!
         Else         
	   TempName = RealName2(Index(RealName2,']')+1:)
	   NBytes = Index(TempName,'.DIR')+3
	   Current_Line = FirstUsed
	   TopLine = 1           
C		See if we can find the right .DIR to put the cursor on..
	   Do 90 I= First_Dir,Last_Dir 

		Call SMG$Set_Cursor_Abs (Files_Display,%Ref(I),Name_Pos)
		Call SMG$Read_From_Display (Files_Display,HoldName)
		If (HoldName(:NBytes) .EQ. TempName(:NBytes)) then
			Current_Line = I
			TopLine = MAX(1,Current_Line-20)
C				Bug in SMG - Don't let TopLine = 2
			If (TopLine .EQ. 2) TopLine = 3
			GoTo 100
		End If
90	   Continue		

100        Forward = .TRUE.
         End If
       End If
       Call Write_Screen
       Call SMG$End_Pasteboard_Update (Pasteboard_ID)	
       Return
       End

C-------------------------------------------------------------------C
C Go to a directory and 'show it'                                   C
C   Go "down" in directory structure, by selecting a .DIR file from
C   	those displayed.
C Note that we always put information on the stack, when going down.
C-------------------------------------------------------------------C

       Subroutine PushStack
       Implicit Integer*4 (A - Z)
       Integer*2 K	
       Logical Did_Not_Load	
       Include 'Common.Dat'
C-------------------------------------------------------------------C

       Call Get_DirName(Current_Line, TempName, Itsa_Dir)
                                                          
       If (Itsa_Dir) then  ! 'DIR' type
         Dname2    = Current_Dir
         RealName2 = Current_Dir_FileName
         Call Sys$SetdDir(TempName,%Val(0),%Val(0)) ! Set New Default Dir
	 Current_Dir = TempName

         Call RealDir (Current_Dir, Current_Dir_FileName)
C			 [aaa.bbb] --> [aaa]bbb.DIR
         StkIndex = StkIndex + 1       ! push stack

	 If (StkIndex .GT. Max_Stack) then
		Do 100 I = 1,Max_Stack-1
			CStack(I)    = CStack(I+1)
			TStack(I)    = TStack(I+1)
			FStack(I)    = FStack(I+1)
			MenuStack(I) = MenuStack(I+1)
100		Continue
		StkIndex = Max_Stack
         End If
	 
         CStack(StkIndex) = Current_Line ! push stack
         TStack(StkIndex) = TopLine    ! push stack
         FStack(StkIndex) = Forward    ! push stack
         MenuStack(StkIndex) = Menu    ! push stack 
         SaveFirst = FirstUsed
         Temp = IncluCount
         IncluCount = 0

         Call Mess_Line(' Reading Directory '//
	1			Current_Dir_FileName(1:62))
         Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)	

         Call Get_FileNames ( Did_Not_Load, Normal_Mode )
         If (Did_Not_Load) then 
           IncluCount = Temp
           FirstUsed = SaveFirst
           StkIndex = StkIndex - 1 ! Pop stack back where it was.
           Current_Dir          = Dname2
           Current_Dir_FileName = Realname2
           Call Sys$SetdDir (Current_Dir, %Val(0), %Val(0)) ! Set Dir to old
C								default.
         Else
	   If (Have_SubProcess) then    ! Set Default Dir. for SubProcess
		Call Str$Trim (%Descr(Current_Device)
	1		,%Descr(Current_Device),%Ref(K))
		Exit_Com = 'SET DEFAULT '//
	1		Current_Device(:K)//Current_Dir
		Call Do_Immediate_DCL
	   End If

           TopLine = 1                
           Current_Line = FirstUsed
           Forward = .TRUE.
         End If
       Call Write_Screen
       Call SMG$End_Pasteboard_Update (Pasteboard_ID) 	
       Else
		Call Mess_Wait(' NOT A DIRECTORY FILE: '//TempName)
       End If              
9999   Continue                          
       Return
       End 

C-------------------------------------------------------------------C
C  Select New Device
C 	Version 7.304 Mod.......
C 	If first char is @, use DM_Username to set up new place.
C-------------------------------------------------------------------C
        Subroutine DM_NewDev (NewDev)
        Implicit Integer*4 (A - Z)
        Logical NewDev, AtStat
        Integer*2  NBytes, K 
	Integer*4 Device_Class, AtLoc
        Include 'Common.Dat'
	Include '($DCDEF)'
	Include '($DVIDEF)'
C-------------------------------------------------------------------C
C
	
	NewDev = .FALSE.

100	Call Get_Initial_Line24 
	1	(' Enter New Device or Directory:',Current_Device,
	2	    New_Device,NBytes)
	
	Call Fix24
	If (NBytes .LE. 0) GoTo 200
                         
C 		Is the first character (any character) '@'?
	AtLoc = Index (New_Device(:NBytes), '@')
	If (AtLoc .GT. 0) Then		! We want a User Sys$Login
	
		If (AtLoc .GT. 1) then
			New_Device = New_Device (AtLoc:)
			NBytes = NBytes - AtLoc + 1
		End If
	
C 		Pick one of the following two: UAF to use SYSUAF.DAT, or
C 		LIST to use SYSUAF.LIS (LIST can be made available to
C 		users by protection, but is a pain to keep updated.  UAF
C		is always up-to-date, but only available to managers)
C 
		Call DM_UserName_UAF  (Nbytes,AtStat)
C		Call DM_UserName_List (Nbytes,AtStat)
C	 		NOTE: New_Device is passed in common
	
		If (.NOT. AtStat) GoTo 100
	
	End If
	
C Now, regardless of how we got here, check for Directory, Etc.
	
	AtLoc = Index (New_Device(:NBytes), '[')
	If (AtLoc .GT. 0) then
C			MAKE SURE DIRECTORY NAME ENDS WITH ']'
        	J = Lib$MatchC(']',%Descr(New_Device))
		If (J.LE.0) then
		    NBytes = NBytes + 1
		    New_Device(NBytes:NBytes) = ']'
		Else
		    If (J .LT. NBytes) then
		    	NBytes = J
		    	New_Device(NBytes+1:) = ' '
		    End If
		End If
	
		Current_Dir = New_Device (AtLoc:NBytes)
		NewDev = .TRUE.       
		If (AtLoc .GT. 1) then
		    New_Device = New_Device (:AtLoc-1)
		    NBytes = AtLoc - 1
		Else
		    New_Device = ' '
		    NBytes = 0
		End If
	Else
		Current_Dir = '[000000]'
	End If
	
C			MAKE SURE DEVICE NAME ENDS WITH ':'
        J = Lib$MatchC('::',%Descr(New_Device))
	If (J.LE.0) then
        	K = Lib$MatchC(':',%Descr(New_Device))
	Else
	        K = Lib$MatchC(':',%Descr(New_Device(J+2:)))
	End If
	If (K .LE. 0) then
		K = Lib$MatchC (' ',New_Device)
		New_Device(K:K) = ':'
	End If

C			IS THERE A CHANGE?
	If  ((NBytes .LE. 0) 		.OR.
	1    (New_Device .EQ. ':')	.OR.
	2    (New_Device .EQ. Current_Device)) GoTo 200

C			CHECK TO SEE IF IT'S A DISK DEVICE
	Device_Class = 0
	Call Lib$GetDVI (%Ref(DVI$_DEVCLASS),,%Descr(New_Device),
	1	%Ref(Device_Class))
	If (Device_Class .NE. DC$_DISK) then
		K = Lib$MatchC(' ',New_Device)
		Call Mess_Wait 
	1		(New_Device(:K)//' Is Not a Disk Device')       
		GoTo 100
	End If

C			OK, SET UP FOR USING THE NEW DEVICE
	Current_Device = New_Device
	NewDev = .TRUE.       

	Call Str$Trim (%Descr(Current_Device)
	1	,%Descr(Current_Device),%Ref(K))
	Call Lib$Set_Logical('SYS$DISK'
	1	,Current_Device(:K))

	
C	DEFAULT DEVICE AND DIRECTORY FOR SUBPROCESS WILL BE SET
C		(IN POPSTACK) IF WE SUCCESSFULLY LOAD FROM THE
C		NEW DEVICE.


200	Return
	End

