C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
c
c Add "annotation" commands via main force & awkwardness as follows:
c  1. ANN command will create a file named cell.ANN for the current
c     cell (or overwrite an old one) dynamically for up to 20 lines
c     of text, just firing up the command "EDIT namecell.ANN" so the user
c     gets to do full screen edits. THE "name" part of the files is
c     taken from the first 6 characters of the sheet name. If these
c     are not in the uppercase alpha range they will be ignored, however,
c     so it is a good idea for sheet titles to have recognizable initial
c     6 characters.
c  2. QUERY or ? command will display the name.ANN file if it exists
c     after setting cursor to top of screen and doing line erase
c     there.
c
	SUBROUTINE USRCMD(CMDLIN,ICODE,IGOTIT)
	CHARACTER*80 CMDSTR
	PARAMETER CUP=1,EL=12,ED=11,SGR=13
	BYTE CMLN(80)
	LOGICAL*1 NMSH(80)
	COMMON/NMSH/NMSH
	EQUIVALENCE(CMLN,CMDSTR)
C DUMMY PLACE FOR USER COMMANDS TO PARSE CMDLIN AND HANDLE
C ADDITIONAL COMMANDS FOR VMS PORTACALC.
	INCLUDE 'VKLUGPRM.FTN'
C DEFINE VALUE AREA FOR SPREAD SHEET. MORE WILL BE NEEDED GENERALLY
C OUT OF COMMONS, BUT AT A MINIMUM, THIS WILL ALLOW SOME ACCESS TO
C USEFUL NUMBERS. LOOK IN XQTCMD FOR MORE...
	INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
	LOGICAL*1 AVBLS(20,27),WRK(128),VBLS(8,RRWP,RCLP)
	INTEGER*2 TYPE(RRWP,RCLP),VLEN(9)
	INTEGER*2 IOLVL,FOOBAR
	COMMON/FOOBAR/FOOBAR
	COMMON/IOLVL/IOLVL
	REAL*8 XAC,XVBLS(RRWP,RCLP)
	REAL*8 TAC,UAC,VAC
	LOGICAL*1 FORM(4)
	LOGICAL*1 CELNAM(8)
	character*18 annam
	logical*1 annams(18)
	equivalence(annam,annams(1))
	CHARACTER*8 CELNM
	CHARACTER*4 CELRW
	EQUIVALENCE(CELNM,CELNAM(1))
	EQUIVALENCE(FORM(1),CELNAM(1))
	EQUIVALENCE(CELRW,CELNAM(5))
	LOGICAL*1 EDNAM(16)
	COMMON/EDNAM/EDNAM
C EDITOR STRING NAME... DEFAULT "EDIT"
	INTEGER*4 JVBLS(2,RRWP,RCLP)
	EQUIVALENCE(XAC,AVBLS(1,27))
	EQUIVALENCE(TAC,AVBLS(1,20))
	EQUIVALENCE(UAC,AVBLS(1,21))
	EQUIVALENCE(VAC,AVBLS(1,22))
	EQUIVALENCE(VBLS(1,1,1),JVBLS(1,1,1))
	EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
