C*****************************************************************************
C	Keystroke handling routines for DM
C  Version 6.x				            August, 1986
C	Dale E. Coy
C	Los Alamos National Laboratory
C	(505) 667-3270
C
C*****************************************************************************
	Subroutine Gold_Keys

	Implicit Integer*4 (A - Z)
	
	Integer*2 Dst_Len
	Character*1 Com,UCMD 
	Character*3 Temp
	Character*16 Identification
	Character*20 Link_time
                  
	Include 'Common.Dat'
	Include	'($LNMDEF)'
	Integer*4 SYS$TrnLnm
                                                
	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}{}{}{}      {ESC}{[}{P} =  GOLD (PF1)
C	---------------------- This is a <GOLD> Key Sequence
C-------------------------------------------------------------------C
C	PROCESS <GOLD> KEY SEQUENCE
C-------------------------------------------------------------------C

C	Get the next character after <GOLD>

        Call GET1Char(Com) ! GET the character of interest
	Call Str$UpCase (%Descr(UCMD),%Descr(Com))

C-------------------------------------------------------------------C
C  Com, UCMD, and Terminator (in common) may now be used to determine
C	what action is required.
C-------------------------------------------------------------------C

C}{}{}{}      {GOLD}{T} = TOP
	If  (UCMD .EQ. 'T')  then
		Call GoTop ! Go to top of the files array

        
C}{}{}{}      {GOLD}{B} = BOTTOM
        Else If (UCMD .EQ. 'B')  then  ! Go to bottom of files array
		Call GoBot
        

                          
C}{}{}{}      {GOLD}{,} = SEARCH (FIND)
        Else If (Com .EQ. ',') then
		Call FindStrg ! GET 'SEARCH' & show it
        	


C}{}{}{}      {GOLD}{.} = CONTINUE SEARCH (FIND NEXT)
        Else If (Com .EQ. '.') then
		Call ShowSrch ! Show 'SEARCH' string
        

                                  
C}{}{}{}      {GOLD}{$}  = Multiple DCL
C}{}{}{}      {GOLD}{[}  = Multiple DCL
C}{}{}{}      {GOLD}{DO} = Multiple DCL
        Else If ((lib$matchc (com, '$[') .gt. 0 ) .OR.
	1	 (Terminator .EQ. SMG$K_TRM_Do))  then 
	Call GoTo_DCL

C}{}{}{}      {GOLD}{K} = Quit
C}{}{}{}      {GOLD}{F} = Quit
       Else If (lib$matchc (Com, 'KkFf') .gt. 0 ) then
             Exit_Com = 'zzzz'!
	     DM_Exit = .TRUE.
       

C}{}{}{}      {GOLD}{G}   = GET FILE (REVERSE COPY)
C}{}{}{}      {GOLD}{F18} = GET FILE (REVERSE COPY)
       Else If  ((UCMD .EQ. 'G') .OR. 
	1        (Terminator .EQ. SMG$K_TRM_F18))  then
		Call Get_Files


C}{}{}{}      {GOLD}{W} = WRITE FILES (COPY)
       Else If  (UCMD .EQ. 'W')  then
		Call DM_Copy


C}{}{}{}      {GOLD}{H} = HELP
       Else If  (UCMD .EQ. 'H')  then
		Call DM_Help (4) ! Gold key help is first.


C}{}{}{}      {GOLD}{P} = PRINT DIRECTORY (SCREENS)
       Else If  (UCMD .EQ. 'P')  then
		Call DM_Print_Dir


C}{}{}{}      {GOLD}{A} = ADDITIONAL OPTIONS (CHANGE PRINTER, ETC.)
       Else If  (UCMD .EQ. 'A')  then
		Call DM_Gold_A


C}{}{}{}      {GOLD}{PF3} = FIND
       Else If  (Terminator .EQ. SMG$K_TRM_PF3)  then
		Call FindStrg


C}{}{}{}      {GOLD}{FIND} = CONTINUE SEARCH (FIND NEXT)
        Else If (Terminator .EQ. SMG$K_TRM_Find) then
		Call ShowSrch ! Show 'SEARCH' string
        
	
