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.Dat' C-------------------------------------------------------------------C Call GetName(Ld(TopLine+CursorLine-1),TempName, Type) Exit_Flag = 0 ! Assume don't start over If (Type .EQ. 0) Then ! 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+5) Tempxx(Semi : 79) = ' ' file_name_extension = tempname (semi-3:semi-1) Exit_Flag = 1 ! Going to fms - startover when return Call Writel(epage, 1,1) 200 Call Writel(' Loading FMS with '//tempxx, 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('E = Edit (FRM file )', 7,5) Call Writel('I = Insert in LIB (FRM file )', 8,5) Call Writel('X = Change your mind and return to DMM', 10,5) Call Writel('Please pick one -- (TLDBEIX) ', 12,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, 'BbDdEeIi') .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, 'bBtTEedDXxLlIi') .eq. 0) goto 200 if (lib$matchc( choice, 'tT') .gt. 0) invocation = 'fms/tran ' if (lib$matchc( choice, 'Ii') .gt. 0) then call writel('Enter the library name: ', 14,5) call kbdname (library, stat) stat = lib$matchc ( ' ', library) invocation = 'fms/lib '//library(1:stat) 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) - invocation = 'fms/descr/brief ' c if (lib$matchc( choice, 'IiEedDtTLl') .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 call write24 exit_flag = 0 end if !call fms ? C-------------------------------------------------------------------C C EDT section C-------------------------------------------------------------------C else 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 : 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 Call Writel(epage//' Loading EDT . . . ', 1, 1) Exit_Com = ' edt '//Tempxx Call Save_Stack('E') ! save stuff and say I'm editing else exit_flag = 0 end if C-------------------------------------------------------------------C C BASIC Section C-------------------------------------------------------------------C if (Lib$matchc(what_function, 'Bb') .gt. 0) then Semi = Lib$Matchc(';',TempName) Tempxx = TempName(1:Semi+5) Tempxx(Semi : 79) = ' ' file_name_extension = tempname (semi-3:semi-1) Exit_Flag = 1 ! Going to basic - startover when return Call Writel(epage, 1,1) 1200 Call Writel(' Loading BASIC with '//tempxx, 1, 1) Call Writel('T = TBCOMP ', 3,5) Call Writel('L = Compile and List ', 4,5) Call Writel('B = Build ', 5,5) Call Writel('O = obj ', 6,5) Call Writel('C= Build xx F (fortran) ', 7,5) Call Writel('P = obj xx F (fortran) ', 8,5) Call Writel('X = Change your mind and return to DMM', 10,5) Call Writel('Please pick one -- (TLBOX) ', 12,5) call get1char(choice) if ((file_name_extension .NE. 'BAS') call writel('Incompatible Choice!',23,5) goto 1200 end if if (lib$matchc( choice, 'bBtTXxLlOo') .eq. 0) goto 200 if (lib$matchc( choice, 'tT') .gt. 0) invocation = 'fms/tran ' if (lib$matchc( choice, 'Ii') .gt. 0) then call writel('Enter the library name: ', 14,5) call kbdname (library, stat) stat = lib$matchc ( ' ', library) invocation = 'fms/lib '//library(1:stat) 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) - invocation = 'fms/descr/brief ' c if (lib$matchc( choice, 'IiEedDtTLl') .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 call write24 exit_flag = 0 end if !call basic compiler C-------------------------------------------------------------------C C COM file section C-------------------------------------------------------------------C else 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 ! E or F or @ calls to DCL Else Call Showit ! do show on directory when E, F, or @ is hit by mistake on ! a directory End If Return End