c available parsing aid:
c call varscn(line,ibgn,lend,lstchr,id1,id2,ivalid)
c where line(ibgn... lend) is scanned. If variable found
c ivalid=1 else ivalid=0. id1,id2 are dims in xvbls for
c variable found if any. lstchr is last char found+1...
C OTHER USEFUL ROUTINES IN THE SHEET:
C GN(LAST,LEND,NUMBER,LINE)
C  LOOKS FROM LINE(LAST) THRU LINE(LEND) FOR A NUMBER AND
C  RETURNS ANY NUMBER IN "NUMBER" ARG. ASSUMES "LINE" IS A
C  BYTE ARRAY. (NO INDICATION OF WHERE THE NUMBER WAS FOUND
C  HOWEVER). THROWS OUT LEADING SPACES, TERMINATES ON A NON
C  NUMERIC.
C INDEX(LINE,CHAR)
C  EXPECTS LINE TO BE NULL TERMINATED AND RETURNS EITHER
C  THE SUBSCRIPT (COUNTING FROM 1) OF CHAR IN LINE OR THE
C  MAX SUBSCRIPT IN LINE (I.E., WHERE IT HIT THE NULL TERMINATOR).
C  NOTE THIS DIFFERS FROM THE "STANDARD" VERSION OF INDEX WHICH
C  RETURNS 0 FOR "NOT FOUND" -- THIS VERSION RETURNS MAX LENGTH
C  FOR "NOT FOUND". STOPS AT 512 BYTES HOWEVER...
C  PARSING IS UP TO USER. NOTE VARSCN MAY BE CALLED TO PARSE
	LOGICAL*1 CMDLIN(132)
	INTEGER*4 ISTTS
C
C INSERT CODE FOR ADDING A LIB$SPAWN CALL HERE TO PASS COMMANDS TO
C DCL IF THEY BEGIN WITH A $ CHARACTER.
	IGOTIT=0
	IF(CMDLIN(1).NE.'$'.AND.CMDLIN(1).NE.'}')GOTO 8000
C
C HERE CALL THE LIB$SPAWN WITH THE COMMAND LINE AS AN ARGUMENT...
	DO 1000 NN=1,80
1000	CMLN(NN)=CMDLIN(NN+1)
	CMLN(80)=13 ! ADD C.R. AFTER LINE
C ABOVE, INSERT A CR AFTER CMD LINE
	ISTTS=LIB$SPAWN(CMDSTR)
C ASSUME WE NEED A REDRAW AFTER THE SPAWN FINISHES
	IF(CMDLIN(1).NE.'}')GOTO 750
	WRITE(6,760)
760	FORMAT(' Press RETURN to redraw spreadsheet>')
	READ(IOLVL,761,END=800,ERR=800)N
761	FORMAT(4A1)
750	continue
950	CONTINUE
	ICODE=2
C FLAG THE MAIN COMMAND PARSER WE HANDLED THE COMMAND
	IGOTIT=1
	GOTO 9990
8000	CONTINUE
	IF(CMDLIN(1).NE.'D'.OR.CMDLIN(2).NE.'T'.OR.CMDLIN(3).NE.'R')
     1  GOTO 8990
	IGOTIT=1
	ICODE=2
	CALL DTRCMD(CMDLIN(4))
C ISSUE DATATRIEVE COMMAND...
8990	CONTINUE
	IF(CMDLIN(1).NE.'F'.OR.CMDLIN(2).NE.'I'.OR.CMDLIN(3).NE.'L')
     1  GOTO 9000
	IGOTIT=1
C FLAG FOR RECALCULATION BUT NOT TOTAL REDISPLAY IF PREFIX IS
C 'FIL' RATHER THAN 'DTR'...
	ICODE=3
	CALL DTRCMD(CMDLIN(4))
C ISSUE DATATRIEVE COMMAND...
C
9000	CONTINUE
	IF(CMDLIN(1).NE.'A'.OR.CMDLIN(2).NE.'N')GOTO 9200
C ANNOTATE COMMAND SEEN
	IGOTIT=1
	ICODE=2
	DO 9001 N=1,80
	CMLN(N)=32
9001	CONTINUE
	CALL IN2AS(PROW,FORM)
	WRITE(CELRW,9002)PCOL-1
9002	FORMAT(I4.4)
	ICM=17
C EDIT NAME IS 16 CHARS LONG
	DO 9040 N=1,6
	IXX=NMSH(N)
	IF(IXX.GT.96)IXX=IXX-32
	IF(IXX.LT.65.OR.IXX.GT.90)GOTO 9040
	CMLN(ICM)=IXX
	ICM=ICM+1
