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
       Subroutine Envoke_DCL_Command
     +   (Exit_Flag, Exit_Com, Symbol, What_function)
       Implicit Integer*4 (A - Z)
       Character*80  Tempxx,EXIT_Com
       Character*250 Symbol
       Character*1   What_function, choice, return_choice
       Character*80  invocation
       Character*80  library
       Character*3   file_name_extension
       integer*2 stat
       COMMON /TTCH/ TTCH1
       Include 'common.include'
C-------------------------------------------------------------------C
       Call GetName(Ld(TopLine+CursorLine-1),TempName, Type)
       Exit_Flag = 0 ! Assume don't start over

        If (Type .ne. 0) Then
	  call showit
	  return
	end if          ! Disallow editing Directories
C-------------------------------------------------------------------C
C FMS Section
C-------------------------------------------------------------------C
    	 if (Lib$matchc(what_function,  'Ff') .gt. 0) then
           Semi = Lib$Matchc('.',TempName)
           Tempxx = TempName(1:Semi+7)
           Tempxx(Semi+8 : 80) = ' '
    	   file_name_extension = tempname (semi+1:semi+3)
    	   Exit_Flag = 1 ! Going to fms - startover when return
    	   Call Writel(epage, 1,1)
200	   Call Writel('  Loading FMS with '//bright//tempxx//dull
     -		, 1, 1)
    	   Call Writel('T = Translate        (FLG --> FRM)', 3,5)
    	   Call Writel('L = Trans and list   (FLG --> FRM)', 4,5)
    	   Call Writel('D = Describe         (FRM --> FLG)',  5,5)
    	   Call Writel('B = Desc/brief       (FRM --> TT:)',  6,5)
    	   Call Writel('C = Desc/brief/lis   (FRM file   )',  7,5)
    	   Call Writel('1 = Desc/disp=esc    (FRM file   )',  8,5)
    	   Call Writel('E = Edit             (FRM file   )',  9,5)
    	   Call Writel('I = lib/insert       (FRM file   )', 10,5)
    	   Call Writel('J = /create LIB      (FRM file   )', 11,5)

    	   Call Writel('X = Change your mind and return to DMM', 13,5)
    	   Call Writel('Please pick one -- (TLDBCEIJX)  ', 14,5)
    	   call get1char(choice)

    	   if ((file_name_extension .NE. 'FLG') .and.
     -	      (lib$matchc( choice, 'LltT') .gt. 0)) then
C		GET TO HERE ONLY IF FILE TYPE <> FLG AND CHOICE = T or L
    		call writel('Incompatible Choice!',23,5)
    		goto 200
    	   end if
    	   if ((file_name_extension .NE. 'FRM') .and.
     -	      (lib$matchc( choice, 'BbDdEeIicC1') .gt. 0)) then
C		GET TO HERE ONLY IF FILE TYPE <> FRM AND CHOICE = D OR E
    		call writel('Incompatible Choice!',23,5)
    		goto 200
    	   end if


	   if (lib$matchc( choice, 'Jj') .gt. 0) then
    	     if (lib$matchc( file_name_extension, 'FLB FRM') .eq. 0) then
