1538 lines
30 KiB
Plaintext
Executable File
1538 lines
30 KiB
Plaintext
Executable File
******************************************************************************
|
|
*
|
|
* 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
|