C-------------------------------------------------------------------C
C Envoke FMS or EDT from within DMM.  Add other Commands in this module
C Rich Gregory 7/29/85
C-------------------------------------------------------------------C
C   Handles all editors, plus executing (@) .COM files
C
C	NOTE: In common with most editor-type functions, this will
C	only let you edit, view, or execute the LATEST version of
C	the file.
C 
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  REMOVED THE "BASIC" SECTION - D.E.C.
C     (BASIC is not available at our site, so couldn't test it.)
C  Also added section to respond to V(iew) and S(how) by envoking 
C	"Viewer"
C  Also handles (now) View & Show Directory - which transfers to a
C    new directory.
C-------------------------------------------------------------------
C  Programmer Notes:
C	To change default editor or "viewer", see Programmer.Doc
C 
C 	TPU, WPE and MORE are special symbols, which cause callable TPU to be
C used:  The exact editor/viewer used depends on whether TPU$SECTION is
C defined for the system.  
C      	If TPU$SECTION is not defined, the default is EVE.
C 	DEFINE TPU$SECTION LANL$UTILITY:[WPE]WPE.TPU$SECTION
C 		is the WPE (WPS+) emulator.
C-------------------------------------------------------------------
C Credit is also due to Bob Hassinger, who suggested using 
C 	callable TPU in this interface.
C 	Added by D.E.C. 11-APR-1987
C-------------------------------------------------------------------

        Subroutine Envoke_DCL_Command ( What_Function )
	
        Implicit Integer*4 (A - Z)
        Integer*2 NBytes	
        Character*1   What_Function, Choice, return_Choice
        Character*3   File_Name_Extension
        Character*1 C
        Logical Regular,Oddedit	
        Integer*2 Stat, K	
	
        Include 'Common.Dat'
	Include	'($LNMDEF)'
	
        Character*(Files_Display_Width) TEMPXX
        Character*(Files_Display_Width) Library
                                                
	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
                                  
        Call GetName(Current_Line, TempName, Itsa_Dir)

        If (TempName(1:1) .EQ. ' ') GoTo 9999	

        If (.NOT.Itsa_Dir) then          ! Disallow editing Directories
		
	        Oddedit = .FALSE.	
                Semi   = Lib$MatchC(';',TempName)
		Point  = Lib$MatchC('.',TempName)

		If ((What_Function .EQ. '@') .OR.
	1	    (Lib$MatchC(What_Function, 'VvSs' ) .GT. 0)) then
C			   For @ and View, use the version number.
	                TEMPXX = TempName(1:Semi+5)
		Else
	                TEMPXX = TempName(1:Semi-1)
		End If
		If (Semi.ge.5) then
			Regular = .TRUE.
	       	Else
			Regular = .FALSE.
			GoTo 10
		End If
         
		If (Tempname(Semi-4:Semi-4) .NE. '.') then
			Regular = .FALSE.
		End If
	
10		If (Point+1 .NE. Semi) then
	    		File_Name_Extension = TempName (Point+1:Semi-1)
		Else
			File_Name_Extension = ' '
		End If

    	     	If (Lib$MatchC(File_Name_Extension, 
     -       		'EXE-OLB-OBJ-FRM-FLB' ) .GT. 0) then
	  		Oddedit = .TRUE.
	     	Else
			Oddedit = .FALSE.
	     	End If

C-------------------------------------------------------------------C
C FMS Section        
C-------------------------------------------------------------------C

    	IF (Lib$MatchC(What_Function,  'Ff') .GT. 0) then
                                                       
		Call Fix_Spawned_Terminal
	
    		If  (((File_Name_Extension .NE. 'FLG') .AND.
	1	      (File_Name_Extension .NE. 'FRM') .AND.
	2	      (File_Name_Extension .NE. 'FLB')) .OR.
	3             (.NOT.Regular))     then
	    		Call Mess_Wait (' File Type not valid for FMS')
			GOTO 9999
		Else
			Call Envoke_FMS_Screen 
	1			(TEMPXX, File_Name_Extension, Choice)
	   	End If

C		NOTE: Envoke_FMS_Screen will validate and Uppercase
C			the reply in Choice.

	If (Choice .EQ. 'T') then
		Exit_Com = 'FMS/TRAN '
		J = 10

	Else If (Choice .EQ. 'I') then
		Library = ' '
    	     	Call Get_Answer_Line23(' Enter the library name:',
	1		Library, K)
		If ((K.LE.0) .OR. (Library .EQ. ' ')) GoTo 100
    	     	Exit_Com = 'FMS/LIB '//Library
		J = 10 + K

	Else If (Choice .EQ. 'L') then
		Exit_Com = 'FMS/TRAN/LIS '
		J = 14

	Else If (Choice .EQ. 'E') then
		Exit_Com = 'FMS/EDIT '
		J = 10

	Else If (Choice .EQ. 'D') then
		Exit_Com = 'FMS/DESC '
		J = 10

	Else If (Choice .EQ. 'B') then
		Exit_Com = 'FMS/DESCR/BRIEF '
		J = 17

	Else If (Choice .EQ. 'S') then
		Exit_Com = 'FMS/DIRECT/FULL '
		J = 17
	Else If (Choice .EQ. 'G') then
		Library = ' '
    	     	Call Get_Answer_Line23
	1		(' Name of the form to extract:',Library, K)
		If ((K.LE.0) .OR. (Library .EQ. ' ')) GoTo 100
    	     	Exit_Com = 'FMS/LIB/EXTRACT/LOG '//TEMPXX(:Semi-1)//
	1		'/FORM_NAME='//Library(:K)

		Go To 90
	
	Else If (Choice .EQ. 'P') then
		Library = ' '
		Call Get_Answer_Line23
	1		(' Name of the form (.FRM) to replace:',
	2			Library, K)
		If ((K.LE.0) .OR. (Library .EQ. ' ')) GoTo 100
    	     	Exit_Com = 'FMS/LIB/REPLACE/LOG '//TEMPXX(:Semi-1)//
	1		' '//Library(:K)
		Go To 90

	Else
		GoTo 100   ! Safety
	End If


	Exit_Com(J:) = TEMPXX

90	If ((Choice .EQ. 'B') .OR. (Choice .EQ. 'S')) then
		Call Do_One_DCL  ! Holds screen at end of output
	Else
		Call Do_Single_DCL
	End If

100	Continue

	Call SMG$UnPaste_Virtual_Display (Window2_Display,Pasteboard_ID)

	Call Restore_Spawned_Terminal
	
	GOTO 9999
	END IF           

                                               
C-------------------------------------------------------------------C
C EDIT section    (Uses "Editor")
C-------------------------------------------------------------------C

   	IF (Lib$MatchC(What_Function, 'Ee' ) .GT. 0) then

	    	If(Regular .AND. Oddedit) then
    	     		Choice = 'N'
    	     		Call Mess_Get1Char
	1     (' Do you really want to EDIT this file??? (Y/N) [N]',
	2		Choice)
		Else
			Choice = 'Y'
		End If

    	   	If (Lib$MatchC( Choice, 'Yy') .GT. 0) then

		    Call Fix_Spawned_Terminal
	
		    If ((Editor .EQ. 'TPU') .OR. 
	1	        (Editor .EQ. 'WPE') .OR. 
	2		(Editor .EQ. 'EDW')) then
C 				Use callable TPU
	
C NOT NEEDED with WPE V5.0 / DM V8.0 - Since we also recognize TPU.
C   
C 				First check if we're really using WPE
C		        Call Lib$SYS_TrnLog ('TPU$SECTION',K,HoldName)
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		        If ((Lib$MatchC ('WPE',HoldName(:K)) .NE. 0) .OR.
C	1		    (Lib$MatchC ('EDW',HoldName(:K)) .NE. 0)) then
C 				Assume we're using 'Real' WPE
C			  Call Set_Terminal_NoLine_Edit
C		        End If
	
C	This doesn't hurt much even if we're not using the WPE editor.
C 				Set the symbol WPE_LASTFILE for WPE
	     		Call Str$Trim(%Descr(TEMPXX), %Descr(TEMPXX), %Ref(K))
			Call Lib$Set_Symbol ('WPE_LASTFILE', TEMPXX(:K), 2)
			Exit_Com = 'TPU '//TEMPXX(:K)
			Call TPU$TPU (Exit_Com)
			Call SMG$Erase_Pasteboard (Pasteboard_ID)
			ReLoad = .TRUE.
	
		    Else
C 				Use whatever editor was specified
	     		Call Str$Trim(%Descr(Exit_Com),%Descr(Editor),
	1			%Ref(NBytes))
	     		Exit_Com(NBytes+2:) = TEMPXX	

	       		Call Do_Single_DCL	
		
		    End If
	
		    Call Restore_Spawned_Terminal
	
    	   	End If                         

		GOTO 9999
	END IF

C-------------------------------------------------------------------C
C VIEW (or SHOW) section    (Uses "Viewer")
C-------------------------------------------------------------------C

   	IF (Lib$MatchC(What_Function, 'VvSs' ) .GT. 0) then

	    	If(Regular .AND. Oddedit) then
    	     		Choice = 'N'
    	     		Call Mess_Get1Char
	1     (' Do you really want to VIEW this file??? (Y/N) [N]',
	2		Choice)
		Else
			Choice = 'Y'
		End If

    	   	If (Lib$MatchC( Choice, 'Yy') .GT. 0) then

		    Call Fix_Spawned_Terminal
	
		    If ((Viewer .EQ. 'MORE') .OR.
	1	        (Viewer .EQ. 'TPU')) then
C 				Use callable TPU
	
C 				First check if we're really using WPE
C		      Call Lib$SYS_TrnLog ('TPU$SECTION',K,HoldName)
			T_ItmLst.BufLen			=	LEN(HoldName)
			T_ItmLst.Dst_Address		=	%LOC(HoldName)
			T_ItmLst.Length_Address		=	%LOC(K)
	
			HoldName = ' '
			Call SYS$TrnLnm(LNM$M_Case_Blind, 'LNM$FILE_DEV', 
	1			'TPU$SECTION',, T_ItmLst)
		      If ((Lib$MatchC ('WPE',HoldName(:K)) .NE. 0) .OR.
	1		   (Lib$MatchC ('EDW',HoldName(:K)) .NE. 0)) then
C 				Assume we're using 'Real' WPE
C 				which means we don't want Read_Only
C NOT NEEDED with WPE V5.0
C			Call Set_Terminal_NoLine_Edit
			Exit_Com = 'TPU/NOJOURNAL '//TEMPXX
		      Else
C 				Something else - use Read_Only
			Exit_Com = 'TPU/READ_ONLY '//TEMPXX
		      End If
	
C 			  Execute and setup for reload - because
C 			  using TPU, even if it's in "read_only" mode,
C 			  the user can write anything he/she desires.
		      Call TPU$TPU (Exit_Com)
		      Call SMG$Erase_Pasteboard (Pasteboard_ID)
		      ReLoad = .TRUE.

		    Else
C 				Use whatever editor was specified
		     	Call Str$Trim(%Descr(Exit_Com),%Descr(Viewer),
	1			%Ref(NBytes))
	     		Exit_Com(NBytes+2:) = TEMPXX	

	       		Call Do_Single_DCL	
		
		    End If
	
		    Call Restore_Spawned_Terminal
	
    	   	End If 

		GOTO 9999
	END IF

C-------------------------------------------------------------------C
C BASIC Section    (Commented out by D.E.C.)
C	BASIC not available at our site.  This section has been
C		left with the original code, to provide some ideas.
C	DO NOT use this code - do the revision using the pattern
C		of the FMS section.
C-------------------------------------------------------------------C
C    	 If (Lib$MatchC(What_Function,  'Bb') .GT. 0) then
C    	   Call Writel(epage, 1,1)                            
C 1200	   Call Writel('  Loading BASIC with '//TEMPXX, 1, 1)
C    	   Call Writel('T = TBCOMP           		  ', 3,5)
C    	   Call Writel('L = Compile and List		  ', 4,5)
C    	   Call Writel('B = Build			  ',  5,5)
C    	   Call Writel('O = obj				  ',  6,5)
C    	   Call Writel('C= Build xx F (fortran)		  ',  7,5)
C    	   Call Writel('P = obj	xx F  (fortran)		  ',  8,5)
C
C    	   call get1char(Choice)
C
C    	   If   ((.NOT.Regular)
C	     .OR.(File_Name_Extension .NE. 'BAS')) then 
C    		call writel('Incompatible File Type',23,5)
C    		goto 1200
C    	   End If
C
C    	   If (Lib$MatchC( Choice, 'bBtTXxLlOo') .EQ. 0) goto 200
C    	   If (Lib$MatchC( Choice, 'tT') .GT. 0) invocation = 'fms/tran '
C    	   If (Lib$MatchC( Choice, 'Ii') .GT. 0) then
C    	     call writel('Enter the library name: ', 14,5)
C    	     call kbdname (library, stat)
C	     stat = Lib$MatchC ( ' ', library)
C    	   End If
Cc
C    	   If (Lib$MatchC( Choice, 'IiEedDtTLl') .GT. 0) then
C    	     return_Choice = 'E' !returns you directtly to DMM after doing 
C    				 !command
C      	   Else
C    	     return_Choice = 'D' !stops and asks for a keystroke for desc/brief
C   	   End If
C    	   If (Lib$MatchC( Choice, 'xX') .EQ. 0) then
C	     stat = Lib$MatchC ( '  ', invocation)
C             Exit_Com = invocation(1:stat+1)//TEMPXX
Cc		print *, exit_com, ' here '
Cc		call get1char (Choice)
C             Call DCL_Setup (return_Choice) ! save stuff and say I'm at DCL.
C	      Call Do_Single_DCL	
C   	   Else
C    	     call Write_Screen
C    	   End If !call basic compiler
C	GOTO 9999
C	END IF


C-------------------------------------------------------------------C
C COM file section
C-------------------------------------------------------------------C

   	IF (Lib$MatchC(What_Function, '@' ) .GT. 0) then

    	   	If   ((Regular) .AND. 
	1	      (File_Name_Extension .EQ. 'COM')) then
    	     		Choice = 'N'
    	     		Call Mess_Get1Char
	1     (' Do you really want to "@" this file??? (Y/N) [N]',
	2		Choice)
		Else
			Choice = 'Y'
		End If

    	   	If (Lib$MatchC( Choice, 'Yy') .GT. 0) then

		    Call Fix_Spawned_Terminal
	
			Exit_Com = ' @'//TEMPXX
	       		Call Do_One_DCL	

C	     			In case the subprocess directory was changed..
		     	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

		    Call Restore_Spawned_Terminal
	
		End If
		   

		GOTO 9999
	END IF
C		 E or F or @ calls to DCL
C---------------------------------------------------------------------
	Else       !! Fell through everything. (.DIR Type)
	     print *,'Internal Error ... Got to Showit Code in Envoke'
	End If

C---------------------------------------------------------------------
9999    Return 

        End
                                                 
C---------------------------------------------------------------------
C  Setup Screen for FMS Options
C---------------------------------------------------------------------
        Subroutine Envoke_FMS_Screen 
	1		( FileName, File_Name_Extension, Reply )

        Implicit Integer*4 (A - Z)
	Logical*1 FRM, FLG, FLB
        Character*1  Reply
        Character*3  File_Name_Extension
	Character*(*) FileName
        Include 'Common.Dat'

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

	Reply = ' '
	
	FRM = .FALSE.
	FLG = .FALSE.
	FLB = .FALSE.

	If (File_Name_Extension .EQ. 'FRM') then
		FRM = .TRUE.
	Else If (File_Name_Extension .EQ. 'FLG') then
		FLG = .TRUE.
	Else If (File_Name_Extension .EQ. 'FLB') then
		FLB = .TRUE.
	Else
		RETURN
	End If

	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
	If (.NOT. FLB) then
	    Call SMG$Put_Line (Window2_Display,
	1	'        FMS Edit of File: '// FileName
	2	,,SMG$M_Reverse)
	Else
	    Call SMG$Put_Line (Window2_Display,
	1	'        FMS Library Operation on: '// FileName
	2	,,SMG$M_Reverse)
	End If
	
C		HEADINGS
        Call SMG$Put_Chars (Window2_Display,
	1	'#       Operation'
	2   	,3,2,,SMG$M_Bold)


                  
C		Selections
	If (FRM) then
		GoTo 100
	Else If (FLG) then
		GoTo 200
	Else If (FLB) then
		GoTo 250
	End If


C		FORM FOR .FRM FILES
100     Call SMG$Put_Chars (Window2_Display,
	1   'D  - Describe                FRM --> FLG'
	2   	,5,2)                                        
	Call SMG$Change_Rendition (Window2_Display,5,2,1,1,SMG$M_Bold)
	Call SMG$Change_Rendition (Window2_Display,5,7,1,1,SMG$M_Bold)

        Call SMG$Put_Chars (Window2_Display,
	1   'B  - Describe/Brief          FRM --> Screen'
	2   	,6,2)                                        
	Call SMG$Change_Rendition (Window2_Display,6,2,1,1,SMG$M_Bold)
	Call SMG$Change_Rendition (Window2_Display,6,16,1,1,SMG$M_Bold)
                  
        Call SMG$Put_Chars (Window2_Display,
	1   'E  - Edit                    FRM file'
	2   	,7,2)                                        
	Call SMG$Change_Rendition (Window2_Display,7,2,1,1,SMG$M_Bold)
	Call SMG$Change_Rendition (Window2_Display,7,7,1,1,SMG$M_Bold)

        Call SMG$Put_Chars (Window2_Display,
	1   'I  - Insert in LIBrary       FRM file'
	2   	,8,2)                                        
	Call SMG$Change_Rendition (Window2_Display,8,2,1,1,SMG$M_Bold)
	Call SMG$Change_Rendition (Window2_Display,8,7,1,1,SMG$M_Bold)

	GoTo 300


C		FORM FOR .FLG FILES
200     Call SMG$Put_Chars (Window2_Display,
	1   'T  - Translate               FLG --> FRM'
	2   	,5,2)                                        
	Call SMG$Change_Rendition (Window2_Display,5,2,1,1,SMG$M_Bold)
	Call SMG$Change_Rendition (Window2_Display,5,7,1,1,SMG$M_Bold)

        Call SMG$Put_Chars (Window2_Display,
	1   'L  - Translate and List      FLG --> FRM'
	2   	,6,2)                                        
	Call SMG$Change_Rendition (Window2_Display,6,2,1,1,SMG$M_Bold)
	Call SMG$Change_Rendition (Window2_Display,6,21,1,1,SMG$M_Bold)

	GoTo 300


C		FORM FOR .FRM FILES
250     Call SMG$Put_Chars (Window2_Display,
	1   'D  - Directory               FLB --> Screen'
	2   	,5,2)                                        
	Call SMG$Change_Rendition (Window2_Display,5,2,1,1,SMG$M_Bold)
	Call SMG$Change_Rendition (Window2_Display,5,7,1,1,SMG$M_Bold)

        Call SMG$Put_Chars (Window2_Display,
	1   'E  - Extract a Form          FLB --> FRM'
	2   	,6,2)                                        
	Call SMG$Change_Rendition (Window2_Display,6,2,1,1,SMG$M_Bold)
	Call SMG$Change_Rendition (Window2_Display,6,7,1,1,SMG$M_Bold)
                  
        Call SMG$Put_Chars (Window2_Display,
	1   'R  - Replace                 FRM --> FLB'
	2   	,7,2)                                        
	Call SMG$Change_Rendition (Window2_Display,7,2,1,1,SMG$M_Bold)
	Call SMG$Change_Rendition (Window2_Display,7,7,1,1,SMG$M_Bold)

	GoTo 300


300	Call SMG$Put_Chars (Window2_Display,
	1   'Type any other character to cancel the FMS operation'  
	2   	,10,2)                                        


	Call SMG$End_Pasteboard_Update (Pasteboard_ID)

	Call Mess_Line (' Type the initial of '//
	1	'the operation you want to perform')

400	Call SMG$Set_Cursor_Mode (Pasteboard_ID, 1)
        Reply = ' '
	Call Get1Char(Reply)
C   	Call WriteTerm (Cursor_On)
	Call SMG$Set_Cursor_Mode (Pasteboard_ID, 0)

	Call Str$UpCase (%Descr(Reply),%Descr(Reply))

	If (FRM) then
	        If (Lib$MatchC(Reply, 'DBEI') .GT. 0) RETURN
	Else If (FLG) then     
	        If (Lib$MatchC(Reply, 'TL') .GT. 0) RETURN
	Else If (FLB) then     
	        If (Lib$MatchC(Reply, 'DER') .GT. 0) then
			If (Reply .EQ. 'D') Reply = 'S'
			If (Reply .EQ. 'E') Reply = 'G'
			If (Reply .EQ. 'R') Reply = 'P'
			Return
		End If
	End IF

	Reply = ' '
	Return
	End