C}{}{}{}      {GOLD}{KP0} = Gold-Advance = Bottom
       Else If  (Terminator .EQ. SMG$K_TRM_KP0)  then
		Call GoBot


C}{}{}{}      {GOLD}{KP1} = Gold-Backup = Top
       Else If  (Terminator .EQ. SMG$K_TRM_KP1)  then
		Call GoTop


C}{}{}{}      {GOLD}{KP5} = Top/Bottom
       Else If  (Terminator .EQ. SMG$K_TRM_KP5)  then
		If (Forward) then
			Call GoBot
		Else
			Call GoTop
		End If


C}{}{}{}      {GOLD}{D} = CHANGE DISK
       Else If  (UCMD .EQ. 'D')  then
		StkIndex = 0
		Current_Dir_FileName = '[000000]000000.DIR'
		Current_Dir = '[000000]'
		Call PopStack


C}{}{}{}      {GOLD}{M} = MAIL (VMS Mail)
       Else If  (UCMD .EQ. 'M')  then
	
C 			Check if Mail$Edit is defined:
C	      Like Call Lib$SYS_TrnLog ('MAIL$EDIT',Dst_Len,HoldName)
		T_ItmLst.BufLen			=	LEN(HoldName)
		T_ItmLst.Dst_Address		=	%LOC(HoldName)
		T_ItmLst.Length_Address		=	%LOC(Dst_Len)
	
		HoldName = ' '
		Mail_Stat = SYS$TrnLnm(LNM$M_Case_Blind, 'LNM$FILE_DEV', 
	1		'MAIL$EDIT',, T_ItmLst)
	
	
	      If 
	1      ((Mail_Stat)
	2 .AND. (Lib$MatchC ('CALLABLE', HoldName(:Dst_Len)) .EQ. 0))
	3	  then
C 			This means that it's defined, and it
C 			isn't CALLABLE_Anything!
	      
		   Exit_Com = 'DEFINE/NOLOG MAIL$EDIT CALLABLE_TPU'
		   Call Do_Immediate_DCL
	      End If
	
C 			Since the logicals are carried through to the
C 			subprocess, mail may have been set:
C 			MAIL :== MAIL/EDIT, if desired.  We'll give
C 			them the mode they are used to.
	
		Call Fix_Spawned_Terminal
	
C NOT NECESSARY with WPE V5.0
C		    If (Editor .EQ. 'WPE') then
C 				First check if we're really using WPE
C		        Call Lib$SYS_TrnLog ('TPU$SECTION',K,HoldName)
C	
C			T_ItmLst.BufLen			=	LEN(HoldName)
C			T_ItmLst.Dst_Address		=	%LOC(HoldName)
C			T_ItmLst.Length_Address		=	%LOC(K)
C	
C			HoldName = ' '
C			Call SYS$TrnLnm(LNM$M_Case_Blind, 'LNM$FILE_DEV', 
C	1			'TPU$SECTION',, T_ItmLst)
C	
C		        If (Lib$MatchC ('WPE',HoldName(:K)) .NE. 0) then
C 				Assume we're using 'Real' WPE
C			  Call Set_Terminal_NoLine_Edit
C		        End If
C		    End If
	
		Exit_Com = 'MAIL'
		Call Do_Single_DCL
		Call Restore_Spawned_Terminal
		

C}{}{}{}      {GOLD}{I} = DIR/FULL (Big I)
       Else If  (UCMD .EQ. 'I')  then
		Call DM_Gold_I


C}{}{}{}      {GOLD}{~} = Show Version of DM
       Else If  (UCMD .EQ. '~')  then
	    	Call Read_Header (Identification, Link_Time)
		Write (Temp,300) Version
300     	Format(I3)
		If (Temp(1:1) .EQ. ' ') then
			If (Temp(2:2) .EQ. ' ') then
	     			Temp(1:3) = Temp(3:3)//'.0'  
			Else
				Temp(1:2) = Temp(2:2)//'.'
			End If
		End If
		Call Mess_Wait (' DM Version '//Temp//'A   [ '//
	1		Identification//' '//Link_Time//' ]')


	END IF

	Return
	End

C----------------------------------------------------------------------
C GOLD_A - Change Default Settings for:
C	Editor, Viewer, Printer, Printer_Type
C----------------------------------------------------------------------
	Subroutine DM_Gold_A

	Implicit Integer*4 (A - Z)
	Character*1 Com, UCMD 
	Character*80 Input_String
	Integer*2 NBytes
	Include 'Common.Dat'
C----------------------------------------------------------------------

	Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)
	Call SMG$Paste_Virtual_Display (Window2_Display,
	1	Pasteboard_ID,1,1)

	Call SMG$Erase_Display (Window2_Display)

