	SUBROUTINE SD
C----------------------------------------------------------------------
C  DO NOT COMPILE THIS ROUTINE WITH THE /CHECK SWITCH.  There is
C	some some "bug" in the way /Check interacts with SMG$ (no
C	apparent bug in the code) which affects the Stack display.
C	May be compiled with /Check for debugging of other code.
C----------------------------------------------------------------------
**
*	SET/SHOW DEFAULT DIRECTORY
*
*
*
*
*	ALAN L. ZIRKLE     NAVAL SURFACE WEAPONS CENTER
*			   CODE K53
*			   DAHLGREN, VIRGINIA  22448
*
*	Modified by:    Dale E. Coy		Sept/Oct 1986 (V4.0A)
*			Los Alamos National Laboratory
*                                               Oct 1986 (V4.1A)
*                                               Feb 1987 (V4.2A)
*                                               Nov 1987 (V4.3A)
*                                                (V4.4A)


	IMPLICIT INTEGER (A-Z)
	
	Include 'SD_Common.Dat'
                         
	LOGICAL PRIV,USER_HAS_PRIV, Check_Command

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

	If (Do_ID) then
		Print *,'        '//ReVideo//'     SD Version 5.0A '//Dull
		Return
	End If

  	If (PLen .EQ. 0) Call Error(1)

	Do_Tree =  CHECK_COMMAND('*')

	Do_Stack = CHECK_COMMAND('<<')

	Do_DM = CHECK_COMMAND('DM')

	RLen = 0
	Do_Dir =   CHECK_COMMAND('DIR')

	If (PLen .LE. 0) Return   !  Command was all stripped off.


	PRIV = USER_HAS_PRIV('SYSPRV')
	If (.NOT.Priv) 	PRIV = USER_HAS_PRIV('SETPRV')


C--------------  For SD Subs ---------------------------------------------
	Device = Current_Device
	DevLen = CDevLen
	Directory = Current_Directory
	DirLen = CDirLen
C-------------------------------------------------------------------------

	STATUS = SD_(PARAM(1:PLEN),PRIV)

	IF (.NOT.STATUS) THEN

	    IF (STATUS.EQ.'184CC'X) CALL ERROR(3)	! BAD DIRECTORY NAME
	    IF (STATUS.EQ.'1C04A'X) CALL ERROR(4)	! NO SUCH DIRECTORY
	    IF (STATUS.EQ.'00024'X) CALL ERROR(5)	! NO PRIVILEGE
	    IF (STATUS.EQ.'00908'X) CALL ERROR(6)	! NO SUCH DEVICE
	    IF (STATUS.EQ.'00930'X) CALL ERROR(7)	! NO MORE FILES

	ENDIF

CX		The following code determines what SD will do if you
CX		explicitly move to the directory you are now in:

CX	If ((Device(:Devlen) .NE. Current_Device(:CDevLen)) .OR.
CX	1   (Directory(:DirLen) .NE. Current_Directory(:CDirLen))) then

		Change = Device(:DevLen)
		Change(DevLen+1:) = Directory(1:DirLen)
		ChgLen = DevLen + DirLen
CX	Else
CX        	Change = ' '
CX		ChgLen = 0
CX	End If

	
10	Continue
	RETURN
	END

C---------------------------------------------------------------
	LOGICAL FUNCTION CHECK_COMMAND(KEY_STRING)
C---------------------------------------------------------------

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) KEY_STRING

	Include 'SD_Common.Dat'
C---------------------------------------------------------------

	Check_Command = .FALSE.

	If (PLen .LE. 0) Return

	K = Lib$MatchC (%Descr(Key_String), Param(:Plen))

	If (K .LE. 0) then
		Return
	Else If (K .GT. 1) then
		If (Param(K-1:K-1) .NE. ' ') Return
	End If

	J = Len(Key_String)

	If (J+K .LE. PLen) then      ! Something is beyond Key_String
		If (Param(J+K:J+K) .NE. ' ') Return
		Check_Command = .TRUE.

		If (Key_String .EQ. 'DIR') then
			Rest = Param(J+K+1:)
			RLen = PLen - (J+K)
			Param(K:) = ' '
			PLen = MAX(0,K-2)
			GoTo 9999
		Else
			Param (K:) = Param (J+K+1:)
			PLen = MAX(0, PLen - J - 1)
			If (PLen .LE. 0) GoTo 9999
		End If

