FUNCTION JJCMD( CMD ) c. Returns the input command to the user c. c.OUT: JJCMD <=I= the number of characters in the input. (-1:EOF) c. c.i/o CMD <=C= User Input c. (1) From DCL Command line, If None and CMD.gt.' ' c. (2) From User Input (UNIT=5). If Input = @FILE, then c. (3) From FILE c. c.Goodies: $DCL_line ... Insues the command via LIB$CMD c. @File .. Reads the file (from unit 99, 98...) c. CMD = '~ONE~' .. Accept one line from CMD and exit c. c. COMMON/JJ_CMD/ JJ_TY !!= 1:CMD, 2:User, 3:File c. Set <0 after call for no User input c. c.Uses: LIB$GET_FOREIGN, JJDCL, JJLEN c. c.Rev: 11/07/82 Use JJUNAM to process @.nnn c.Rev: 06/15/80 Use Unit=5 For input c------------------------------------------------------------end.of.info common /JJ_CMD/ JJ_TY character CMD*(*), prstr*(132) data iunit/100/, is1cmd/0/ 41 format(132a) 49 format(q,132a) c. if( CMD.eq.'~ONE~' ) then is1cmd = 1 goto 9000 endif JJCMD = 0 prstr = CMD c. c... Get the next input c. 1000 continue c. c... Foreign input c. if( is1cmd.eq.1 .and. JJ_TY.eq.1 ) goto 8000 if( JJ_TY.eq.0 ) then !!First try JJ_TY = 2 call lib$get_foreign( CMD,,JJCMD ) if( JJCMD.eq.0 ) goto 1000 JJ_TY = 1 c. c... User input c. else if( JJ_TY.le.2 ) then if( prstr.le.' ' ) goto 8000 !!>> No user prompt type 41,prstr(1:jjlen(prstr)),' ' read(5,49,end=8000) JJCMD, CMD c. c... File input c. else if( JJ_TY.eq.3 ) then read( iunit, 49, end=1900 ) JJCMD, CMD else goto 8000 endif goto 2000 c. .... c. c... E.O.F. on file input c. 1900 continue close( unit=iunit ) iunit = iunit+1 if( iunit.ge.100 ) JJ_TY = jjsave goto 1000 !!>> retry next level c. c... $ and @ command processing c. 2000 continue if( CMD(1:1).eq.'$' ) then c. c... $DCL_command ... Issue a DCL command c. call jjdcl( CMD(2:) ) goto 1000 c. .... else if( CMD(1:1).eq.'@' ) then c. c... @file_name ... Open an indirect file c. if( iunit.eq.100 ) jjsave = JJ_TY iunit = iunit-1 if( cmd(2:2).eq.'.' ) call JJUNAM(cmd(2:)) open(unit=iunit,type='old',readonly,name=CMD(2:),err=2900) JJ_TY = 3 goto 1000 !!>> Start on next LOWer level endif goto 9000 !!>> return c. ---- c... Illegal file name c. 2900 continue type *,'Can''t open ',CMD(1:jjlen(CMD)) iunit = iunit+1 if( iunit.ge.100 ) JJ_TY = 2 goto 1000 !!>> retry next level c. c. c... Return an E.O.F. c. 8000 continue JJCMD = -1 CMD = '^Z' c. 9000 continue return end PROGRAM ZTEST c. c.test progrram for JJCMD c. common /JJ_CMD/ JJ_TY, iunit character*40 CMD call jjcmd('~ONE~') c. 1000 continue CMD = '$JJCMD:' iret = JJCMD(CMD) type*,iret,' =JJCMD',JJ_TY,' =JJ_TY',iunit,' =Unit --',CMD if( iret.ge.0 ) goto 1000 c. end