tldm-universe/Ardent/UV/APP.PROGS/EDT

******************************************************************************
*
*	Routine to handle UniVerse Spooled Device Management
*
*	Module	%M%	Version	%I% 	Date	%H%	
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description........................................
*	10/13/98 23801 RGA Change copyright info.
*	10/29/92 10493 TMC Add EDT, Ultimate's ED
*
*******************************************************************************
*
*
* @(#) EDITOR - ULTIMATE COMPATIBLE EDITOR 
* 	 Author:	Rick Poleshuck
*   	   Date:	6/14/90
* Last modified:	1/9/91
*
$OPTIONS PICK

*
* $include EQUATES
*
EQU TRUE TO 1
EQU FALSE TO 0
EQU TAB TO CHAR(9)
EQU SUB.END TO 32000

* list of commands
EQU COM.NULL		TO 1
EQU COM.EXIT 		TO 2
EQU COM.EXITALL 	TO 3
EQU COM.QUESTION	TO 4
EQU COM.WILDCARD	TO 5
EQU COM.LIST		TO 6
EQU COM.GOTO		TO 7
EQU COM.SUPPRESS	TO 8
EQU COM.LENGTH		TO 9
EQU COM.TOP		TO 10
EQU COM.UP		TO 11
EQU COM.BOTTOM		TO 12
EQU COM.BREAK		TO 13
EQU COM.COLUMN		TO 14
EQU COM.FILEDELETE	TO 15
EQU COM.HEX		TO 16
EQU COM.JOIN		TO 17
EQU COM.DISP.PRE	TO 18
EQU COM.EXE.PRE		TO 19
EQU COM.SET.PRE		TO 20
EQU COM.DOWN		TO 21
EQU COM.ZONE		TO 22
EQU COM.TABS		TO 23
EQU COM.INSERT		TO 24
EQU COM.FILE		TO 25
EQU COM.FILESAVE	TO 26
EQU COM.FLIP		TO 27
EQU COM.CANCEL		TO 28
EQU COM.CANCELALL	TO 29
EQU COM.COPY		TO 30
EQU COM.DELETELINE	TO 31
EQU COM.MERGE		TO 32
EQU COM.REPLACE		TO 33
EQU COM.REP.UNIVERSAL	TO 34
EQU COM.APPEND		TO 35
EQU COM.BREAKLINE	TO 36

$include UNIVERSE.INCLUDE TTY

*
* $include INIT
*
PROMPT ""
wildcard = TRUE
suppress = FALSE
found = TRUE
hex = FALSE
dummy = @(0,0)
search.lines = 0
search.string = ""
search.start = 0
search.stop = 0
zonestart = 1
zonestop  = SUB.END
multitems = FALSE
pre.execute = ""
DIMENSION prestore( 10 )
prestore( 1 ) = "L22"
FOR i = 2 TO 10
	prestore( i ) = ""
NEXT i
TTYGET tty$ THEN
	tty.save = tty$
	CC.QUIT = -1
	TTYSET tty$ THEN NULL
END 

* Get filename and file pointer
* input: ARG. 
* output:	filename - name of current file
* 		fp	 - current filepointer
*	        itemlist - dynamic array of all specified items
*		nitems   - number of items to process
*
* $include GETFN
*
dict = FALSE
GET ( ARG. ) filename ELSE filename = ""
BEGIN CASE
	CASE filename = "" 
		STOPE 200
	CASE filename = "DICT"
		dict = TRUE
		GET ( ARG. ) filename
		OPEN "DICT", filename TO fp ELSE
			STOPE 202, filename
		END
	CASE filename = "DATA"
		GET ( ARG. ) filename
		OPEN "DATA", filename TO fp ELSE
			STOPE 202, filename
		END
	CASE 1
		OPEN filename TO fp ELSE
			STOPE 202, filename
		END
END CASE
*
* get list of itemids
*
itemlist = ""
nitems = 0
LOOP 
	GET ( ARG. ) item ELSE item = ""
UNTIL 	item = "" DO
	* check for single * as argument
	IF itemlist = "" AND item = "*" THEN
		itemlist = "*"
		nitems = 1
		EXIT
	END
	itemlist = itemlist:item:@VM
	nitems += 1
REPEAT

* Check for no items specified
IF nitems = 0 THEN 
	* is select list active
	IF SYSTEM(11) = 0 THEN
		STOPE 203
	END ELSE
		multitems = TRUE
		itemlist = ""
		LOOP
			NULL
		WHILE READNEXT tmp 
			itemlist = itemlist:tmp(0):@VM
			nitems += 1
		REPEAT
	END
END ELSE
	* if Argument = * then loop thru get list of items
	IF  itemlist = "*" THEN
		* Get list of items
		nitems = 0
		multitems = TRUE
		itemlist = ""
		SELECT fp TO selectlist
		LOOP
			NULL
		WHILE READNEXT tmp,junk FROM selectlist 
			itemlist = itemlist:tmp:"":@VM
			nitems += 1
		REPEAT
	END 
	IF nitems > 1 THEN multitems = TRUE
END

*
* Loop thru all items
*
FOR item.no = 1 TO nitems
	item = FIELD ( itemlist, @VM, item.no )
	modified = FALSE

	nattr = 0
	READ record FROM fp,item THEN
		nattr = DCOUNT( record, @AM )
		new.item = FALSE
	END ELSE
		PRINT @SYS.BELL:"New item" 
		record = ""
		new.item = TRUE
	END
	xrecord = record
	xline = ""
	xlineno = 0
	IF nattr = 0 THEN
		lastline = TRUE
		curline = 0
	END ELSE
		lastline = FALSE
		curline = 1
	END
	IF multitems = TRUE THEN PRINT item

	PRINT "Top"
	*
	* main editing loop
	*
	exited = FALSE
	LOOP
		GOSUB getcommand
		GOSUB docommand
	WHILE exited = FALSE
	REPEAT

NEXT item.no

* 
* End of main routine
*
TTYSET tty.save ELSE NULL
STOP

*
* subroutine section
*
getcommand:
*
* $include GETCOMMAND
*

*	                 1         2         3
*               123456789012345678901234567890123
EQU comlist TO "ABCDEFGHIJLMNPQRSTUXZ0123456789^?"

*
* look for a valid command
* 

valid = FALSE
LOOP
retry:
	IF pre.execute <> "" THEN
		* get prestore command
		comline = FIELD ( pre.execute, @SM, 1 )
		IF COL2() THEN
			pre.execute = pre.execute[ COL2()+1, SUB.END ]
		END ELSE
			pre.execute = ""
		END
	END ELSE
		PRINT ".":
		INPUT comline
		IF comline = "" THEN PRINT @(-10):
	END
	comline = TRIMB( TRIMF( comline ) )

	IF comline = "" THEN 
		command = COM.NULL
		RETURN
	END
	command = INDEX ( comlist, UPCASE( comline[1,1] ), 1 )

	ON command GOSUB gca, gcb, gcc, gcd, gce, gcf, gcg, gch, gci, gcj,
		 	 gcl, gcm, gcn, gcp, gcq, gcr, gcs, gct, gcu, gcx,
			 gcz, gc0, gc1, gc2, gc3, gc4, gc5, gc6, gc7, gc8,
			 gc9, gcup, gcquest

WHILE valid = FALSE
	PRINT "Cmnd?"
REPEAT
RETURN
		
gca:
	BEGIN CASE
	CASE UPCASE(comline) = "A"
		IF search.string <> "" THEN
			parm1 = search.lines
			parm2 = search.string
			parm3 = search.start
			parm4 = search.stop 
			valid = TRUE
			command = COM.LIST
		END
	CASE UPCASE( comline[2,1] ) = "L" 
		command = COM.APPEND
		comline = comline[3,SUB.END]
		GOSUB parsenumber
		parm1=parm
		IF parm1 = 0 THEN parm1 = 1
		sep=comline[1,1]
		parm2=FIELD( comline[2,SUB.END], sep, 1 )
		valid = TRUE
	CASE UPCASE ( comline[2,1] ) = "S"
		PRINT "AS not available"
	END CASE
	RETURN

gcb:
	BEGIN CASE
	CASE UPCASE(comline) = "B" 
		command = COM.BOTTOM
		valid = TRUE
	CASE UPCASE(comline[1,2]) = "BL" 
		comline = comline[2,SUB.END]
		GOSUB parseline
		* parm1 = number of lines to break
		* parm2 = search string
		* parm3 = starting column
		* parm4 = ending column
		* search string is required for BL
		IF parm2 <> "" THEN
			*
			* fixup parameters 
			*
			IF parm1 = 0 THEN parm1 = 1
			IF parm3 = 0 THEN parm3 = 1
			BEGIN CASE
			CASE parm4 = 0
				parm4 = SUB.END
			CASE parm4 <= parm3
				parm4 = 1
			CASE 1
				parm4 = ( parm4 - parm3 ) + 1
			END CASE
			command = COM.BREAKLINE
			valid = TRUE
		END
	END CASE
	RETURN

gcc:
	BEGIN CASE
	CASE UPCASE(comline) = "C" 
		command = COM.COLUMN
		valid = TRUE
	CASE UPCASE( comline[2,1] ) = "L" 
		command = COM.COPY
		comline = TRIMF( comline[3,SUB.END] )
		GOSUB parsenumber
		IF parm <> 0 THEN 
			parm1 = parm
			comline = TRIMF( comline )
			IF comline[1,1] = "-" THEN
				comline = TRIMF( comline[2,SUB.END] )
				GOSUB parsenumber
				parm2 = parm
			END
			command = COM.COPY
			valid = TRUE
		END
	END CASE
	RETURN
gcd:
	IF UPCASE( comline[2,1] ) = "E" THEN
		comline = comline[2,SUB.END]
		GOSUB parseline
		*
		* fixup parameters 
		*
		IF parm3 = 0 THEN parm3 = 1
		BEGIN CASE
		CASE sep = ":" AND parm3 <> 1 
			* if specified search from beginning ':' but don't
			* look at first column then just return FALSE
			RETURN
		CASE parm4 = 0
			parm4 = SUB.END
		CASE parm4 <= parm3
			parm4 = 1
		CASE 1
			parm4 = ( parm4 - parm3 ) + 1
		END CASE
		command = COM.DELETELINE
		valid = TRUE
	END
	RETURN

gce:
	BEGIN CASE
	CASE UPCASE( comline ) = "EX"
		command = COM.EXIT
		valid = TRUE
	CASE UPCASE( comline ) = "EXT"
		command = COM.EXITALL
		valid = TRUE
	CASE 1
		NULL
	END CASE
	RETURN
gcf:
	chr = UPCASE( comline[2,1] )
	BEGIN CASE
	CASE chr = "" 
		command = COM.FLIP
		valid = TRUE
		RETURN
	CASE chr = "D" 
		command = COM.FILEDELETE
		valid = TRUE
		* filedelete takes no parameters
		RETURN
	CASE chr = "I"
		command = COM.FILE
	CASE chr = "S"
		command = COM.FILESAVE
	CASE 1
		PRINT "Cmnd?"
		RETURN to retry
	END CASE
	*
	* parm1 = overwrite flag
	* parm2 = item name
	* parm3 = filename
	*
	* set overwrite flag
	IF UPCASE ( comline[3,1] ) = "O" THEN
		parm1 = TRUE
		comline = comline[4,SUB.END]
	END ELSE
		parm1 = FALSE
		comline = comline[3,SUB.END]
	END
	* set new file name
	IF comline[1,1] = "(" THEN
		* is it a DICT file
		comline = comline[2,SUB.END]
		tmp = FIELD( comline, " ", 1 )
		IF tmp = "DICT" THEN
			tmp = TRIMF(comline[COL2()+1,SUB.END])
			parm3 = "DICT ":FIELD( comline, " ", 1 )
			comline = comline[ COL2()+1, SUB.END ]
		END ELSE
			parm3 = tmp
			comline = comline[ COL2()+1, SUB.END ]
		END
		* if filename specified and no item specified
		* then use same item name
		parm2 = TRIMF( comline )
		IF parm2 = "" THEN
			parm2 = item
		END
	END ELSE
		parm2 = FIELD( comline , " ", 1 )
		parm3 = ""	
	END
	
	valid = TRUE
	RETURN

gcg:
	comline = TRIMF( comline[2, SUB.END] )
	IF NUM ( comline ) = TRUE THEN
		command = COM.GOTO
		parm1 = comline
		valid = TRUE
	END
	RETURN
gch:
	IF UPCASE(comline[1,2]) = "HX" THEN
		command = COM.HEX
		valid = TRUE
	END
	RETURN
gci:
	IF UPCASE(comline) = "I" THEN
		parm1 = ""
	END ELSE
		parm1 = comline[3,SUB.END]
	END
	command = COM.INSERT
	valid = TRUE
	RETURN
gcj:
	IF UPCASE(comline[1,2]) = "JL" THEN
		command = COM.JOIN
		valid = TRUE
	END
	RETURN
gcl:
	GOSUB parseline
	command = COM.LIST
	*
	* fixup parameters 
	*
	IF parm3 = 0 THEN parm3 = 1
	BEGIN CASE
	CASE sep = ":" AND parm3 <> 1 
		* if specified search from beginning ':' but don' look at first
		* column then just return FALSE
		RETURN
	CASE parm4 = 0
		parm4 = SUB.END
	CASE parm4 <= parm3
		parm4 = 1
	CASE 1
		parm4 = ( parm4 - parm3 ) + 1
	END CASE
	search.lines = parm1
	search.string = parm2
	search.start = parm3
	search.stop = parm4

	valid = TRUE
	RETURN

gcm:
	IF UPCASE ( comline[2,1] ) = "E" THEN
		* parm1 = number of lines
		* parm2 = filename
		* parm3 = item-id
		* parm4 = start line
		comline = TRIMF( comline[3,SUB.END] )
		GOSUB parsenumber
		parm1 = parm
		comline = TRIMF( comline )
		IF comline[1,1] <> "("  THEN
			* merge in same file
			parm2 = filename
			sep = comline[1,1]
			comline = comline[2,SUB.END]
			parm3 = FIELD( comline, sep, 1 )
			* null itemid specified defaults to current itemid
			IF parm3 = "" THEN parm3 = item
			comline = comline[ COL2() + 1, SUB.END ]
			GOSUB parsenumber
			parm4 = parm
		END ELSE
			* is it a DICT file
			comline = comline[2,SUB.END]
			tmp3 = FIELD( comline, ")", 1 )
			comline = comline[COL2()+1,SUB.END]
			GOSUB parsenumber
			parm4 = parm
			IF tmp3[1,5] = "DICT " THEN
				tmp1 = TRIMF(tmp3[6,SUB.END])
				parm2 = "DICT ":FIELD( tmp1, " ", 1 )
				tmp3 = tmp1[ COL2()+1, SUB.END ]
			END ELSE
				parm2 = FIELD( tmp3, " ", 1 )
				tmp3 = tmp3[ COL2()+1, SUB.END ]
			END
			* if filename specified and no item specified
			* then use same item name
			parm3 = TRIMF( tmp3 )
			IF parm3 = "" THEN
				parm3 = item
			END
		END
		valid = TRUE
		command = COM.MERGE
	END
	RETURN
gcn:
	comline = TRIMF( comline[2,SUB.END] )
	parm1 = 0
	IF LEN ( comline ) > 0 THEN
		GOSUB parsenumber
		parm1 = parm
	END
	IF LEN ( comline ) = 0 THEN
		valid = TRUE
		command = COM.DOWN
	END
	RETURN

gcp:
	BEGIN CASE
	CASE UPCASE( comline ) = "PD" 
		command = COM.DISP.PRE
		valid = TRUE

	CASE LEN ( comline ) = 2 AND NUM( comline[2,1] )  
		* prestores are called as 0 based but stored 1 based
		command = COM.EXE.PRE
		parm1 = comline[2,1] + 1
		valid = TRUE

	CASE UPCASE( comline ) = "P"
		* P with no arguments is P0
		command = COM.EXE.PRE
		parm1 = 1
		valid = TRUE

	CASE NUM( comline[2,1] ) 
		command = COM.SET.PRE
		valid = TRUE
		parm1 = comline[2,1] + 1
		parm2 = comline[4,SUB.END]

	END CASE
	RETURN
gcq:
	RETURN
gcr:
	* parm1 = number of lines
	* parm2 = search string
	* parm3 = replace string
	* parm4 = start column
	* parm5 = end column
	IF UPCASE( comline[2,1] ) = "U" THEN
		command = COM.REP.UNIVERSAL
		comline = comline[3,SUB.END]
	END ELSE
		command = COM.REPLACE
		comline = comline[2,SUB.END]
	END
	GOSUB parsenumber
	parm1 = parm
	comline = TRIMF( comline )
	IF comline = "" THEN
		* simple replace command
		parm4 = 0
		valid = TRUE
		RETURN
	END
	sep = comline[1,1]
	parm2 = FIELD( comline, sep, 2 )
	comline = comline[ COL2() + 1, SUB.END ]
	IF comline = "" THEN
		PRINT "Strng?"
		RETURN 
	END
	parm3 = FIELD( comline, sep, 1 )
	comline = TRIMF( comline[ COL2() + 1, SUB.END ] )
	parm4 = 1
	parm5 = 0
	IF LEN ( comline ) <> 0 THEN
		GOSUB parsenumber
		parm4 = parm
		comline = TRIMF( comline )
		IF LEN( comline ) > 0 THEN
			IF comline[1,1] <> "-" THEN
				PRINT "Col#?"
				RETURN 
			END
			comline = comline[2,SUB.END]
			GOSUB parsenumber
			parm5=parm
		END 
	END
	IF sep = ":" THEN
		* universal search would make no sense
		command = COM.REPLACE
	END
	IF parm2 = "" AND command = COM.REP.UNIVERSAL THEN
		PRINT "Strng?"
		RETURN 
	END
	
	BEGIN CASE
	CASE sep = ":" AND parm4 <> 1 
		* if specified search from beginning ':' but don' look at first
		* column then just return 
		RETURN
	CASE parm5 = 0
		parm5 = SUB.END
	CASE parm5 <= parm4
		parm5 = parm4
	END CASE
	valid = TRUE
	RETURN

gcs:
	IF comline[2,1] = "?" THEN
		command = COM.LENGTH
	END ELSE
		command = COM.SUPPRESS
	END
	valid = TRUE
	RETURN
gct: 
	IF UPCASE(TRIM( comline )) = "T" THEN
		command = COM.TOP
		valid = TRUE
	END 
	RETURN

gcu:
	parm1 = 0
	comline = TRIMF( comline[2,SUB.END] )
	IF LEN ( comline ) > 0 THEN
		GOSUB parsenumber
		parm1 = parm
	END
	IF LEN ( comline ) = 0 THEN
		valid = TRUE
		command = COM.UP
	END
	RETURN
gcx: 
	BEGIN CASE
	CASE UPCASE( comline ) = "X"
		command = COM.CANCEL
		valid = TRUE
	CASE UPCASE ( comline ) = "XF"
		command = COM.CANCELALL
		valid = TRUE
	END CASE
	RETURN
gcz:
	parm1 = 1
	parm2 = SUB.END

	comline = TRIMF ( comline[2,SUB.END] )
	IF LEN (comline ) > 0 THEN
		GOSUB parsenumber
		parm1 = parm
		IF LEN( comline ) > 0 THEN
			IF comline[1,1] <> "-" THEN
				PRINT "Col#?"
				RETURN TO retry
			END
			comline = comline[2,SUB.END]
			GOSUB parsenumber
			parm2 = parm
			IF LEN( comline ) > 0 THEN
				PRINT "Col#?"
				RETURN TO retry
			END
		END
	END
	valid = TRUE
	command = COM.ZONE
	RETURN
*
* numbers
*
gc0:
gc1:
gc2:
gc3:
gc4:
gc5:
gc6:
gc7:
gc8:
gc9:
	IF NUM( comline ) = TRUE THEN
		valid = TRUE
		command = COM.GOTO
		parm1 = comline
	END
	RETURN
gcup:
	valid = TRUE
	command = COM.WILDCARD
	RETURN
gcquest:
	valid = TRUE
	command = COM.QUESTION
	RETURN

parsenumber:
*
*	inputs:	comline - command line
*	outputs: parm - parameter
*		 comline - points to after parameter
*
	tmp = LEN( comline )
	parm = 0
	FOR i = 1 TO tmp 
		IF NUM( comline[1,1] ) THEN
			parm = parm*10 + comline[1,1]
			comline = comline[2,SUB.END]
		END ELSE
			i = tmp 
		END
	NEXT i
	RETURN


parseline:
	parm2 = ""
	parm3 = 0
	parm4 = 0
	sep = ""

	comline = TRIMF( comline[2,SUB.END] )
	GOSUB parsenumber	
	parm1 = parm

	IF LEN ( comline ) > 0 THEN 

		sep = comline[1,1]
		parm2 = FIELD( comline, sep, 2 )
		comline = comline[ COL2() + 1, SUB.END ]
		IF LEN ( comline ) > 0 THEN 
			GOSUB parsenumber
			parm3 = parm
			IF LEN ( comline ) > 0 THEN
				IF comline[1,1] <> "-" THEN
					PRINT "Col#?"
					RETURN TO retry
				END
				comline = comline[2,SUB.END]
				GOSUB parsenumber
				parm4 = parm
				IF LEN ( comline ) > 0 THEN
					PRINT "Col#?"
					RETURN TO retry
				END
			END
		END
	END
	RETURN

docommand:
*
* $include DOCOMMAND
*
BEGIN CASE
CASE command = COM.NULL
	GOSUB disp.line
	GOSUB iseoi

CASE command = COM.QUESTION
	IF LEN ( curline ) > 3 THEN
		PRINT item:"  L ":curline
	END ELSE
		PRINT item:"  L ":FMT(curline,"R%%%")
	END

CASE command = COM.WILDCARD
	IF wildcard = TRUE THEN
		wildcard = FALSE
		PRINT "/^\ on"
	END ELSE
		wildcard = TRUE
		PRINT "/^\ off"
	END

CASE command = COM.APPEND
	curline -= 1
	tmp3 = curline + parm1 -1
	FOR i = curline TO tmp3
		modified = TRUE
		record<curline> = record<curline>:parm2
		GOSUB disp.line
		GOSUB iseoi
		IF curline >= nattr THEN
			i = tmp3
			lastline = TRUE
		END
	NEXT i

CASE command = COM.BREAKLINE
	curline -= 1
	found = TRUE
	FOR i = 1 TO parm1 
		IF parm2 <> "" THEN
			start = parm3
			stop = parm4
			search = parm2
			GOSUB locate
		END 
		IF found THEN
			modified = TRUE
			position += LEN( parm2 ) 
			* Add length of search to break position
			record<curline> = record<curline>[1,position -1]:@AM:record<curline>[position,65536]
			nattr += 1
			GOSUB disp.line
			GOSUB disp.line
			GOSUB iseoi
		END ELSE
			curline += 1
			IF curline >= nattr THEN
				lastline = TRUE
			END
		END
		IF lastline = TRUE THEN
			i = parm1
		END
	NEXT i

CASE command = COM.COLUMN
	IF suppress = FALSE THEN
		PRINT "   ":
		tmp = @CRTWIDE - 3
	END ELSE
		tmp = @CRTWIDE
	END
	PRINT "          1         2         3         4         5         6         7" [ 1, tmp ] 
	IF suppress = FALSE THEN PRINT "   ":
	PRINT " 123456789012345678901234567890123456789012345678901234567890123456789012345678" [ 1, tmp ]

CASE command = COM.EXIT OR command = COM.EXITALL
	IF modified = TRUE THEN
		GOSUB sure
		IF tmp = FALSE THEN
			RETURN
		END
	END
	PRINT "'":item:"' exited"
	IF command = COM.EXITALL THEN
		STOP
	END
	exited = TRUE

CASE command = COM.COPY
	IF parm2 < parm1 THEN parm2 = parm1
	modified = TRUE
	* build list of attributes to move
	tmp = ""
	FOR i = parm1 TO parm2
		tmp = tmp:record<parm1>
		IF i < parm2 THEN tmp = tmp:@AM
		DEL record<parm1>
	NEXT i
	* adjust curline for deletion before insertion
	IF curline > parm1 THEN 
		curline = curline - ( parm2 - parm1 + 1 )
	END
	IF curline = nattr THEN
		record = record:@AM:tmp
	END ELSE
		INS tmp BEFORE record<curline>
	END

CASE command = COM.DELETELINE
	IF parm1 = 0 THEN parm1 = 1
	curline -= 1
	lastline = FALSE
	IF curline < 1 THEN curline = 1
	IF curline > nattr THEN
		PRINT "Seqn?"
		GOTO enddelete
	END
	nattr.saved = nattr
	FOR i = 1 TO parm1 WHILE curline <= nattr
		IF parm2 <> "" THEN
			start = parm3
			stop = parm4
			search = parm2
			GOSUB locate
		END ELSE
			found = TRUE
		END
		IF found THEN
			modified = TRUE
			DEL record<curline>
			nattr -= 1
		END ELSE
			curline += 1
		END
	NEXT i
	IF curline > nattr OR nattr = 0 THEN
		PRINT "EOI ":
		lno = nattr.saved
		GOSUB disp.number
		lastline = TRUE
		PRINT
	END
	RETURN
enddelete:
	NULL

CASE command = COM.FLIP
	curline = 1
	PRINT "Top"
	lastline = FALSE

CASE command = COM.FILEDELETE
	IF modified = TRUE THEN
		GOSUB sure
		IF tmp = TRUE THEN
			DELETE fp, item 
			exited = TRUE
			PRINT "'":item:"' deleted."
		END
	END ELSE
		DELETE fp, item 
		exited = TRUE
		PRINT "'":item:"' deleted."
	END

CASE command = COM.FILE OR command = COM.FILESAVE
	* if parm3 isn't specified use same file
	IF parm3 = "" THEN
		* if parm2 isn't specified than just rewrite item
		IF parm2 = "" THEN
			WRITE record TO fp, item THEN
				modified = FALSE
			END ELSE
				PRINT "Write error!"
			END
		END ELSE
			* if overwrite flag isn't specified
			* and item exists then don't write record
			IF parm1 = FALSE THEN
				READU dummy FROM fp, parm2 THEN
					PRINT "Cmnd?"
					GOTO file.end
				END
			END
			WRITE record TO fp, parm2 THEN
				modified = FALSE
			END ELSE
				PRINT "Write error!"
			END
		END
	END ELSE
	* if parm3 is specified use different file
		IF parm2 = "" THEN parm2 = item
		* open specified filename
		OPEN parm3 TO tmp ELSE 
			PRINT "Open error!"
			GOTO file.end
		END
		* if overwrite flag isn't specified
		* and item exists then don't write record
		IF parm1 = FALSE THEN
			READU dummy FROM tmp, parm2 THEN
				PRINT "Cmnd?"
				GOTO file.end
			END
		END
		WRITE record TO tmp,item THEN 
			modified = FALSE
		END ELSE
			PRINT "Write error!"
		END
		CLOSE tmp
	END 

	IF command = COM.FILE THEN
		exited = TRUE
	END
	xrecord = record
	xline = ""
	IF exited = FALSE THEN
		curline = 1
		PRINT "Top"
		lastline = FALSE
	END ELSE
		PRINT "'":item:"' filed"
	END
file.end:
	NULL

CASE command = COM.HEX
	IF hex = TRUE THEN
		hex = FALSE
		PRINT "Hex off"
	END ELSE
		hex = TRUE
		PRINT "Hex on"
	END

CASE command = COM.INSERT
	IF parm1 = "" THEN
		IF curline = 0 THEN curline = 1
		* handle screw line number display
		IF new.item = TRUE THEN
			lno = curline 
		END ELSE
			lno = curline -1
		END
		LOOP
			IF LEN( lno ) > 3 THEN
				PRINT lno:"+":
			END ELSE
				PRINT FMT( lno, "R%%%" ):"+":
			END
			INPUT parm1
		UNTIL parm1 = ""
			IF new.item = TRUE THEN lno += 1
			GOSUB insert.line
		REPEAT
	END ELSE
		GOSUB insert.line
	END
	new.item = FALSE

CASE command = COM.JOIN
	IF curline > 1 THEN
		* join line is really remove an @AM
		tmp = INDEX ( record, @AM, curline - 1 )
		record = record[1,tmp-1]:record[tmp+1,65556]
		modified = TRUE
		curline -= 1
		nattr -= 1
		GOSUB disp.line
		GOSUB iseoi
	END

CASE command = COM.LIST
	GOSUB istop
	found = TRUE	;* disp.line lists only found lines - default to found
	IF parm1 = 0 THEN
		IF parm2 = "" THEN parm1 = 1
		ELSE
			* special case - parm1 = 0/locate first match in item
			found = FALSE
			LOOP 
				* disp.line only prints line if found = TRUE
				* else it increments  pointer
				start = parm3
				stop = parm4
				search = parm2
				GOSUB locate
				GOSUB disp.line
				GOSUB iseoi
			UNTIL lastline OR found
			REPEAT
		END
	END 
	FOR i = 1 TO parm1 WHILE lastline = FALSE
		IF parm2 <> "" THEN
			start = parm3
			stop = parm4
			search = parm2
			GOSUB locate
		END 
		* disp.line only prints line if found = TRUE else
		* it increments  pointer
		GOSUB disp.line
		GOSUB iseoi
	NEXT i

CASE command = COM.MERGE
	* parm1 = number of lines
	* parm2 = filename
	* parm3 = item-id
	* parm4 = start line
	IF parm2 <> "" THEN
		* merge from different file
		OPEN parm2 TO mergefp ELSE
			PRINT "Not on file"
			RETURN
		END
	END ELSE
		* merge from same file
		mergefp = fp
	END
	
	READ mergerecord FROM mergefp,parm3 ELSE
		PRINT "Not on file"
		RETURN
	END
	modified = TRUE
	tmp1 = parm1 + parm4 - 1
	tmp2 = ""
	j = 0
	* get all attributes to merge
	nmattr = DCOUNT ( mergerecord, @AM )
	FOR i = parm4 to tmp1 WHILE i <= nmattr
		tmp3 = mergerecord<i>
		tmp2 = tmp2:tmp3
		j = j + 1
		IF i <> tmp1 THEN
			tmp2 = tmp2:@AM
		END
	NEXT i
	* insert merged attributes and update counts
	INS tmp2 BEFORE record<curline>
	nattr += j
	IF nattr <> 0 THEN new.item = FALSE
	curline += j

	* release memory
	tmp2 = ""	
	tmp3 = ""
	mergerecord = ""

CASE command = COM.REPLACE OR command = COM.REP.UNIVERSAL
	* parm1 = number of lines
	* parm2 = search string
	* parm3 = replace string
	* parm4 = start column
	* parm5 = end column
	IF parm1 = 0 THEN parm1 = 1
	curline -= 1
	lastline = FALSE		;* backed up so lastline is false
	IF curline <= 0 THEN curline = 1
	IF parm4 = 0 THEN
		* simple replace - prompting for input
		IF curline >= nattr THEN curline = nattr
		FOR i = 1 TO parm1 
			IF NOT(suppress) THEN
				lno = curline
				GOSUB disp.number
			END
			PRINT " ":
			INPUT insert.buf
			IF insert.buf = "" THEN i = parm1 ELSE
				modified = TRUE
				record<curline> = insert.buf
			END
			IF curline >= nattr THEN
				PRINT "EOI ":nattr
				i = parm1
			END
			curline += 1
		NEXT i
	END ELSE
		* search and replace
		tmp = parm1 - curline - 1
		IF tmp > nattr THEN parm1 = tmp
		FOR replace = 1 TO parm1 WHILE curline <= nattr
			search = parm2
			start = parm4
			stop = parm5
			foundlist=""
			LOOP
				GOSUB locate
				IF found THEN
					position = position + start -1
					foundlist = foundlist:position:@AM
				END
			WHILE command = COM.REP.UNIVERSAL AND found = TRUE AND start < stop
				start = position + LEN( parm2 ) 
			REPEAT
			
			IF foundlist <> "" THEN
				j = DCOUNT( foundlist, @AM ) -1
				modified = TRUE
				line = record<curline>
				lensrch = LEN ( parm2 )
				FOR i = j TO 1 STEP -1
					k = foundlist<i>
					line = line[1,k-1]:parm3:line[k+lensrch,SUB.END]
				NEXT i
				record<curline> = line
				GOSUB disp.line
				line = ""
				found = TRUE
			END ELSE
				curline += 1
			END
		NEXT replace
	END
	GOSUB iseoi

CASE command = COM.DISP.PRE
	FOR i = 1 TO 10
		PRINT "P":i-1:" ":prestore(i)
	NEXT i

CASE command = COM.EXE.PRE
	pre.execute = prestore( parm1 )

CASE command = COM.SET.PRE
	prestore(parm1) = parm2

CASE command = COM.SUPPRESS
	IF suppress = TRUE THEN
		suppress = FALSE
		PRINT "Suppress off"
	END ELSE
		suppress = TRUE
		PRINT "Suppress on"
	END

CASE command = COM.LENGTH
	PRINT "Item length is ":LEN(record):" bytes"

CASE command = COM.TOP
	lastline = FALSE
	PRINT "Top"
	curline = 1

CASE command = COM.BOTTOM
	PRINT "EOI ":nattr
	curline = nattr+1

CASE command = COM.UP
	lastline = FALSE
	curline -= parm1
	curline -= 1
	IF curline < 1 THEN 
		PRINT "Top"
		curline = 1
	END ELSE
		GOSUB disp.line
		GOSUB iseoi
	END

CASE command = COM.DOWN
	curline += parm1
	IF curline >= nattr THEN 
		PRINT "EOI ":
		curline = nattr
		lno = curline
		GOSUB disp.number
		PRINT
		lastline = TRUE
	END ELSE
		GOSUB disp.line
		GOSUB iseoi
	END

CASE command = COM.GOTO
	lastline = FALSE
	IF parm1 = 0 THEN
		curline = 1
		PRINT "Top"
	END ELSE
		curline = parm1
		GOSUB disp.line
		GOSUB iseoi
	END

CASE command = COM.ZONE
	zonestart = parm1
	zonestop = parm2 - parm1 + 1

CASE command = COM.CANCEL
	PRINT "Undo not available"

CASE command = COM.CANCELALL
	record = xrecord
	nattr = DCOUNT( record, @AM )
	lastline = FALSE
	curline = 1
	lno = xlineno
	GOSUB disp.number

END CASE
RETURN

*
* subroutines
*   

disp.number:
	IF LEN( lno ) > 3 THEN
		PRINT lno:
	END ELSE
		PRINT FMT( lno, "R%%%" ):
	END
	RETURN

disp.line:
	IF lastline = TRUE THEN
		IF new.item = TRUE THEN
			PRINT "New item"
		END
		GOSUB istop
	END
	IF curline <= nattr THEN
		IF new.item = FALSE AND nattr <> 0 THEN
			* don't display when searching and not found
			IF command <> COM.LIST OR found = TRUE THEN
				IF suppress = FALSE THEN
					lno = curline
					GOSUB disp.number
				END 
				GOSUB putline
			END
			curline += 1
		END
	END 
	RETURN

sure:
	PRINT "Sure(Y/N=CR)?":
	INPUT tmp
	IF UPCASE( TRIMF(tmp)[1,1] ) = "Y" THEN
		tmp = TRUE
	END ELSE
		tmp = FALSE
	END
	RETURN

putline:
	tmp = record<curline>[zonestart, zonestop]
	tmp1 = LEN ( tmp )

	IF hex = TRUE THEN
	*
	* format hex string
	*
		tmp2 = ""
		FOR j = 1 TO tmp1
			tmp2 = tmp2:OCONV( tmp[j,1], "MX" )
		NEXT j
		tmp = tmp2
	END 
	*
	* filter nonprintable characters
	*
	length = LEN( tmp )
	tmp1 = ""
	FOR j = 1 TO length
		chr = tmp[j,1]
		IF ( chr >= " " AND chr <= "~" ) OR chr = TAB THEN
			tmp1 = tmp1:chr
		END ELSE
			tmp1 = tmp1:"."
		END
	NEXT j
	PRINT " ":tmp1
	
	RETURN

*
* locate string in line
*	input:  record<curline>: string to search
*		start = starting column
*		stop = ending column
*		search = string to find
*		sep:   separator - ":" means only match from start of line
*	        wildcard: TRUE|FALSE
*	output: found - TRUE|FALSE
*		position - position of found string
locate:
	IF search = "" THEN
		* special case - search for //
		position = 1
		found = TRUE
		RETURN
	END
	line = record<curline>[ start, stop ]:SPACE(256)
	*
	* look for exact match
	*
	IF wildcard = FALSE OR INDEX( search, "^", 1 ) = 0 THEN
		IF sep = ":" THEN
			IF search = line[ 1, LEN( search ) ] THEN
				found = TRUE
				position = 1
			END ELSE
				found = FALSE
			END
		END ELSE
			position = INDEX( line, search, 1 ) 
			IF position = 0 THEN
				found = FALSE
			END ELSE
				found = TRUE
			END
		END
	END ELSE
		tline = line
		IF sep = ":" THEN
		* must start in column 1
			GOSUB wildcompare
			IF found = TRUE THEN position = 1
		END ELSE
			position = 1
			found = FALSE
			LOOP
				IF search[1,1] = '^' THEN
					* wildcard always matches first char
					tpos = 1
				END ELSE
					* wildcard always matches first char
					tpos = INDEX ( tline, search[1,1], 1 )
				END
				IF tpos <> 0 THEN
					* first character not found
					tline = tline[tpos,SUB.END]
					position = position + tpos -1
				END
			WHILE tline <> "" AND tpos <> 0
				GOSUB wildcompare
				IF found = TRUE THEN
					GOTO locate.found
				END ELSE
					tline = tline[2,SUB.END]
				END
			REPEAT
		END
	END
locate.found:	
	tline = ""
	line = ""
	RETURN

insert.line:
	* Trailing Attribute mark denotes empty line - just remove it
	* embedded attribute marks are inserted
	*
	tmp = LEN(parm1)
	IF ( parm1[tmp,1] = @AM ) THEN parm1 = parm1[1,tmp-1]

	IF curline = nattr THEN
		record = record:@AM:parm1
	END ELSE
		INS parm1 BEFORE record<curline>
	END
	modified = TRUE
	tmp = DCOUNT ( parm1, @AM )
	* line with no @AM is still one attribute
	IF tmp = 0 THEN tmp = 1
	* increment curline and total number of attributes
	curline += tmp
	nattr += tmp
	IF curline > nattr THEN lastline = TRUE
	RETURN


wildcompare:
	*
	* input: search - search string
	*	 line - searched string
	k = LEN ( search )
	found = TRUE
	FOR j = 1 TO k
		IF search[j,1] <> '^' AND search[j,1] <> tline[j,1] THEN
			found = FALSE
			j = k
		END
	NEXT j
	RETURN

iseoi:
	IF curline > nattr OR nattr = 0 THEN
		PRINT "EOI ":
		lno = nattr
		GOSUB disp.number
		lastline = TRUE
		PRINT
	END
	RETURN

istop:
	IF curline > nattr OR lastline = TRUE THEN
		curline = 1
		PRINT @SYS.BELL:"Top"
		lastline = FALSE
	END
	RETURN

END