10		K = Lib$MatchC ('  ',Param(:Plen))
		If (K .GT. 0) then
			Param (K:) = Param (K+1:)
			PLen = PLen - 1
                        If (PLen .GT. 0) GoTo 10
		Else
			If (Param(:PLen) .EQ. ' ') PLen = 0
		End If
	Else              ! Key_String ends the Params
		Check_Command = .TRUE.
		If (K .LE. 2) then
			Param = ' '
			PLen = 0
		Else
			PLen = K-2
		End If
	End If

9999	Return	

	END

C---------------------------------------------------------------------
	SUBROUTINE ERROR(CODE,STATUS)

	IMPLICIT INTEGER (A-Z)

	Include 'SD_Common.Dat'

	CHARACTER*2 B

C		The following is the Bell character - if you want it!
C	PARAMETER ( B = CHAR(7) // CHAR(7) )
	Parameter (B = '  ')
C---------------------------------------------------------------------

	CALL LIB$PUT_LINE(' ')

	GO TO (1,2,3,4,5,6,7),CODE

1	CALL LIB$PUT_LINE('  SYNTAX ERROR  '//B,2,3)
	GO TO 100

2	CALL LIB$PUT_LINE('  ERROR DEFINING SYMBOLS  '//B,2,3)
	CALL LIB$STOP(%VAL(STATUS))

3	CALL LIB$PUT_LINE('  INVALID DIRECTORY NAME  '//B,2,3)
	GO TO 100

4	CALL LIB$PUT_LINE('  NO SUCH DIRECTORY '//DIRECTORY(1:DIRLEN)
	1			//' ON '//DEVICE(1:DEVLEN)//'  '//B,2,3)
	GO TO 100

5	CALL LIB$PUT_LINE('  NO PRIVILEGE TO USE '//DIRECTORY(1:DIRLEN)
	1						  //'  '//B,2,3)
	GO TO 100

6	CALL LIB$PUT_LINE('  DEVICE '//DEVICE(1:DEVLEN)
	1				    //' NOT AVAILABLE  '//B,2,3)
	GO TO 100

7	CALL LIB$PUT_LINE('  END OF TRAVERSAL REACHED  '//B,2,3)

100	CALL EXIT('10000004'X)		! ABORT, WITHOUT A MESSAGE

	RETURN
	END
              
C------------------------------------------------------------------------
C	SD_Display_Stack

C		Displays the SD Stack.
C		Dale E. Coy, Sept/Oct 1986.
C------------------------------------------------------------------------
	Subroutine SD_Display_Stack

	Implicit Integer (A-Z)

	Integer*2 Terminator
	Integer*4 Start_Line, Start_Line_Len, End_Line, Line
	Integer*4 Previous_Line
	Character*2 NN
                                                  
	Include 'SD_Common.Dat'
	Include 'SD_SMG.Dat'

	Data Start_Line /3/
C------------------------------------------------------------------------

	Call SD_SMG

	Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)
	
	Call SMG$Put_Line(Top_Display,'     SD    Directory Stack')
                                                                       
	Call SMG$Paste_Virtual_Display        
     1		 (Bottom_Display,Pasteboard_ID,23,1)
  
	Call SMG$Put_Line(Bottom_Display,'  Press Up or Down Arrow '//
	1	'to move,  Select or Return Key to choose Directory.')

	Call SMG$Put_Line(Bottom_Display,
	1'                          Any other key will Quit.')

C------------------------------------------------------------------------
C		Now, fill in the Stack Display
	Write (SD_Slotn(8:9),108) SD_SP_Number
108				Format (I2.2)
	SP = SD_SP_Number
	
	Status = Lib$Get_Symbol (%Descr(SD_Slotn),
	1		%Descr(String),%Ref(SLen))

	Call SMG$Set_Cursor_Abs(Main_Display,%Ref(Start_Line),1)
	Call SMG$Put_Line(Main_Display,' Current '//String(:SLen))
	Start_Line_Len = SLen
	    If (SD_Highlight) then
		Call SMG$Change_Rendition (Main_Display,Start_Line,
	1		2,1,7,BR_Mask,0)
		Call SMG$Change_Rendition (Main_Display,Start_Line,
	1		10,1,%Ref(Start_Line_Len),SMG$M_Bold,0)
	    Else
		Call SMG$Change_Rendition (Main_Display,Start_Line,
	1		2,1,7,SMG$M_Reverse,0)
	    End If
	
C			And get the other SD_SLOTs
	Do I = 2, Stack_Depth

		SP = SP - 1
		If (SP .LT. 0) SP = Stack_Depth - 1
                Write (NN,108) I-1
		Write(SD_Slotn(8:9),108) SP
	
		Status = Lib$Get_Symbol (%Descr(SD_Slotn),
	1		%Descr(String),%Ref(SLen))

		If (I .LE. 10) then      ! I-1 is single-digit

			Call SMG$Put_Line(Main_Display,
	1		'     <'//NN(2:2)//'  '//String(:SLen))
		Else

       			Call SMG$Put_Line(Main_Display,
	1		'     <'//NN//' '//String(:SLen))

		End If

 	End Do


	Call SMG$Set_Cursor_Abs(%Ref(Main_Display),
	1		%Ref(Start_Line),%Ref(1))

	Line = Start_Line
	End_Line = Start_Line + Stack_Depth - 1
	GoTo 85  ! Skip extra instructions
C--------------------------------------------------------------------
C		Brighten the appropriate indicator
                  
80	Continue
	If (Line .EQ. Start_Line) then
	    If (SD_Highlight) then
		Call SMG$Change_Rendition (%Ref(Main_Display),
	1	     %Ref(Start_Line),%Ref(2),%Ref(1),%Ref(7),BR_Mask)
		Call SMG$Change_Rendition (Main_Display,Start_Line,
	1	     %Ref(10),%Ref(1),%Ref(Start_Line_Len),SMG$M_Bold)
	    End If
	Else
		Call SMG$Set_Cursor_Abs
	1		     (%Ref(Main_Display),%Ref(Line),%Ref(10))
		Call SMG$Read_From_Display
	1		     (%Ref(Main_Display),%Descr(String))
		Call STR$Trim (%Descr(String),
	1		     %Descr(String),%Ref(SLen))

		KP = SLen+4
	        If (SD_Highlight) 
	1	Call SMG$Change_Rendition (%Ref(Main_Display),
	2		%Ref(Line),6,1,%Ref(KP),SMG$M_Bold)
	End If

C       	And Read in a keypad stroke. 

85	Continue
	Call SMG$End_Pasteboard_Update (Pasteboard_ID)
	
	If (Line .EQ. Start_Line) then
		Call SMG$Set_Cursor_Abs	(Main_Display,Line,1)
	Else
		Call SMG$Set_Cursor_Abs	(Main_Display,Line,4)
	End If
	
	Call SMG$Read_KeyStroke (Keyboard_ID,Terminator)
                                   
	Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)

		If (Terminator .eq. SMG$k_trm_up) then

			Previous_Line = Line
			Line = Line - 1
			If (Line .LT. Start_Line) Line = End_Line

			GoTo 200


		Else If (Terminator .eq. SMG$k_trm_down) then
			
			Previous_Line = Line
			Line = Line + 1
			If (Line .GT. End_Line) Line = Start_Line

			GoTo 200


C			CR or either Select Key:
		Else If ((Terminator .EQ. SMG$k_trm_cr) .OR.
	1		 (Terminator .EQ.          273) .OR.
	2		 (Terminator .EQ.          314))  then
		    If (Line .NE. Start_Line) then
			Call SMG$Set_Cursor_Abs
	1			(%Ref(Main_Display),Line,10)
			Call SMG$Read_From_Display
	1			(%Ref(Main_Display),%Descr(Change))
			Call STR$Trim (%Descr(Change),
	1			%Descr(Change),%Ref(ChgLen))
		    End If
			Goto 9900


		Else If (Terminator .EQ. 23) then  !  RePaint

			Call SMG$Repaint_Screen (Pasteboard_ID)
			GoTo 80

		Else If (Terminator .EQ. 256) then  ! Gold
			Call SMG$Read_KeyStroke (Keyboard_ID,Terminator)
			Cmd = Char(Terminator)
			Previous_Line = Line

			If ((Cmd .EQ. 't') .OR. (Cmd .EQ. 'T')) then
				Line = Start_Line
				GoTo 200
			Else If ((Cmd .EQ. 'b') .OR. (Cmd .EQ. 'B')) then
				Line = End_Line
				GoTo 200
                        Else
                                GoTo 222   ! Exit
			End If

		Else  ! Exit, so fix up the "Current" (top) line

222			Call SMG$End_Pasteboard_Update (Pasteboard_ID)

			Call SMG$Change_Rendition (Main_Display,
	1			Start_Line,2,1,7,SMG$M_Reverse)
		    	If (Line .EQ. Start_Line) then
				GoTo 9950
		    	Else
				Previous_Line = Line  ! To signal cleanup
			        If (SD_Highlight)
	1			Call SMG$Change_Rendition 
	2			   (Main_Display,Start_Line,
	3			   10,1,%Ref(Start_Line_Len),SMG$M_Bold)

			GoTo 200    ! Exit
	 	    End If
		End If
                                   
C		Un-Brighten the Previous Display Line
200	Continue
	If (Previous_Line .EQ. Start_Line) then
	    If (SD_Highlight) then
		Call SMG$Change_Rendition (Main_Display,Start_Line,
 	1	     2,1,7,SMG$M_Reverse)
		Call SMG$Change_Rendition (Main_Display,Start_Line,
	1	     10,1,%Ref(Start_Line_Len),SMG$M_Bold,SMG$M_Bold)
	    End If
	Else
		Call SMG$Set_Cursor_Abs	(%Ref(Main_Display),
	1		%Ref(Previous_Line),%Ref(1))
		Call SMG$Read_From_Display
	1			(%Ref(Main_Display),%Descr(String))
		Call STR$Trim (%Descr(String),
	1			%Descr(String),%Ref(SLen))

		KP = SLen+4
	        If (SD_Highlight)
	1	Call SMG$Change_Rendition (%Ref(Main_Display),
	2	     %Ref(Previous_Line),%Ref(6),%Ref(1),%Ref(KP),
	3	     SMG$M_Bold,SMG$M_Bold)
	End If

	If (Line .EQ. Previous_Line) then
		GoTo 9950  ! Terminate 
	Else
		GoTo 80    ! To get another line
	End If


C		Terminate, clearing the screen (SDMAIN will write output).
9900	Call SMG$Delete_Pasteboard (Pasteboard_ID)
	GoTo 9999

C		Terminate, clearing only the last lines
9950	Call SMG$UnPaste_Virtual_Display 
	1		(Bottom_Display, Pasteboard_ID)
	Call SMG$Set_Cursor_Abs(Main_Display,24,1)
	Call SMG$Delete_Pasteboard (Pasteboard_ID,0)
	GoTo 9999

9999	Continue

	Call SMG$Delete_Virtual_Keyboard (Keyboard_ID)

	Return
	End

C------------------------------------------------------------------------
C	SET UP SMG ENVIRONMENT FOR SD PROGRAMS
C		Dale E. Coy         Sept/Oct, 1986
C		Los Alamos National Laboratory
C
C	Used by SD_Display_Stack and SDTREE
C------------------------------------------------------------------------
	Subroutine SD_SMG

        Implicit Integer*4 (A - Z)
	Include 'SD_SMG.Dat'

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

	
	Call SMG$Create_Pasteboard
     1		 (Pasteboard_ID,,PB_Rows,PB_Columns)

C 		Use NoTabs, as SMG gets confused if we don't
	Call SMG$Control_Mode (Pasteboard_ID,
	1	,Entry_Control_Mode)
	Current_Control_Mode = Entry_Control_Mode + SMG$M_NOTABS
	Call SMG$Control_Mode (Pasteboard_ID,
	1	Current_Control_Mode)
	

	Call SMG$Create_Key_Table (Key_Table_ID)
	
	Call SMG$Create_Virtual_Keyboard (Keyboard_ID,
	1	'TT')

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

	Call SMG$Create_Virtual_Display
     1		 (24,265, Main_Display)

	If (SD_VT300) then
	    Call SMG$Create_Virtual_Display
     1		 (1,80, Top_Display,,BR_Mask)
	Else
	    Call SMG$Create_Virtual_Display
     1		 (1,80, Top_Display,,SMG$M_REVERSE)
	End If
	
	If (SD_VT300) then
	    Call SMG$Create_Virtual_Display
     1		 (2,80, Bottom_Display,,BR_Mask)
	Else
	    Call SMG$Create_Virtual_Display
     1		 (2,80, Bottom_Display,,SMG$M_REVERSE)
	End If
	
	Call SMG$Create_Virtual_Display
     1		 (1,80, Normal_Display)


C	NOW SET UP THE INITIAL SCREEN
C----------------------------------------------------------------------

	Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)

	Call SMG$Paste_Virtual_Display
     1		 (Main_Display,Pasteboard_ID,1,1)
  
	Call SMG$Paste_Virtual_Display
     1		 (Top_Display,Pasteboard_ID,1,1)
  
	Call SMG$End_Pasteboard_Update (Pasteboard_ID)
	
	
9999	Return
        End