C		LABEL FOR THIS SCREEN
	Call SMG$Put_Line (Window2_Display,
	1	'        Directory Management Additional Options:'//
	2	'  Change settings for....                  '
	3	,,SMG$M_Reverse)

C		HEADINGS
        Call SMG$Put_Chars (Window2_Display,
	1	'#     Item           Current Value'
	2   	,3,2,,SMG$M_Bold)

C 		FIXED INFORMATION
        Call SMG$Put_Chars (Window2_Display,
	1   '9  Save the Settings of these items.       '//
	2   '(in SYS$LOGIN:DM_DEFAULTS.COM)'
	2   	,13,2)                                        
	Call SMG$Change_Rendition (Window2_Display,13,2,1,4,SMG$M_Bold)

	
C		Now, set up the prompting display area:
	Call SMG$Create_Virtual_Display
	1	 (2,132, SGA_Display,,BR_Mask)

	Call SMG$Put_Line(SGA_Display,
	1	'  Type the number or ''initial'' of '//
	2	'the item you want to change.')

	Call SMG$Put_Line(SGA_Display,
	1	'                                       '//
	2	'(Press Return to leave the Options menu)')

	Call SMG$Paste_Virtual_Display (SGA_Display,
	1	Pasteboard_ID,23,1)

	
C		Selections
100     Call SMG$Put_Chars (Window2_Display,
	1   '1  Edit Command    - '//Editor(:60)
	2   	,5,2)                                        
	Call SMG$Change_Rendition (Window2_Display,5,2,1,4,SMG$M_Bold)

        Call SMG$Put_Chars (Window2_Display,
	1   '2  View Command    - '//Viewer(:60)
	2   	,6,2)                                        
	Call SMG$Change_Rendition (Window2_Display,6,2,1,4,SMG$M_Bold)

        Call SMG$Put_Chars (Window2_Display,
	1   '3  Print Command   - '//Print_Command(:60)
	2   	,7,2)                                        
	Call SMG$Change_Rendition (Window2_Display,7,2,1,4,SMG$M_Bold)

        Call SMG$Put_Chars (Window2_Display,
	1   '4  Type of Printer - '//Printer_Type(:10)
	2   	,8,2)                                        
	Call SMG$Change_Rendition (Window2_Display,8,2,1,4,SMG$M_Bold)


200	Call SMG$End_Pasteboard_Update (Pasteboard_ID)

	Call SMG$Set_Cursor_Mode (Pasteboard_ID, 1)
        Com = ' '
	Call Get1Char(Com)
	Call SMG$Set_Cursor_Mode (Pasteboard_ID, 0)

	Call Str$UpCase (%Descr(UCMD),%Descr(Com))

        If ((Com .EQ. '1') .OR. ( UCMD .EQ. 'E' )) then     
		Call Get_Initial_Line24 
	1	  (' New value for Edit Command:',Editor,
	2	    Input_String,NBytes)
		Call Fix24
		If (NBytes .LE. 0) then
			GoTo 200
		Else If ((Input_String(:NBytes) .EQ. ' ')
	1	    .OR. (Input_String(:Nbytes) .EQ. Editor)) then
			GoTo 200
		Else
			Editor = Input_String(:NBytes)
C				Set this as Global Symbol (Remember)
		        Call Lib$SET_Symbol(%Descr('DM$Editor'), 
	1				%Descr(Editor(:NBytes)),%Ref(2))
			Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)
			GoTo 100
		End If

        Else If ((Com .EQ. '2') .OR. ( UCMD .EQ. 'V' )) then     
		Call Get_Initial_Line24 
	1	  (' New value for View Command:',Viewer,
	2	    Input_String,NBytes)
		Call Fix24
		If (NBytes .LE. 0) then                       
			GoTo 200
		Else If ((Input_String(:NBytes) .EQ. ' ')
	1	    .OR. (Input_String(:Nbytes) .EQ. Viewer)) then
			GoTo 200
		Else
			Viewer = Input_String(:NBytes)