C		GET TO HERE ONLY IF FILE TYPE <> FLB or FRM AND CHOICE = J
    		call writel('Incompatible Choice!',23,5)
    		goto 200
	     end if
    	   end if

    	   if (lib$matchc( choice, 'cCbBtTEedDXxLlIiJj1') .eq. 0) goto 200
    	   if (lib$matchc( choice, 'tT') .gt. 0) invocation = '%fms/tran '
    	   if (lib$matchc( choice, '1') .gt. 0) invocation = 
     +	     '%fms/desc/disp=esc '
    	   if (lib$matchc( choice, 'jJIi') .gt. 0) then
    	     call writel('Enter the library name: ', 15,5)
    	     call kbdname (library, stat)
	     stat = lib$matchc ( ' ', library)
	     if (lib$matchc( choice, 'Ii') .gt. 0) then      
	       invocation = '%fms/lib '//library(1:stat)
	     else
	       invocation = '%fms/lib/create '//library(1:stat)
	     end if
    	   end if
    	   if (lib$matchc( choice, 'Ll') .gt. 0)
     -                               invocation = '%fms/tran'//'/lis '
    	   if (lib$matchc( choice, 'Ee') .gt. 0) invocation = '%fms/edit '
    	   if (lib$matchc( choice, 'Dd') .gt. 0) invocation = '%fms/desc '
    	   if (lib$matchc( choice, 'Bb') .gt. 0) then 
             invocation = '%fms/descr/brief '
	   end if
    	   if (lib$matchc( choice, 'cC') .gt. 0) then
	     invocation = '%fms/descr/brief/output='//
     -	     tempname(1:semi-1)//'.LIS '
	   end if
    	   if (lib$matchc( choice, 'cCbBIijJEedDtTLl1') .gt. 0) then
    	     return_choice = 'E' !returns you directtly to DMM after doing 
    				 !command
      	   else
    	     return_choice = 'D' !stops and asks for a keystroke for desc/brief
   	   end if
    	   if (lib$matchc( choice, 'xX') .eq. 0) then
	     stat = lib$matchc ( '  ', invocation)
             Exit_Com = invocation(1:stat+1)//Tempxx
c		print *, exit_com, ' here '
c		call get1char (choice)
             Call Save_Stack(return_choice)  ! save stuff and say I'm at DCL level
    	     Call Writel(LargeScreen, 21, 1) !The cursor is stuck on the last
             Call Writel(Reterminal, 22, 1)  !two lines, release the terminal
    	     call writel(epage, 1, 1) 	     !so the fms output can scroll
    	     call writel(' ', 23, 5)
   	   else !for X - leave with nothing done
    	     call write24
    	     exit_flag = 0
    	   end if ! pick an option X or other
	 end if !fms
C-------------------------------------------------------------------C
C EDT section
C-------------------------------------------------------------------C
    	 if (Lib$matchc(what_function, 'Ee' ) .gt. 0) then
    	   choice = 'y'
    	   Exit_Flag = 1 ! Going to edit - startover when return
           Semi = Lib$Matchc(';',TempName)
           Tempxx = TempName(1:Semi+5)
           Tempxx(Semi+6 : 79) = ' '
    	   file_name_extension = tempname (semi-3:semi-1)
    	   if (Lib$matchc(file_name_extension, 
     -       'EXE-OLB-OBJ-FRM-FLB' ) .gt. 0) then
    	     choice = 'n'
    	     call mess('Do you really want to EDIT this file???')
    	     call get1char(choice)
    	   end if
    	   if (lib$matchc( choice, 'Yy') .gt. 0) then
	     Exit_Com = '%edt '//Tempxx
             Call Save_Stack('E') ! save stuff and say I'm editing
    	   else
    	     exit_flag = 0
    	   end if 
	 end if !edt
C-------------------------------------------------------------------C
C BASIC Section
C-------------------------------------------------------------------C
    	 if (Lib$matchc(what_function,  'Bb') .gt. 0) then
             Semi = Lib$Matchc('.',TempName)
             Tempxx = TempName(1:Semi-1)
             Tempxx(Semi : 79) = ' '
    	     file_name_extension = tempname (semi+1:semi+3)
    	   if (lib$matchc (file_name_extension, 'BAS-FOR-PAS') .eq. 0) then
    		choice = 'X'
    		goto 1300
    	   end if
    	   Exit_Flag = 1 ! Going to basic - startover when return
    	   Call Writel(epage, 1,1)
