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') .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 BASIC with '//bright//tempxx(1:semi-1) - //'.'//file_name_extension//dull, 1, 1) Call Writel('T = TBCOMP ', 3,5) Call Writel('U = TBCOMP XX ', 4,5) Call Writel('L = Compile /noobj/List ', 5,5) Call Writel('C = Compile /noobj ', 6,5) Call Writel('B = Build ', 7,5) Call Writel('O = obj ', 8,5) Call Writel('1 = Build xx F (fortran) ', 9,5) Call Writel('2 = obj xx F (fortran) ', 10,5) Call Writel('3 = compile/noobj (fortran) ', 11,5) Call Writel('4 = compile/noobj/list (fortran) ', 12,5) Call Writel('r = r [xxx.exe] file ', 13,5) Call Writel('5 = cc file ', 14,5) Call Writel('6 = ll file ', 15,5) Call Writel('7 = cc file e ', 16,5) Call Writel('X = Change your mind and return to DMM', 18,5) Call Writel('Please pick one -- (TULBOR1234567X) ', 19,5) call get1char(choice) if (lib$matchc( choice, 'TtuULlBbCcOo1234xXrR567') .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, 'cC') .gt. 0) - invocation = '% basic/noobj ' if (lib$matchc( choice, '2Oo') .gt. 0) invocation = 'obj ' if (lib$matchc( choice, 'Ll') .gt. 0) - invocation = '% basic/lis/noobj ' if (lib$matchc( choice, '3') .gt. 0) - invocation = '% fortran/noobj ' if (lib$matchc( choice, '4') .gt. 0) - invocation = '% fortran/lis/noobj ' if (lib$matchc( choice, '5') .gt. 0) - invocation = '% cc ' if (lib$matchc( choice, '6') .gt. 0) - invocation = '% ll ' if (lib$matchc( choice, '7') .gt. 0) - invocation = '% cc ' if (lib$matchc( choice, '1Bb') .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' C------------- add suffixes to U and 1 and 2 and 7 --------------------------- stat = lib$matchc ( ' ', exit_com) if (lib$matchc( choice, '12') .gt. 0) then exit_com( stat+1: stat+2) = ' f' end if if (lib$matchc( choice, '7') .gt. 0) then exit_com( stat+1: stat+2) = ' e' 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