9040	CONTINUE
	ICM=ICM-1
	DO 9003 N=1,8
	CMLN(N+ICM)=CELNAM(N)
9003	CONTINUE
	CMLN(ICM+9)='.'
	CMLN(ICM+10)='A'
	CMLN(ICM+11)='N'
	CMLN(ICM+12)='N'
	CMLN(ICM+13)=' '
	CMLN(80)=13
	DO 8603 N=1,16
	CMLN(N)=EDNAM(N)
8603	CONTINUE
C	CMLN(1)='E'
C	CMLN(2)='D'
C	CMLN(3)='I'
C	CMLN(4)='T'
C	CMLN(5)=' '
C NOW HAVE "EDIT name.ANN"
c built... go fire it up for creation or modification of annotation...
	DO 9150 N=17,ICM+12
	IF(CMLN(N).EQ.' ')CMLN(N)='0'
9150	CONTINUE
	ISTTS=LIB$SPAWN(CMDSTR(1:ICM+14))
	GOTO 9990
9200	CONTINUE
	IF(CMDLIN(1).NE.'?'.AND.(CMDLIN(1).NE.'Q'.OR.CMDLIN(2)
     1  .NE.'U'.OR.CMDLIN(3).NE.'E')) GOTO 9300
C QUERY COMMAND SEEN
	IGOTIT=1
	ICODE=2
	DO 9237 N=1,18
9237	ANNAMS(N)=32
	CALL IN2AS(PROW,FORM)
	WRITE(CELRW,9002)PCOL-1
	ICM=0
	DO 9240 N=1,6
	IXX=NMSH(N)
	IF(IXX.GT.96)IXX=IXX-32
	IF(IXX.LT.65.OR.IXX.GT.90)GOTO 9240
	ICM=ICM+1
	ANNAMS(ICM)=IXX
9240	CONTINUE
	DO 9241 N=1,8
	ANNAMS(ICM+N)=CELNAM(N)
9241	CONTINUE
	ANNAMS(ICM+9)='.'
	ANNAMS(ICM+10)='A'
	ANNAMS(ICM+11)='N'
	ANNAMS(ICM+12)='N'
	DO 9250 N=1,18
	IF(ANNAMS(N).EQ.' ')ANNAMS(N)='0'
9250	CONTINUE
	ANNAMS(ICM+13)=' '
	OPEN(UNIT=2,NAME=ANNAM(1:ICM+13)
     1  ,ACCESS='SEQUENTIAL',STATUS='OLD',
     1  ERR=9210)
	DO 9030 N=1,20
	READ(2,9031,END=9032,ERR=9032)WRK
9031	FORMAT(128A1)
	CALL UVT100(CUP,N+2,1)
	CALL UVT100(EL,2)
	WRITE(6,9035)WRK
9035	FORMAT(128A1)
9030	CONTINUE
9032	CONTINUE
C THIS DISPLAYS ALL THE ANNOTATION WE HAVE...
	CLOSE(UNIT=2)
	CALL UVT100(CUP,LLCMD,1)
	CALL UVT100(EL,2)
	WRITE(6,760)
	READ(IOLVL,761,END=800,ERR=800)N
	GOTO 9990
9210	CONTINUE
	ICODE=3
	CALL UVT100(CUP,LLDSP,1)
	call uvt100(EL,2)
	WRITE(6,9211)
9211	FORMAT(' No annotation found on this cell.')
9300	CONTINUE
9990	CONTINUE
	RETURN
800	CONTINUE
	CLOSE(UNIT=IOLVL)
C RESET TO NORMAL I/O OFF CONSOLE.
	FOOBAR=0
	IOLVL=5
	CLOSE(UNIT=5)
	OPEN(UNIT=5,FILE='SYS$COMMAND:',CARRIAGECONTROL='NONE')
C REOPEN CONSOLE IN CASE OF INITIALIZER FILES...
	GOTO 750
	END