1200	   Call Writel(
     -		'  Loading COMPILER with '//bright//tempxx(1:semi-1)
     -		//'.'//file_name_extension//dull, 1, 1)
    	   Call Writel('T = TBCOMP           		  ', 3,5)
    	   Call Writel('U = TBCOMP file XX		  ', 4,5)
    	   Call Writel('L = CC /noobj/List=[]		  ', 5,5)
    	   Call Writel('C = CC /noobj	       		  ', 6,5)
    	   Call Writel('B = Build			  ',  7,5)
    	   Call Writel('O = obj				  ',  8,5)
    	   Call Writel('r = r [xxx.exe] file		  ',  9,5)
    	   Call Writel('4 = pascal/env/noobj file	  ',  10,5)
    	   Call Writel('5 = cc file			  ',  11,5)
    	   Call Writel('6 = ll file			  ',  12,5)
    	   Call Writel('7 = cc file e			  ',  13,5)
    	   Call Writel('8 = cc file l			  ',  14,5)

    	   Call Writel('X = Change your mind and return to DMM', 16,5)
    	   Call Writel('Please pick one -- (TULBCOR567X)  ', 17,5)
    	   call get1char(choice)

    	   if (lib$matchc( choice, 'TtuULlBbCcOoxXrR45678') .eq. 0)
     -	     goto 1200
    	   if (lib$matchc( choice, 'rR') .gt. 0) then
             call sys$setdDir(%val(0), %val(0), invocation) !get default dir
	     stat = lib$matchc( ']', invocation)
             invocation( stat - 3: stat - 1) = 'EXE'
             invocation = '% R '//invocation(1:stat)//tempxx
c	     print *, invocation
           end if
    	   if (lib$matchc( choice, 'uUtT') .gt. 0) invocation = '% tbcomp '
    	   if (lib$matchc( choice, '4') .gt. 0)
     -	     invocation = '% pascal/envir/noobj '
    	   if (lib$matchc( choice, 'lLcC578') .gt. 0) 
     -       invocation = '% cc  '
    	   if (lib$matchc( choice, 'Oo') .gt. 0) invocation = 'obj '
    	   if (lib$matchc( choice, '6') .gt. 0)
     -                               invocation = '% ll '
    	   if (lib$matchc( choice, 'Bb') .gt. 0) 
     -       invocation = '% build '
c
    	   return_choice = 'E' !returns you directtly to DMM after doing 
   			       !command
1300   	   if (lib$matchc( choice, 'xX') .eq. 0) then
	     stat = lib$matchc ( '   ', invocation)
c	     print *, stat
	     if (lib$matchc( choice, 'rR') .eq. 0) then
               Exit_Com = invocation(1:stat)//Tempxx
	     else
	       Exit_Com = invocation
	     end if
c	     print *, exit_com, '---here'
czzzzz
C------------- add suffixes to U, C, L and 5, and 7 -------------------
	     stat = lib$matchc ( '   ', exit_com)
    	     if (lib$matchc( choice, 'Ll') .gt. 0) then
     	       exit_com( stat+1: stat+2) = ' KN'
	     end if
   	     if (lib$matchc( choice, 'cC') .gt. 0) then
     	       exit_com( stat+1: stat+2) = ' N'
	     end if
    	     if (lib$matchc( choice, '7') .gt. 0) then
     	       exit_com( stat+1: stat+2) = ' E'
	     end if
    	     if (lib$matchc( choice, '8') .gt. 0) then
     	       exit_com( stat+1: stat+2) = ' L'
	     end if
    	     if (lib$matchc( choice, 'uU') .gt. 0) then
     	       exit_com( stat+1: stat+2) = ' xx'
	     end if
c	     print *, exit_com, '---here'
c	     call get1char (choice)
             Call Save_Stack(return_choice) ! save stuff and say I'm at DCL level
    	     Call Writel(LargeScreen, 21, 1) !The cursor is stuck on the last
             Call Writel(Reterminal, 22, 1)  !two lines, release the terminal
    	     call writel(epage, 1, 1) 	     !so the fms output can scroll
    	     call writel(' ', 23, 5)
   	   else
    	     call write24
    	     exit_flag = 0
    	   end if 
	end if !call basic compiler
C-------------------------------------------------------------------C
C COM file section
C-------------------------------------------------------------------C
    	 if (Lib$matchc(what_function, '@' ) .gt. 0) then
    	   Exit_Flag = 1 ! Going to edit - startover when return
           Semi = Lib$Matchc(';',TempName)
           Tempxx = TempName(1:Semi+5)
           Tempxx(Semi : 70) = ' '
    	   file_name_extension = tempname (semi-3:semi-1)
    	   if (file_name_extension .eq. 'COM') then
             Call Writel(epage//'  Running Com File . . . ', 1, 1)
             Exit_Com = ' @ '//Tempxx
             Call Save_Stack('D') ! save stuff and say I'm at the DCL level
   	   else
    	     exit_flag = 0
    	   end if
    	 end if !com file section
       Return 
       End