C				Set this as Global Symbol (Remember)
		        Call Lib$SET_Symbol(%Descr('DM$Viewer'), 
	1				%Descr(Viewer(:NBytes)),%Ref(2))
			Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)
			GoTo 100
		End If

        Else If ((Com .EQ. '3') .OR. ( UCMD .EQ. 'P' )) then     
		Call Get_Initial_Line24 
	1	  (' New value for Print Command:',Print_Command,
	2	    Input_String,NBytes)
		Call Fix24
		If (NBytes .LE. 0) then                       
			GoTo 200
		Else If ((Input_String(:NBytes) .EQ. ' ')
	1	    .OR. (Input_String(:Nbytes) .EQ. Print_Command)) 
	2			then
			GoTo 200
		Else
			Print_Command = Input_String(:NBytes)
C				Set this as Global Symbol (Remember)
		        Call Lib$SET_Symbol(%Descr('DM$Print_Command'), 
	1				%Descr(Print_Command(:NBytes)),
	2				%Ref(2))
			Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)
			GoTo 100
		End If

        Else If ((Com .EQ. '4') .OR. ( UCMD .EQ. 'T' )) then     
		Call Get_Initial_Line24 
	1	  (' New value for Type of Printer:',Printer_Type,
	2	    Input_String,NBytes)
		Call Fix24
		If (NBytes .LE. 0) then                       
			GoTo 200
		Else If ((Input_String(:NBytes) .EQ. ' ')
	1	    .OR. (Input_String(:Nbytes) .EQ. Printer_Type)) 
	2			then
			GoTo 200
		Else
			Printer_Type = Input_String(:NBytes)
C				Set this as Global Symbol (Remember)
		        Call Lib$SET_Symbol(%Descr('DM$Printer_Type'), 
	1				%Descr(Printer_Type(:NBytes)),
	2				%Ref(2))
			Call SMG$Begin_Pasteboard_Update (Pasteboard_ID)
			GoTo 100
		End If

        Else If ((Com .EQ. '9') .OR. ( UCMD .EQ. 'S' )) then     
		Open (Unit=1, File='SYS$LOGIN:DM_DEFAULTS.COM', 
	1		Carriagecontrol='NONE', Organization='SEQUENTIAL',
	2		Status='UNKNOWN', Err=219)
		Call SMG$Change_Rendition 
	1		(Window2_Display,13,49,1,25,SMG$M_Bold)
		Call Str$Trim (%Descr(Editor),%Descr(Editor),
	1		%Ref(NBytes))
		Write (1,209) '$ DM$EDITOR        :== '//Editor(:NBytes)
		Call Str$Trim (%Descr(Viewer),%Descr(Viewer),
	1		%Ref(NBytes))
		Write (1,209) '$ DM$VIEWER        :== '//Viewer(:NBytes)
		Call Str$Trim (%Descr(Print_Command),%Descr(Print_Command),
	1		%Ref(NBytes))
		Write (1,209) '$ DM$PRINT_COMMAND :== '//Print_Command(:NBytes)
		Call Str$Trim (%Descr(Printer_Type),%Descr(Printer_Type),
	1		%Ref(NBytes))
		Write (1,209) '$ DM$PRINTER_TYPE  :== '//Printer_Type(:NBytes)
209		Format (A)
		Close (Unit=1)
		Call SMG$Change_Rendition 
	1		(Window2_Display,13,49,1,25,SMG$M_Normal)
		GoTo 200
	
219		Continue	! Couldn't open the file	
		Call Mess_Wait (' Can''t open file '//
	1		'SYS$LOGIN:DM_DEFAULTS.COM to save your options')
		GoTo 200

	
	Else 
		GoTo 500
	End If


500	Call SMG$UnPaste_Virtual_Display (Window2_Display,Pasteboard_ID)
	Call SMG$Delete_Virtual_Display (SGA_Display)

	Return
	End
