PROGRAM LZYCLI C****************************************************************************** C * C Abstract: Lazy man's CLI - Keeps last 23 commands for reuse * C * C Author..: W. E. Crocker Date.: 22-AUG-86 * C National Steel Corp. * C Granite City Division * C 20th and State Streets * C Granite City, IL. 62040 * C (618) 451-3371 * C * C Revision: Add VMS style symbols * C * C Author..: W. E. Crocker Date.: 20-APR-88 * C * C OpSystem: RSX-11M-Plus /V3.0.C/ Computer.: PDP-11/44 * C * C Language: Fortran-77 /V5.0.16/ Compiler.: ...F77 * C * C Filename: LB00:[7,64]LZYCLI.TSK Installed Task * C $OLB: -none- Object Library * C $ULB: -none- Source Library * C $ODL: -none- Overlay Descriptor * C $BLD: -none- Build Options * C $DEF: -none- Common Definitions * C ==> $MAIN: LB00:[GCSSRC]LZYCLI.FTN Main Source * C Subroutine Sources * C $SUBn: -none- Subroutine Function * C * C****************************************************************************** C * C** IMPLICIT NONE ! You MUST define all parameters & variables * IMPLICIT COMPLEX*8 (A-Z) ! * C * C****************************************************************************** C**** Include the definition file with the filename in it INCLUDE 'LZYDEF.DEF/LIST' C**** Program Local Parameter and Variable Definition(s) C** The following variables are needed for the bare-bones CLI REAL*4 RDCL ! DCL TASK NAME IN RAD50 INTEGER*4 IOFSCB ! Offspring control block from parent INTEGER*2 ICMBFL ! Command buffer length INTEGER*2 IOBLEN ! Option information buffer len INTEGER*2 ICMDLN ! # chars in cmd line INTEGER*2 IGRPNX ! Index into info buffer for the Group & member INTEGER*2 IUNIT ! I*2 Unit # of device INTEGER*2 INOCHR ! I*2 Number of characters INTEGER*2 IGRP ! UIC group for RPOI INTEGER*2 IMEM ! member INTEGER*2 IGCCCS ! Masks indicating action to take if INTEGER*2 IGCCEX ! no commmand queued INTEGER*2 IGCCST ! (see Exec. Ref on GCCI$) INTEGER*2 IGCCND INTEGER*2 ICMELM ! CLI messages from system INTEGER*2 ICMEXT ! (see System Managment Guide on CLIs) INTEGER*2 ICMLKT INTEGER*2 ICMRMT BYTE BCMDBF(264) ! Command buffer - 1 byte extra for I*2 boundry BYTE BNOCHR ! # of chars returned (note: the # of C*** chars. returned is not necessarily the # in the command line. BYTE BUNIT ! Terminal unit # BYTE BCMMND(255) ! CMD BYTE BOPTBF(14) CHARACTER*2 ADEVTP ! ASCII device type (i.e. "TT") CHARACTER*255 ACMMND ! Char. version of command EQUIVALENCE (ADEVTP, BCMDBF(1)), (BUNIT ,BCMDBF(3)), 1 (BNOCHR, BCMDBF(4)), (ICMDLN,BCMDBF(5)), 1 (BCMMND, BCMDBF(9)) EQUIVALENCE (BCMMND, ACMMND ) EQUIVALENCE (IOFSCB, BOPTBF(7)) C**** Program variable initialization DATA ICMBFL /263/ ! 8 bytes + max length of 255. DATA IOBLEN /14/ ! Length of BOPTBF DATA IGRPNX /9/ ! UIC offset DATA RDCL /6R...DCL/ ! DCL task name DATA IGCCCS /0/ ! INCP VALUES IN GTCMCI DATA IGCCEX /1/ DATA IGCCST /2/ DATA IGCCND /128/ DATA ICMELM /5/ ! CLI messages from system DATA ICMEXT /6/ DATA ICMLKT /7/ DATA ICMRMT /8/ C*** The variables for the user written portion of the CLI goes here INTEGER*2 HNOCMD ! # of commands to keep PARAMETER (HNOCMD = 23 ) INTEGER*2 DAT ! Data file LUN PARAMETER (DAT = 3) BYTE BBUFER(80) ! Buffer in which to generate commands BYTE BTTBUF (10) ! Input buffer while editing (only using 1 byte) BYTE BINCHR ! Input character BYTE BFILBF ( 2048 ) ! File buffer BYTE BESC ! INTEGER*2 IMOVTO ! Move to location function (see bottom) INTEGER*2 ILSTCM ! Last command pointer INTEGER*2 INXPTR ! Next table pointer INTEGER*2 ITABLE(16) ! Terminating Table INTEGER*2 IPARM(6) ! Parameters needed by QIO INTEGER*2 ILEN ! Length of string INTEGER*2 IESCFL ! Escape sequence flag INTEGER*2 ICOL ! Current column # INTEGER*2 IMODE ! Overstrike or insert mode INTEGER*2 INWLEN ! New length when deleting words INTEGER*2 INDX ! Misc. indexing variable INTEGER*2 IDS ! Directive status return INTEGER*2 ISB ( 2) ! I/O Status Buffer in words BYTE BSB ( 4) ! I/O Status Buffer in bytes EQUIVALENCE ( ISB(1), BSB(1) ) CHARACTER*80 ACMDLS (HNOCMD) ! Command list CHARACTER*9 ASYMBL ( 4) ! Symbols BYTE BSYMLN ( 4) ! Symbol length CHARACTER*40 AEQVST ( 4) ! Equivalence string BYTE BEQVLN ( 4) ! Equivalence string length CHARACTER*9 ANWSYM ! New symbol CHARACTER*40 ANWEQV ! equivalence string INTEGER*2 INWSYL ! New symbol length INTEGER*2 INWEQL ! equivalence length INTEGER*2 IBGSYM ! Beginning of symbol in command line INTEGER*2 ITEMP ! Temporary variable INTEGER*2 IOLNCH ! # of chars. in command line before symbol subst. INTEGER*2 IOFSET ! Offset used when a symbol is followed by ':' INTEGER*2 ILOOP ! Loop counter for safety CHARACTER*80 ABUFER ! Command line building scratchpad CHARACTER*160 ATEMP ! Temporary buffer for , insert & symbol substitution CHARACTER*26 AFILNM ! File containing old commands CHARACTER*1 AINCHR ! Input character CHARACTER*1 ANULL ! Null character EQUIVALENCE (BTTBUF(1), BINCHR) EQUIVALENCE (BTTBUF(1), AINCHR) EQUIVALENCE (BFILBF(1), ACMDLS(1) ) EQUIVALENCE (BFILBF(HNOCMD*80+ 1), ILSTCM ) EQUIVALENCE (BFILBF(HNOCMD*80+ 5), ASYMBL(1) ) EQUIVALENCE (BFILBF(HNOCMD*80+41), BSYMLN(1) ) EQUIVALENCE (BFILBF(HNOCMD*80+45), AEQVST(1) ) EQUIVALENCE (BFILBF(HNOCMD*80+205), BEQVLN(1) ) EQUIVALENCE (BBUFER(1), ABUFER ) DATA ITABLE /"020002,"002000,5*0,"100000, ! Terminate on , 1 "020002,"002000,5*0,"100000/ ! , in 7 ! bit or 8 bit mode. DATA ANULL(1:1) /"00/ DATA INWEQL /-1/ ! Used as an indicator ! to prevent sending define symbol commands to DCL DATA BESC /"33/ C**** Program Entry CALL ERRSET (39,,.FALSE.,.TRUE.,.FALSE.,) ! Disable input fmt errmsg ! If creating new command file 1 CALL GTCMCI(BCMDBF,ICMBFL,BOPTBF,IOBLEN,0,IGCCEX,IDS) ! GET CMD FOR CLI IF (IDS .LT. 0) GO TO 1000 C C IF THE GTCMCI DIRECTIVE HAD THE GC.CST OPTION SPECIFIED, WE MAY HAVE C JUST BEEN UNSTOPPED, SO WE HAVE TO GET THE COMMAND. C IF (IDS .EQ. 0) GO TO 1 ! Were we just unstopped? IF (ADEVTP(1:1) .LT. ' ') GO TO 2000 ! Is this a system message? IUNIT= BUNIT ! Convert byte to integer (unit #) CALL ASNLUN(5,ADEVTP,IUNIT,IDS) ! Assign terminal to lun 5 INOCHR=BNOCHR ! Convert byte to integer IF (INOCHR .GE. 0) GO TO 5 INOCHR = 256 + BNOCHR ! Convert negative to unsigned 5 IF (INOCHR .LT. ICMDLN) GOTO 1050 ! Did entire command fit in buffer? C C*** We have a command. Lets do something with it! C AFILNM(1:04) = 'LZ0:' ! Create filename AFILNM(5:15) = ADIRCT(1:11) AFILNM(16:17) = ADEVTP(1:2) WRITE (AFILNM(18:26), 9002) IUNIT 9002 FORMAT (O2.2,'CMD.DAT') OPEN ( UNIT = DAT, 1 FILE = AFILNM(1:26), 2 STATUS = 'UNKNOWN', 3 ACCESS = 'DIRECT', 4 RECL = 512, 5 MAXREC = 1, 9 ERR = 2050) READ (DAT'1,ERR=900) BFILBF ! Read in record INXPTR = ILSTCM ! Retrieve last command ptr ILEN = -1 ! If still a -1 at line 900, ! recall mode was not entered C*** Do we want to enter command line editing mode? TTDRV will strip off C*** the leading . 40 IF ((BCMMND(1) .EQ. "133) .AND. (BCMMND(2) .EQ. "101)) THEN CALL GETADR( IPARM, BTTBUF ) ! Setup for the QIO IPARM(2) = 1 ! IPARM(3) = 3 ! CALL GETADR( IPARM(4), ITABLE ) CALL WTQIO( "1400, 5, 1, , BSB, , IDS ) ! Attach to terminal WRITE (5,9910) BESC ! Shift to alt. keypad mode IESCFL = 0 ! Clear escape sequence flag IMODE = 0 ! Assume overstrike mode WRITE (5, 9901) ! Clear a line on the screen 50 ICOL = 1 ! Start at column 1 DO 54 ILEN = 80, 1, -1 ! Find length of command IF (ACMDLS(INXPTR)(ILEN:ILEN) .NE. ' ') GOTO 56 ! Found the last char. of command 54 CONTINUE ILEN = 80 ! I don't know how long it is!! 56 ABUFER(1:) = ACMDLS(INXPTR)(1:80) ! Save in local storage 58 IDS = IMOVTO (23, ICOL) ! Display command WRITE (5, 9080) ABUFER(ICOL:80) IDS = IMOVTO (23, ICOL) ! Position cursor GOTO 99 60 IDS = IMOVTO (23, ICOL) ! Display command 62 WRITE (5, 9081) ABUFER(ICOL:ILEN) 64 IDS = IMOVTO (23, ICOL) ! Position cursor 99 BINCHR = 0 CALL WTQIO( "5021, 5, 1, , BSB, IPARM, IDS ) IF (BSB(2) .EQ. "32) THEN ! Process CLOSE (UNIT=DAT) WRITE (5, 9912) BESC ! Exit alt keypad mode GOTO 1 ENDIF IF (BSB(2) .EQ. "15) THEN ! Process 81 INOCHR = ILEN ACMMND(1:ILEN) = ABUFER(1:ILEN) WRITE (5, 82) 82 FORMAT (' ') GOTO 900 ENDIF IF (BSB(2) .EQ. "01) THEN ! Toggle insert/overstrike mode IMODE = IMODE .XOR. "1 GOTO 99 ENDIF C [ Arrow Keypd Esc [ Keypd GOTO ( 200, 300, 400, 500, 600, 700) IESCFL ! Esc, "[" 100 IF (BINCHR .EQ. "33) THEN ! Process arrows or ? IESCFL = 1 GOTO 99 ENDIF IF ( BSB(2) .EQ. "177) THEN ! Is it a delete? IF (ICOL .EQ. 1) GOTO 99 ! Nothing to the left of col. 1 ATEMP(ICOL:ILEN) = ABUFER(ICOL:ILEN)! Save in temp. buffer ABUFER(ICOL-1:ILEN-1) = ATEMP(ICOL:ILEN)! Shift it over one byte ABUFER(ILEN:ILEN) = ' ' ! Step on last char ICOL = ICOL -1 ! Move to the left ILEN = ILEN -1 ! Shorten the string GOTO 58 ! Display whats left ENDIF IF (BINCHR .LT. "40) GOTO 99 ! Displayable character? C*** SUBSTITUTE NEW CHARACTER IF (IMODE .EQ. 1) THEN ! Insert mode? ATEMP(ICOL:ILEN)= ABUFER(ICOL:ILEN) ! push things over one byte ABUFER(ICOL+1:ILEN+1)= ATEMP(ICOL:ILEN) ! push things over one byte ILEN = ILEN + 1 ! The string gets longer, IF (ILEN .GT. 80) ILEN = 80 ! but lets not get too long. ENDIF ! or overstrike? ABUFER(ICOL:ICOL) = AINCHR ! Get character WRITE (5, 9084) BESC, ICOL, AINCHR ! Show character ICOL = ICOL + 1 ! Move over one column IF (ICOL .GT. ILEN) ILEN = ICOL ! Stretch 'er out IF (IMODE .EQ. 1) GOTO 60 GOTO 64 ! Redisplay current command 200 IF (BINCHR .EQ. '[') THEN ! More of the arrow? IESCFL = 2 GOTO 99 ENDIF IF (BINCHR .EQ. 'O' ) THEN ! Or something from the keypad? IESCFL = 3 GOTO 99 ENDIF IESCFL = 0 ! Neither one GOTO 99 300 IESCFL = 0 ! Clear escape flag GOTO (302, 304, 306, 308) BINCHR-"100 ! Branch based on which arrow GOTO 99 ! All else 302 INXPTR = INXPTR - 1 ! Backup one command IF (INXPTR .LT. 1 )INXPTR = HNOCMD GOTO 50 ! Go show next command 304 INXPTR = INXPTR + 1 ! Forward one command IF (INXPTR .GT. HNOCMD )INXPTR = 1 GOTO 50 ! Go show next command 306 IF (ICOL .GE. 80) GOTO 99 ! Can't go past column 80 ICOL = ICOL + 1 ! To the right one column IF (ICOL .GT. ILEN) THEN ! At the end of the command? ILEN = ICOL ! Increment its length ABUFER(ICOL:ICOL) = ' ' ! Space fill ENDIF GOTO 64 308 ICOL = ICOL - 1 ! To the left one column IF (ICOL .LT. 1) ICOL = 1 GOTO 64 400 IF (BINCHR .EQ. 'P') THEN ! PF1 or Gold key? IESCFL = 4 GOTO 99 ENDIF 405 IESCFL = 0 ! Clear escape flag IF (BINCHR .EQ. 'l') THEN ! Del char? ( , ) IF (ICOL .EQ. ILEN) THEN ! Can't delete past the end ABUFER(ILEN:ILEN) = ' ' ! Step on last char GOTO 58 ENDIF ABUFER(ICOL:ILEN-1) = ABUFER(ICOL+1:ILEN)! Shift over ABUFER(ILEN:ILEN) = ' ' ! Step on last char ILEN = ILEN -1 ! Shorten the string GOTO 58 ! Display whats left ENDIF 410 IF (BINCHR .EQ. 'm') THEN ! Del word? ( - ) DO 414 INDX = ICOL, ILEN ! Search for the next space IF (( ABUFER(INDX:INDX) .EQ. ' ' ) .OR. ! or 1 ( BBUFER(INDX) .EQ. "11 )) GOTO 415 414 CONTINUE ABUFER(ICOL:ILEN) = ' ' ! None found - clear to EOL ILEN = ICOL GOTO 58 ! Display whats left 415 INWLEN = ILEN-INDX+ICOL-1 ! New length of command line ABUFER(ICOL:INWLEN) = ABUFER(INDX+1:ILEN) ! Shift chars ABUFER(INWLEN+1:ILEN) = ' ' ! Step on shifted chars ILEN = INWLEN ! Shorten the string GOTO 58 ! Display whats left ENDIF 420 IF (BINCHR .EQ. 'p') THEN ! BOL? ( 0 ) ICOL = 1 ! Back to column 1 GOTO 64 ! Reposition cursor ENDIF 430 IF (BINCHR .EQ. 'r') THEN ! EOL? ( 2 ) 432 ICOL = ILEN ! To EOL IF ((ABUFER(ICOL:ICOL) .NE. ' ') .AND. ! Go one extra space if 1 (ILEN .LT. 80)) THEN ! the last character is not ICOL = ILEN + 1 ! a space ILEN = ILEN + 1 ENDIF GOTO 64 ! Reposition cursor ENDIF 440 IF (BINCHR .EQ. 'M') GOTO 81 ! ? 450 IF (BINCHR .EQ. 'q') THEN ! Next Word? ( 1 ) DO 454 INDX = ICOL, ILEN-1 ! Search for the next space IF (( ABUFER(INDX:INDX) .EQ. ' ' ) .OR. ! or 1 ( BBUFER(INDX) .EQ. "11 )) GOTO 455 454 CONTINUE GOTO 432 ! None found, go to EOL 455 ICOL = INDX + 1 ! Move to start of next word GOTO 64 ! Reposition cursor ENDIF GOTO 64 ! Anything else 500 IF (BINCHR .EQ. "33) THEN ! Another escape IESCFL = 5 GOTO 99 ENDIF IESCFL = 0 ! No GOTO 99 600 IF (BINCHR .EQ. 'O' ) THEN ! Something from the keypad? IESCFL = 6 GOTO 99 ENDIF IESCFL = 0 ! No GOTO 99 700 IESCFL = 0 ! Gold what? 710 IF (BINCHR .EQ. 'r') THEN ! Del to EOL? ( PF1 2 ) ABUFER(ICOL:ILEN) = ' ' ! Clear to EOL ILEN = ICOL GOTO 58 ! Display whats left ENDIF IESCFL = 0 ! ??? GOTO 99 ENDIF ! End of edit mode IF THEN C*** Do we want to show all commands? IF ((BCMMND(1) .EQ. "133) .AND. (BCMMND(2) .EQ. "102)) THEN DO 550 INDX = 1, HNOCMD ! Spit 'em all out WRITE (5, 9980) INDX, ACMDLS(INXPTR)(1:77) INXPTR = INXPTR - 1 ! Decrement pointer IF (INXPTR .LT. 1) INXPTR = HNOCMD ! Adj for wrap-around 550 CONTINUE CLOSE (UNIT=DAT) GOTO 1 ENDIF C*** Recall a command IF ((ACMMND(1:2) .GE. '01') .AND. (ACMMND(1:2) .LE. '23')) THEN READ (ACMMND(1:2), 9012) INXPTR INXPTR = ILSTCM - INXPTR + 1 IF (INXPTR .LT. 1) INXPTR = INXPTR + HNOCMD BCMMND(1) = "133 ! Setup for edit mode BCMMND(2) = "101 GOTO 40 ENDIF C*** Display symbols? 800 IF ((BCMMND(1) .EQ. "133) .AND. (BCMMND(2) .EQ. "104)) THEN WRITE (5, 9920) ! Symbol header line DO 809 INDX = 1, 4 ! Show current symbols WRITE (5, 9922) INDX, ASYMBL(INDX)(1:9), AEQVST(INDX)(1:40) 809 CONTINUE CLOSE (UNIT=DAT) GOTO 1 ENDIF C** Skip over define symbol section GOTO 900 C** Define or delete a symbol (branch from INDEX function above) 820 ANWSYM(1: 9) = ACMMND(1:ICOL-1) ! New symbol and equivalence string INWSYL = ICOL-1 ! symbol length IF (ICOL+3 .GT. INOCHR) THEN ! Deleting a symbol? (i.e. "C:==") ANWEQV(1:40) = ' ' ! Blank out new eqv. string INWEQL = 0 ! 0 chars long ELSE ANWEQV(1:40) = ACMMND(ICOL+3:INOCHR) ! New eqv. string INWEQL = INOCHR - (ICOL+3) + 1 IF (INWEQL .GT. 40) INWEQL = 40 ! Only have room for 40 chars ENDIF DO 829 INDX = 1, 4 ! Deleting or redefining a symbol? IF (ASYMBL(INDX) .NE. ANWSYM) GOTO 829 ! Matches the old one? AEQVST(INDX)(1:40) = ANWEQV(1:40) ! New equivalence string BEQVLN(INDX) = INWEQL ! New eqv. string length IF (INWEQL .EQ. 0 ) THEN ! Delete symbol? ASYMBL(INDX)(1:) = ' ' ! Clear symbol text BSYMLN(INDX) = 0 ! Zero symbol length ENDIF GOTO 902 ! Go save to disk 829 CONTINUE IF (INWEQL .EQ. 0) THEN ! If eqv. string length is 0, WRITE (5, 9926) ! and we make it here, we couldn't find the symbol to delete. GOTO 902 ENDIF DO 834 INDX = 1, 4 ! Adding a new symbol? IF ((ASYMBL(INDX)(1:1) .NE. ANULL(1:1)) .AND. 1 (ASYMBL(INDX)(1:1) .NE. ' ') ) GOTO 834 ! This slot available? ASYMBL(INDX)(1: 9) = ANWSYM(1:9) ! New symbol & AEQVST(INDX)(1:40) = ANWEQV(1:40) ! equivalence string BSYMLN(INDX) = INWSYL ! symbol length BEQVLN(INDX) = INWEQL ! eqv. string length GOTO 902 ! Go save to disk 834 CONTINUE WRITE (5, 9924) ! No room left GOTO 902 C**** Save the command (only if different from preceding command) C** Is this a define symbol command? 900 ICOL = INDEX (ACMMND(1:12), ':==') ! Search for delimiter IF (ICOL .GE. 2) GOTO 820 ! 902 IF (ACMMND(1:INOCHR) .NE. ACMDLS(ILSTCM)(1:INOCHR) ) THEN INXPTR = ILSTCM + 1 ! New pointer IF (INXPTR .GT. HNOCMD) INXPTR = 1 ! Adjust for wrap-around ILSTCM = INXPTR ACMDLS(INXPTR) = ACMMND(1:INOCHR) ! Save command ENDIF WRITE (DAT'1) BFILBF CLOSE (UNIT=DAT) IF (ILEN .NE. -1) WRITE (5, 9912) BESC ! Was recall mode entered? ! If so, exit alt keypad mode C** Don't send to DCL if this was a define symbol command IF (INWEQL .NE. -1) GOTO 1 ! Won't be -1 if a symbol was defined. C** Symbol substitution needed? DO 929 INDX = 1, 4 ! 4 symbols to look at IF (BSYMLN(INDX) .EQ. 0 ) GOTO 929 ! Symbol defined? IBGSYM = 0 ILOOP = 0 910 IBGSYM = IBGSYM + 1 ! Move over 1 char for next search IF (IBGSYM .GT. INOCHR) GOTO 929 ! All the way through the string? CWEC write (5, 909) INOCHR, IBGSYM CWEC 909 FORMAT (' INOCHR: ',I3,' IBGSYM: ',I3) ILOOP = ILOOP + 1 IF (ILOOP .GT. 40) GOTO 2050 ! Safety IDS = INDEX (ACMMND(IBGSYM:INOCHR), 1 ASYMBL(INDX)(1:BSYMLN(INDX)) ) ! See it in here? CWEC WRITE (5, 911) INDX, IDS, IBGSYM, BSYMLN(INDX) CWEC 911 FORMAT (' INDX: ',I2,' IDS: ',I3, 'IBGSYM: ',I3,' BSYMLN: ',I3) IF (IDS .EQ. 0) GOTO 929 ! All done with this symbol? IBGSYM = IBGSYM + IDS - 1 ! No - Found another symbol ITEMP = IBGSYM+BSYMLN(INDX) ! Ptr to char. after symbol IF (IBGSYM .EQ. 1) THEN ! Is symbol in 1st spot? GOTO 912 ELSE GOTO 914 ! No, its further into the command ENDIF 912 IF (BSYMLN(INDX) .EQ. INOCHR) GOTO 920 ! Exact match in command line? IF ((ACMMND(ITEMP:ITEMP) .EQ. ' ') .OR. ! Is symbol terminated by " " or ":"? 1 (ACMMND(ITEMP:ITEMP) .EQ. ':')) GOTO 920 GOTO 910 914 IF (((ACMMND(IBGSYM-1:IBGSYM-1) .EQ. ' ') .OR. ! Preceded by " " or ":"? 1 (ACMMND(IBGSYM-1:IBGSYM-1) .EQ. ':')) .AND. 1 ((ACMMND(ITEMP :ITEMP ) .EQ. ' ') .OR. ! and followed by " " or ":"? 1 (ACMMND(ITEMP :ITEMP ) .EQ. ':') .OR. ! or its the end of line 1 ( ITEMP .GT. INOCHR ))) GOTO 920 GOTO 910 920 IOFSET = 0 ! Assume no ":" trailer IF (ACMMND(ITEMP:ITEMP) .EQ. ':') IOFSET = 1 ! Lets make sure, though IF (ITEMP .LT. INOCHR) ! Save the rest of the command line? 1 ATEMP(ITEMP+IOFSET:INOCHR) = ACMMND(ITEMP+IOFSET:INOCHR) IOLNCH = INOCHR ! Save the length of the existing cammand line ACMMND(IBGSYM:IBGSYM+BEQVLN(INDX)-1) = 1 AEQVST(INDX)(1:BEQVLN(INDX)) ! Substitute the symbol INOCHR = INOCHR + (BEQVLN(INDX) - BSYMLN(INDX)) - IOFSET ! New length IF (ITEMP .LT. IOLNCH) ! Drop the command line back in 1 ACMMND(IBGSYM+BEQVLN(INDX):INOCHR) = ATEMP(ITEMP+IOFSET:IOLNCH) GOTO 910 929 CONTINUE C*** Give it to DCL 945 IGRP = BOPTBF(IGRPNX+1) ! (Convert byte to integer) group IMEM = BOPTBF(IGRPNX) ! Member part of UIC C C ISSUE RPOI$ DIRECTIVE TO EXECUTE COMMAND C CALL RPOI(RDCL,IGRP,IMEM,,BCMMND,INOCHR,,ADEVTP,IUNIT,,IOFSCB,IDS) IF (IDS .LE. 0) GO TO 1010 ! ERROR? GO TO 1 ! BACK TO START C C CONTROL IS TRANSFERED HERE IF UNKNOWN COMMANDS ARE TO BE REJECTED C INSTEAD OF BEING PASSED TO DCL. C 950 WRITE (5,952) 952 FORMAT('0ILLEGAL COMMAND') GO TO 1 ! BACK TO START C C ERROR HANDLING CODE C 1000 WRITE (5,1002) IDS ! ERROR IN GTCMCI 1002 FORMAT('0FATAL ERROR IN GTCMCI DIRECTIVE. DSW=',I6) GO TO 2050 ! EXIT C 1010 WRITE (5,1012) IDS ! ERROR IN RPOI 1012 FORMAT('0FATAL ERROR IN RPOI DIRECTIVE. DSW=',I6) GO TO 2050 ! EXIT C 1050 WRITE (5,1052) ! ENTIRE COMMAND DID NOT FIT IN BUFFER 1052 FORMAT('0SORRY, PART OF YOUR COMMAND WAS LOST') GO TO 1 ! BACK TO START C C A SYSTEM MESSAGE WAS RECEIVED INSTEAD OF A COMMAND C 2000 IF (BUNIT .EQ. ICMLKT) GO TO 2010 ! IS IT A NEW TERMINAL LINKED TO US? IF (BUNIT .EQ. ICMRMT) GO TO 2020 ! IS IT A TERMINAL BEING REMOVED? IF (BUNIT .EQ. ICMEXT) GO TO 2050 ! IS IT AN ELIMINATE ALL PACKET? IF (BUNIT .EQ. ICMELM) GO TO 2050 ! IS IT A CLI ELIMINATION MESSAGE? GO TO 1 ! IGNORE ALL OTHER MESSAGES C C ISSUE WELCOME MESSAGE C 2010 IUNIT = BCMMND(3) ! Convert byte terminal unit # to integer CALL ASNLUN(5,ADEVTP,IUNIT,IDS) ! ASSIGN LUN 5 TO SPECIFIED DEVICE C WRITE (5,2012) C 2012 FORMAT('0WELCOME TO A LAZY MAN''S CLI') GO TO 1 ! BACK TO START C C ISSUE GOOD BYE MESSAGE C 2020 CONTINUE CCC IUNIT = BCMMND(3) ! CONVERT BYTE TERMINAL UNIT # TO INTEGER CCC CALL ASNLUN(5,ADEVTP,IUNIT,IDS) ! ASSIGN LUN 5 TO SPECIFIED DEVICE CCC WRITE (5,2022) CCC 2022 FORMAT('0Catch ya all later') GO TO 1 ! BACK TO START C C WHEN AN ELIMINATE ALL MESSAGE IS RECEIVED, EXIT IMMEDIATELY C 2050 ABUFER(1:) = 'SET TERM TTnn: CLI:MCR' WRITE (ABUFER(12:13), 9022) IUNIT CALL SPAWN (RDCL,IGRP,IMEM,,,BSB,,ABUFER, 22,IUNIT,ADEVTP,IDS) CALL EXIT 9012 FORMAT (I2) 9022 FORMAT (O2.2) 9901 FORMAT (' ') 9910 FORMAT ('+',A1,'=') 9912 FORMAT ('+',A1,'>') 9920 FORMAT (' ',/' ','No. Symbol Equivalence String') 9922 FORMAT (' ',I1,' - ',A9,' - ',A40) 9924 FORMAT (' Symbol creation error - no symbol space available.') 9926 FORMAT (' No symbol match for attempted symbol deletion. ') 9080 FORMAT ('+',A<80-ICOL+1>) 9081 FORMAT ('+',A) 9084 FORMAT ('+',A1,'[23;',I2.2,'H',A1) 9980 FORMAT (' ',I2.2,'>',A77) END INTEGER*2 FUNCTION IMOVTO(IROW,ICOL) C**** Do cursor positioning INTEGER*2 IROW, ICOL INTEGER*2 IPARM (6), IDS BYTE BSB (4) CHARACTER*10 ATEXT DATA ATEXT(1:1) /"33/ DATA ATEXT(2:8) /'[01;01H'/ WRITE (ATEXT(3:7), 9012) IROW,ICOL 9012 FORMAT (I2.2,';',I2.2) CALL GETADR( IPARM, ATEXT ) IPARM(2) = 8 IPARM(3) = 0 CALL WTQIO( "400, 5, 2, , BSB, IPARM, IDS ) IMOVTO = IDS RETURN END