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-7159
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-------------------------------------------------------------------

        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'
        Character*(Files_Display_Width) TEMPXX
        Character*(Files_Display_Width) Library

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. '@') then
	                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
                                                       
    		If  (((File_Name_Extension .NE. 'FLG') .AND.
	1	      (File_Name_Extension .NE. 'FRM')) .OR.
	2             (.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
		GoTo 100   ! Safety
	End If


        Exit_Com(J:) = TEMPXX

	If (Choice .EQ. 'B') 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)

	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 Str$Trim(%Descr(Exit_Com),%Descr(Editor),
	1			%Ref(NBytes))
	     		Exit_Com(NBytes+2:) = TEMPXX	

	       		Call Do_Single_DCL	
    	   	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 Str$Trim(%Descr(Exit_Com),%Descr(Viewer),
	1			%Ref(NBytes))
	     		Exit_Com(NBytes+2:) = TEMPXX	

	       		Call Do_Single_DCL	
    	   	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

			Exit_Com = ' @'//TEMPXX
	       		Call Do_Single_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

		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
        Character*1  Reply
        Character*3  File_Name_Extension
	Character*(*) FileName
        Include 'Common.Dat'

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

	Reply = ' '

	If (File_Name_Extension .EQ. 'FRM') then
		FRM = .TRUE.
	Else If (File_Name_Extension .EQ. 'FLG') then
		FRM = .FALSE.
	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
	Call SMG$Put_Line (Window2_Display,
	1	'        FMS Edit of File: '// FileName
	2	,,SMG$M_Reverse)

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


                  
C		Selections
	If (FRM) then
		GoTo 100
	Else
		GoTo 200
	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


300	Call SMG$Put_Chars (Window2_Display,
	1   'Any other character to cancel FMS edit'  
	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 WriteTerm (Cursor_Off)
        Reply = ' '
	Call Get1Char(Reply)
   	Call WriteTerm (Cursor_On)

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

	If (FRM) then
	        If (Lib$MatchC(Reply, 'DBEI') .GT. 0) RETURN
	Else     
	        If (Lib$MatchC(Reply, 'TL') .GT. 0) RETURN
	End IF

	Reply = ' '
	Return
	End

