LineEDitor: Difference between revisions

From Pickwiki
Jump to navigationJump to search
m link fix
 
IanMcGowan (talk | contribs)
0, Bureaucrats, moderator, Administrators, ‘autoconfirmed’, ‘sysop’
84 edits
Add source code, grabbed from archive.org
 
Line 4: Line 4:


https://sites.google.com/site/nzpickie/home/programs
https://sites.google.com/site/nzpickie/home/programs
<PRE>
    program led
* This editor reproduces the UniData Alternate Editor for QM/U2
* The code is based on LED, a line editor released into
* the public domain by Public Trust of New Zealand.
* Written by Keith Robert Johnson.
*====================================================================
* Version information
*  2.00 - Simplified code - No longer supporting R83
*        Downcased the source to comply with QM standards.
*====================================================================
$define universe
$ifdef qm
$include err.h
    voc = @voc
$else
    open 'VOC' to voc else stop 201,'VOC'
$endif
$ifdef universe
$options information
$endif
$ifdef unidata
$basictype 'U'
$endif
* INITIALISE
    prompt ''
    am = char(254); vm = char(253); sm = char(252)
    true = 1 = 1; false = not(true); qt = '"\':"'"
    common /led$data/ edkeep,secure,kept
    equ cellsize to 100
    dim memr(1)
* List of verbs for viewing data only
    viewverb = 'VIEW':am:'BROWSE':am:'LOOK'
* XCOM data - YES this editor will do $commands like AE does
    dim junk(100)
    equ this to junk(1)
    equ item to junk(2)
    equ here to junk(3)
    equ x$cc to junk(11)
    equ comi to junk(13)
    equ comd to junk(14)
    equ last to junk(15)
    equ comdmark to junk(19)
    equ wordmark to junk(20)
    equ fnam to junk(24)
    equ xsep to junk(25)
    mat junk = ''
    xsep = ' '
    wordmark = ' '
    comdmark = '`'
* Local data
    begn = @(0) ; ceop = @(-3) ; ceol = @(-4) ; goup = @(-10)
    revb = @(-13) ; revf = @(-14) ; undb = @(-15) ; undf = @(-16)
    heap = false ; salt = '' ; rlen = 0
    plen = system(3)-1 ; pwin = plen-1 ; line = '' ; here = 0
    dim fr(10) ; mat fr = '' ; fr(3) = 'MCU'
    oops = '' ; oopc = '' ; oopl = '' ; oopf = ''
    oopb = '' ; oopk = ''
    join = '' ; nill = '' ; fold = ''
    macn = 0 ; macc = ''
    pick = '' ; lastfind = '' ; huge = 99999999
* Turn off page prompt
    test = @(0,0)
* Find Match words - a LOOP can have multiple WHILE and UNTIL conditions
    fm.words = '' ; fm.findf = '' ; fm.finda = ''
    fm.words<1> = 'END' ; fm.findf<1> = 'END'
    fm.finda<1> = 'IF':vm:'END':vm:'OPEN':vm:'OPENSEQ':vm:'BEGIN':vm:'LOCATE'
    fm.words<2> = 'LOOP' ; fm.findf<2> = 'REPEAT':vm:'UNTIL':vm:'WHILE'
    fm.words<3> = 'UNTIL'; fm.findf<3> = fm.findf<2>
    fm.finda<3> = 'LOOP':vm:'UNTIL':vm:'WHILE'
    fm.words<4> = 'WHILE'
    fm.findf<4> = fm.findf<2>; fm.finda<4> = fm.finda<3>
    fm.words<5> = 'FOR' ; fm.findf<5> = 'NEXT'
    fm.words<6> = 'NEXT' ; fm.finda<6> = 'FOR'
    fm.words<7> = 'BEGIN' ; fm.findf<7> = 'END CASE':vm:'CASE'
    fm.words<8> = 'CASE' ; fm.findf<8> = 'CASE':vm:'END CASE'
    fm.finda<8> = 'BEGIN CASE':vm:'CASE'
    fm.words<9> = 'LOCKED' ; fm.findf<9> = 'END'
    fm.finda<9> = 'READU':vm:'READVU':vm:'MATREADU'
    fm.words<10> = 'REPEAT' ; fm.finda<10> = fm.finda<3>
* Special for C code
    fm.words<11> = '{' ; fm.findf<11> = '}'
    fm.words<12> = '}' ; fm.finda<12> = '{'
*
    endwords = 'IF\OPEN\OPENSEQ\READNEXT\READ\READU\READV\READVU\'
    endwords := 'MATREAD\MATREADU\LOCATE'
    convert '\' to am in endwords
* page editor stuff
    botl = system(3) - 2; clpg = @(-1)
*    bell = char(7) ; span = system(2)
    bell = @sys.bell ; span = system(2)
    bott = @(0,system(3)-1):ceol
* Define key activity numbers - 22 keys defined
    equ uarr to 1, darr to 2, larr to 3, rarr to 4
    equ upag to 5, dpag to 6, lpag to 7, rpag to 8
    equ tpag to 9, bpag to 10
    equ escp to 11, phlp to 12, zoom to 13
    equ delc to 14, dell to 15, delr to 16
    equ back to 17, carr to 18, togg to 19, writ to 20
    equ skey to 21, rkey to 22
* Set up the keys - In QM we can use generic key mapping (YAY)
* but I also like to have default keys
    acts = '' ; keys = ''
* Arrow keys
    acts<-1> = uarr ; keys<-1> = char(205)
    acts<-1> = uarr ; keys<-1> = char(26)
    acts<-1> = darr ; keys<-1> = char(206)
    acts<-1> = darr ; keys<-1> = char(10)
    acts<-1> = larr ; keys<-1> = char(203)
    acts<-1> = larr ; keys<-1> = char(21)
    acts<-1> = rarr ; keys<-1> = char(204)
    acts<-1> = rarr ; keys<-1> = char(6)
* Page movement keys
    acts<-1> = upag ; keys<-1> = char(207)
    acts<-1> = upag ; keys<-1> = char(16)
    acts<-1> = dpag ; keys<-1> = char(208)
    acts<-1> = dpag ; keys<-1> = char(14)
    acts<-1> = lpag ; keys<-1> = char(209)
    acts<-1> = lpag ; keys<-1> = char(1)
    acts<-1> = rpag ; keys<-1> = char(210)
    acts<-1> = rpag ; keys<-1> = char(5)
    acts<-1> = tpag ; keys<-1> = char(214)
    acts<-1> = tpag ; keys<-1> = char(20)
    acts<-1> = bpag ; keys<-1> = char(215)
    acts<-1> = bpag ; keys<-1> = char(2)
* delete character, line, and delete to end of line keys
    acts<-1> = delc ; keys<-1> = char(212)
    acts<-1> = delc ; keys<-1> = char(4)
    acts<-1> = dell ; keys<-1> = char(216)
    acts<-1> = dell ; keys<-1> = char(127)
    acts<-1> = dell ; keys<-1> = char(24)
    acts<-1> = delr ; keys<-1> = char(217)
    acts<-1> = delr ; keys<-1> = char(11)
    acts<-1> = delr ; keys<-1> = char(18) ;* for Wyse terminals
* backspace and carriage return keys
    acts<-1> = back ; keys<-1> = char(008)
    acts<-1> = carr ; keys<-1> = char(013)
* escape, help, Go to line, toggle insert/overwrite mode, save keys
    acts<-1> = escp ; keys<-1> = char(027)
    acts<-1> = escp ; keys<-1> = char(017)
    acts<-1> = phlp ; keys<-1> = char(128)
    acts<-1> = zoom ; keys<-1> = char(007)
    acts<-1> = togg ; keys<-1> = char(211)
    acts<-1> = togg ; keys<-1> = char(009)
    acts<-1> = writ ; keys<-1> = char(129)
    acts<-1> = writ ; keys<-1> = char(023)
* search key, reverse search key
    acts<-1> = skey ; keys<-1> = char(130) ;* F3 for search
    acts<-1> = rkey ; keys<-1> = char(166) ;* shift-F3 for reverse search
    mode = 'LINE'
* The saved stuff
    pres = '' ; look = '' ; stak = ''
    wild = false ; shew = false
    chan = '' ; olda = '' ; cmat = '' ; mmat = ''
    caseflag = false ; spaceflag = true ; blockflag = true
* Save the standard defaults in the session variable if it's not set
$ifdef universe
    if unassigned(edkeep) then edkeep = '0'
$else
    if assigned(edkeep) else edkeep = '0'
$endif
    if edkeep eq '0' then
        edkeep = pres:am:look:am:stak:am:wild:am:chan:am:olda:am:shew
        edkeep := am:cmat:am:mmat:am:not(caseflag):am:not(spaceflag)
        edkeep := am:not(blockflag)
        kept = ''
    end
* Get the 'as-is' settings from the session variable
    pres = edkeep<1>
    look = edkeep<2>
    stak = edkeep<3>
    wild = edkeep<4> ; wild = not(not(wild))
    chan = edkeep<5>
    olda = edkeep<6>
    shew = edkeep<7> ; shew = not(not(shew))
    cmat = edkeep<8>
    mmat = edkeep<9>
    caseflag = not(edkeep<10>)
    spaceflag = not(edkeep<11>)
    blockflag = not(edkeep<12>)
* Get forced default flags
!&&&
! nick = true
!&&&
    read temp from voc, '&ED.OPTIONS' then
        line = upcase(trim(remove(temp, dlim)))
        if line[1,1] eq 'X' then
          loop
              line = upcase(trim(remove(temp, dlim)))
              begin case
                case line[1,8] eq 'BLOCK ON'
                    blockflag = true
                case line[1,9] eq 'BLOCK OFF'
                    blockflag = false
                case line[1,7] eq 'CASE ON'
                    caseflag = true
                case line[1,8] eq 'CASE OFF'
                    caseflag = true
                case line[1,8] eq 'SPACE ON'
                    spaceflag = true
                case line[1,9] eq 'SPACE OFF'
                    spaceflag = true
                case line[1,7] eq 'SHOW ON'
                    shew = true
                case line[1,8] eq 'SHOW OFF'
                    shew = true
              end case
          while dlim repeat
        end
    end
$ifdef universe
    if unassigned(secure) then secure = '0'
$else
    if assigned(secure) else secure = '0'
$endif
    prepprog = '' ; prepflag = false
    postprog = '' ; postflag = false
*********** UniData AE-style security start
$ifdef unidata
    prepprog = getenv('PREPROG_AE_UDT')
$endif
$ifdef universe
    execute 'ENV' capturing temp
    xxno = dcount(temp,am)
    for xx = 1 to xxno
        line = temp<xx>
        if field(line,'=',1) eq 'PREPROG_AE_UDT' then
          prepprog = field(line,'=',2)
          xxno = xx
        end
    next xx
$endif
$ifdef qm
* QM doesn't allow underscores in environmental variables, so
* this is the closest I can get to AE environmental variable name.
    call !atvar(prepprog,'@PREPROG.AE.UDT')
$endif
* These next two tests are from the AE security documentation
* They may not be required, but you can set them up if you want
*    if prepprog[1,3] eq 'AE_' then prepprog = ''
*    if prepprog[len(prepprog)-2,3] ne '_AE' then prepprog = ''
    if prepprog ne '' then prepflag = true
* The following security definitions mirror those of I_AE_SECURITY
* in UniData.  I have only copied the functionality for SEC.SET
* being "NONE" (that is, this user cannot edit) and the general
* disabling of LOAD via the SEC.LOAD.FLG at first call to @PREPPROG;
* and inhibiting of file updates via subsequent @PREPPROG calls.
    dim security(40)
    equ sec.set to security(1) ;* set by preprog on very first call
* These fields are set in preprog
    equ sec.read.flg  to security(2) ;* read ok or not
    equ sec.write.flg  to security(3) ;* write ok or not
    equ sec.delete.flg to security(4) ;* delete ok or not
    equ sec.unload.flg to security(5) ;* unload ok or not
    equ sec.load.flg  to security(6) ;* load ok or not
    equ sec.xeq.flg    to security(7) ;* xeq ok or not
    equ sec.xcom.flg  to security(8) ;* xcoms ok or not
* the following 5 fields pass information to preprog & postprog,
    equ sec.fn        to security(9) ;* file name
    equ sec.id        to security(10);* record id
    equ sec.dir.flg        to security(11);* 1 if file is a directory
    equ sec.newfile.flg    to security(12);* 1 if new file name
    equ sec.active.sel.flg to security(13);* 1 if select list is active
* this is how to make AE stop and return to calling program or ecl
    equ sec.stop.flg  to security(14);* set to 1 to force ae to stop
* for secondary calls to preprog; the first 3 cannot be changed
    equ sec.call2.type to security(15);* 1 load, 2 unload
    equ sec.fn2        to security(16);* second file - for load/unload
    equ sec.id2        to security(17);* second id - for load or unload
    equ sec.ok2.flg    to security(18);* if 1, ok to load/unload
* 19-22 are used by postprog, which I have not implemented
    equ sec.dict.flg  to security(23) ;* 1 if fn is dict ...
    equ sec.dict2.flg to security(24) ;* 1 if fn2 is dict ...
* field 25 is specific to UNIDATA AE, this and all other fields unused
* WARNING: preprog programs should not use the STOP or ABORT statements
*          they should use the SEC.STOP.FLG to end nicely.
*********** UniData AE-style security end
* QM has it's own source control system depending on a callable program
* named SOURCE.CONTROL existing.  It has the following fields
*
* DICT.FLAG    - 'DICT' if a dictionary, otherwise ''
* FILE.NAME    - name of file to be written
* RECORD.NAME  - name of record to be written
* RECORD.DATA  - the record to write
* CALLER        - calling program identifier, I have used '3'
* WRITE.ALLOWED - 1 on call, returns 1 if write allowed and 0 otherwise
* UPDATED      - 0 on call, returns 1 if RECORD.DATA is changed
    source.control = false
$ifdef qm
    if catalogued('SOURCE.CONTROL') then source.control = true
$else
* We can implement QM-style security if we want
    if prepprog eq 'SOURCE.CONTROL' then source.control = true
$endif
    if source.control then prepflag = false ; prepprog = ''
    name = @logname
    levl = @level
    path = @path
    term = @tty
    whom = @userno
    acct = @who
* This is to display unprintable characters safely
    badc = char(255)
    for xx = 0 to 31    ; badc := char(xx) ; next xx
    for xx = 127 to 250 ; badc := char(xx) ; next xx
    gudc = str('~',len(badc))
* eeePC does not distinguish between these
    if index(upcase(system(7)),'EEEPC',1) then
        badc := char(251):char(252):char(253); gudc := '[\]'
    end else
        badc := char(251):char(252):char(253)
        gudc := char(179):char(178):char(185)
    end
* The yes/no can be language independant!
    yes = 'Yes' ; yes = upcase(trim(yes))
    no = 'No' ; no = upcase(trim(no))
    ny = '(':no[1,1]:'/':yes[1,1]:') >'
* Want to see these thing in a single page
    presnumb = system(3)-2
    if presnumb gt 20 then presnumb = 20
    looknumb = presnumb; channumb = presnumb
* Want this to be no more than five pages
    staknumb = (presnumb+1)*5+1
* Parse the command line - long way in before work starts, eh?
* Anything in brackets is an option - but we do not use them at all.
* "verb" is how this was called so it should work to call again
    verb = ''
$ifdef qm
$include parser.h
    call !parser(parser$reset, 0, @sentence, 0)
    opts = false
    options = ''
    sentence = ''
    loop
        call !parser(parser$get.token, type, param, keyword)
    until type eq parser$end do
        begin case
          case type eq 4 ; opts = true
          case type eq 5 ; opts = false
          case opts      ; options<-1> = param
          case 1        ; sentence<-1> = param
        end case
    repeat
$else
    rest = @sentence
    keepquot = false
    gosub parse.rest
    sentence = bite
    temp = dcount(sentence,am)
    options = sentence<temp>
    if options[1,1] eq '(' then
        options = field(field(options,'(',2),')',1)
        sentence = delete(bite,temp,0,0)
    end else options = ''
$endif
if options ne '' then options = ' (':options:')'
* The C option allows the user to build paragraphs
* using DATA statements to control the editor.
* Otherwise they are restricted to an interactive mode.
    if index(upcase(options),'C',1)
        then editpage = false
        else editpage = true
    if upcase(sentence<1>) eq 'RUN' then
        verb = sentence<1>:' ':sentence<2>:' '
        sentence = delete(sentence,1,0,0)
        sentence = delete(sentence,1,0,0)
    end
    verb = verb:sentence<1>
    sentence = delete(sentence,1,0,0)
* Check if a viewing verb has been used
* If so, we can turn off both security systems (I mope I'm right!)
* The security flags are set safe, and each command is tested
* individually, so I think it's pretty safe.
* FORMAT is still allowed, but no other change command.
    viewflag = false ; view = 'edit'
    locate(upcase(verb),viewverb;posn) then
        viewflag = true
        view = 'view'
        source.control = false
        prepflag = false
    end
* OR, they used the V option
    if index(upcase(options),'V',1) then
        viewflag = true
        view = 'view'
        source.control = false
        prepflag = false
    end
* HELP location
    help.def = '2.00'
    help = ''
    pagehelp = ''
    fnam = sentence<1>
    sentence = delete(sentence,1,0,0)
    if upcase(fnam) eq 'DICT' then
        fnam = 'DICT ':sentence<1>
        sentence = delete(sentence,1,0,0)
    end
    idlist = sentence
    if system(11) and idlist ne '' then
        crt 'A select list was active, but specific ids were entered.'
        crt 'Select list will be ignored.'
        crt str('-',len('Select list will be ignored.'))
        clearselect
    end
    open 'AE_COMS' to acom else
$ifdef qm
        execute 'CREATE.FILE AE_COMS'
$else
        execute 'CREATE.FILE AE_COMS 1 7'
$endif
        open 'AE_COMS' to acom else stop 'Cannot open ':'AE_COMS'
        test = @(0,0)
    end
* Get file
    loop
        got.file = false
        if fnam eq '' then
          stub = 'File name? '
          gosub get.rope; fnam = rope; crt
        end
        if fnam eq '' then stop
        dprt = field(fnam,' ',1)
        fprt = field(fnam,' ',2)
        if fprt eq '' then fprt = dprt ; dprt = ''
        open dprt, fprt to file then
          got.file = true
        end else
          open upcase(dprt),upcase(fprt) to file then
              got.file = true
          end else
              crt 'Cannot open ':'"':fnam:'"'
              fnam = ''
          end
        end
    until got.file do
    repeat
    if fileinfo(file,3) eq '4' then bleach = false else bleach = true
    bleach = upcase(fileinfo(file,2))
    if bleach[2] = 'BP' or bleach[7] = 'SFPROGS'
        then bleach = false
        else bleach = true
* Get the record
    if idlist eq '*' then
        idlist = ''
        execute 'SELECT ':dprt:' ':fprt
        test = @(0,0)
    end
    if system(11) then
        eof = false
        loop
          readnext id else eof = true
        until eof do
          idlist<-1> = id
        repeat
    end
    loop
        killsign = false
        if idlist eq '' then
          stub = 'Record name? '
          gosub get.rope; rest = rope ; crt
          keepquot = false
          gosub parse.rest
          idlist = bite
          bite = '' ; rest = ''
        end
        idcnt = dcount(idlist,am)
        for id = 1 to idcnt until killsign
          item = idlist<id>
          gosub edit.item
        next id
    while killsign do
        idlist = ''
    repeat
    edkeep = pres:am:look:am:stak:am:wild:am:chan:am:olda:am:shew
    edkeep := am:cmat:am:mmat:am:not(caseflag):am:not(spaceflag)
    edkeep := am:not(blockflag):am:lower(kept)
    stop
* SUBROUTINES
* ***********
edit.item:
    stopsign = false
    here = 0 ; dnum = 0
    beg = 0 ; fin = 0 ; krj = ''
    crt
    if idcnt gt 1 then crt '<':id:'/':idcnt:'> ':
    if prepflag then
        if secure eq '0' then
          mat security = ''
          sec.set = ''
          call @prepprog(mat security)
          if sec.set eq 'NONE' then stop
          if sec.stop.flg then stop
          secure = sec.set
        end
        mat security = ''
        sec.set = secure
        if sec.set then
          sec.fn = fprt
          sec.id = item
          sec.dir.flg = fileinfo(file,3) = '4'
          sec.newfile.flg = false
          sec.active.sel.flg = false
          sec.dict.flg = (dprt = 'DICT')
          call @prepprog(mat security)
          if sec.stop.flg then stop
          if not(sec.read.flg) then return
        end
    end else
        sec.stop.flg = false
        sec.read.flg = true
        sec.write.flg = true
        sec.delete.flg = true
        sec.xcom.flg = true
        sec.unload.flg = true
        sec.load.flg = true
        sec.xeq.flg = true
        sec.ok2.flg = true
* Apply the viewing flag
        if viewflag then
          crt 'VIEW ONLY - NO UPDATES ALLOWED'
          sec.write.flg = false
          sec.delete.flg = false
          sec.xcom.flg = false
          sec.unload.flg = false
          sec.load.flg = false
          sec.xeq.flg = false
          sec.ok2.flg = false
        end
    end
    readu this from file, item locked goto locked.record then
        lock = true
carry.on:
        gosub parse.record
        crt 'Top of "':item:'" in "':fnam:'", ':last:' lines, ':len(this):' characters.'
    end else
        lock = true
        this = ''
        gosub parse.record
        crt 'Top of new "':item:'" in "':fnam:'".'
    end
    orig = this
    gosub get.lfmt
* Edit the record
    loop
        if mode<1> eq 'PAGE' then
          pcol = rem(pchr-1,span)
          prow = here+1-ptop
          crt @(60,0):ceol:revb:mode<2>:revf:' ':fmt(here,'R#4'):
          crt ',':fmt(pchr,'L#4'):
          bite = temp[pchr,1]
          if bite ne '' then crt ' (':seq(bite):')':
          crt @(pcol,prow):
          gosub get.page.comd
          if mode eq 'LINE' then
              crt bott:'Line Editor Mode':
              if that ne this then
                crt ' - CHANGES HAVE BEEN MADE':
                oops = that ; oopc = 'PE'
                oopl = savl<1> ; oopf = savl<2>
                oopb = beg:am:fin ; oopk = krj
              end
              crt
              that = ''
              gosub display.line
          end
        end
        if mode<1> eq 'LINE' then
* Get the command
          if x$cc ne '' then
              comi = x$cc<1>
              x$cc = delete(x$cc,1,0,0)
          end else
              if mode<1> eq 'PAGE' then continue
              if salt ne '' then
                comi = salt<1,1,1>; del salt<1,1,1>
              end else
                stub = prmt:': '; heap = true
                gosub get.rope; comi = rope; heap = false
              end
              if macn then macc<1,1,-1> = comi
          end
          gosub parse.command
          if not(numb eq '' or numb matches '1N0N') then
              crt ; gosub bad.command
              continue
          end
          if comd eq '' then
              gosub null.command
              if comd eq '' then continue
          end
* Save command to list
          if comi ne '' and comi ne stak<1,1> and comd ne 'D' then
              stak = insert(stak,1,1,0,comi)
              stak = delete(stak,1,staknumb,0)
          end
* Apply the command
          if comd ne 'R' then crt
          if comd matches '1N0N' then
              here = comd
              if here gt last then here = last
              gosub display.line
              continue
          end
          loop
              redo = false
              first = comd[1,1]
              posn = index('ABCDEFGHIJKLMNOPQRSTUVWXYZ',first,1)
              on posn gosub a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z
          while redo do repeat
          if stopsign then release file, item ; lock = false ; return
        end
    repeat
    return
parse.command:
    comi = trimf(comi)
    dlim = oconv(oconv(comi,'MC/A'),'MC/N')[1,1]
    if dlim eq '' then
        rest = ''
        comd = upcase(comi)
    end else
        posn = index(comi,dlim,1)
        rest = comi[posn+1,huge]
        comd = upcase(comi[1,posn-1])
    end
    temp = oconv(comd,'MCN')[1,1]
    if temp ne '' then
        temp = index(comd,temp,1)
        numb = comd[temp,huge]
        comd = comd[1,temp-1]
    end else numb = ''
    return
parse.line:
    if line eq comdmark then line = ''
    xx = 1
    loop
        temp = index(line,'^',xx)
    while temp do
        bite = line[temp,5]
        if bite matches '"^^"3N' then
          line = line[1,temp-1]:line[temp+1,len(line)]
          xx += 1
        end else
          bite = bite[1,4]
          if bite matches '"^"3N' then
              line= line[1,temp-1]:char(bite[2,3]):line[temp+4,len(line)]
          end else xx += 1
        end
    repeat
    return
a:  begin case
        case comd eq 'A'                ; * append
          if viewflag then gosub viewonly ; return
          if rest eq '' then rest = olda<1,1>
          if rest eq '' then
              crt 'No previous append command to repeat'
              gosub bad.comd
              return
          end
          olda = rest:vm:dlim
          line = rest ; gosub parse.line ; rest = line
          chng = 0 ; save = here ; savl = last
          dnum = 1
          gosub set.bounds
          for here = dawn to dusk
              gosub get.line
              line = line:rest
              if not(chng) then gosub savethis
              memr(cell)<lnum> = line
              chng += 1
              if shew or dnum lt plen then gosub display.line
          next here
          here = dusk
          if chng then
              gosub reset.record
              crt chng:' lines changed - now at ':here
          end
        case 1 ; gosub bad.command
    end case
    return
b:  begin case
        case comd eq 'B' and dlim eq ''  ; * bottom
          here = last ; gosub display.line
        case index('\B\BD\BK\BR\BS\','\':comd:'\',1)  ; * break line
          if viewflag then gosub viewonly ; return
          if rest eq '' then
              crt 'The second field is empty.'
              gosub bad.comd
              return
          end
          chng = 0 ; save = here ; savl = last ; show = ''
          gosub set.bounds
          for here = dusk to dawn step -1
              gosub get.line
              posn = index(line,rest,1)
              if posn then
                left = line[1,posn-1]
                temp = line[posn+len(rest),len(line)]
                if temp ne '' or comd eq 'BS' then
                    begin case
                      case comd eq 'BD' ; line = left:rest
                      case comd eq 'BK' ; line = temp
                      case comd eq 'BR' ; line = temp:left:rest
                      case comd eq 'BS' ; line = temp:rest:left
                      case 1 ; line = left:rest
                    end case
                    memr(cell)<lnum> = line
                    show = insert(show,1,0,0,here)
                    numb += 1
                    chng += 1
                    if comd eq 'B' then
                      dusk += 1
                      last += 1
                      lnum += 1
                      line = temp
                      gosub insert.line
                    end
                end
              end
          next here
          if chng then
              gosub savethis
              gosub reset.record
              zzno = dcount(show,am)
              savl = 0 ; dnum = 1
              for zz = 1 to zzno
                here = show<zz> + savl
                if shew or dnum lt plen then gosub display.line
                if comd eq 'B' and zzno gt 1 then
                    here += 1
                    savl += 1
                    if shew or dnum lt plen then gosub display.line
                end
              next zz
              show = ''
          end
          if comd eq 'B'
              then here = dusk + numb - 2
              else here = dusk
          if here gt last then here = last
          if chng then
              crt 'Split ':numb:' records.  Now at line ':here
          end
          gosub get.line
      case index('\BC\BCD\BCK\BCR\BCS\','\':comd:'\',1)  ; * Break @ Column
          if viewflag then gosub viewonly ; return
          posn = trim(field(rest,dlim,1))
          if not(posn matches '1n0n') then
            crt 'No column position given'
            gosub bad.comd
            return
          end
          chng = 0 ; save = here ; show = ''
          gosub set.bounds
          for here = dusk to dawn step -1
            gosub get.line
            if len(line) gt posn then
                left = line[1,posn-1]
                temp = line[posn+1,len(line)]
                if temp ne '' or comd eq 'BCS' then
                  begin case
                      case comd eq 'BCD' ; line = left:rest
                      case comd eq 'BCK' ; line = temp
                      case comd eq 'BCR' ; line = temp:left:rest
                      case comd eq 'BCS' ; line = temp:rest:left
                      case 1 ; line = left:rest
                  end case
                  memr(cell)<lnum> = line
                  show = insert(show,1,0,0,here)
                  numb += 1
                  chng += 1
                  if comd eq 'BC' then
                      dusk += 1
                      last += 1
                      lnum += 1
                      line = temp
                      gosub insert.line
                  end
                end
            end
          next here
          if chng then
              gosub savethis
              gosub reset.record
              zzno = dcount(show,am)
              savl = 0 ; dnum = 1
              for zz = 1 to zzno
                here = show<zz> + savl
                if shew or dnum lt plen then gosub display.line
                if comd eq 'BC' and zzno gt 1 then
                    here += 1
                    savl += 1
                    if shew or dnum lt plen then gosub display.line
                end
              next zz
              show = ''
          end
          if comd eq 'BC'
              then here = dusk + numb - 2
              else here = dusk
          if here gt last then here = last
          if chng then
              crt 'Split ':numb:' records.  Now at line ':here
          end
          gosub get.line
        case comd eq 'BLEACH'              ; * change BLEACH flag
          rest = upcase(rest)
          begin case
              case rest eq 'ON' ; bleach = true
              case rest eq 'OFF' ; bleach = false
              case 1 ; bleach = not(bleach)
          end case
          if bleach
              then crt 'Colours disabled'
              else crt 'Colours enabled'
        case comd eq 'BLOCK'              ; * change BLOCK flag
          rest = upcase(rest)
          begin case
              case rest eq 'ON' ; blockflag = true
              case rest eq 'OFF' ; blockflag = false
              case 1 ; blockflag = not(blockflag)
          end case
          if blockflag then
              crt 'Verification of block actions enabled'
          end else crt 'Verification of block actions disabled'
        case 1 ; gosub bad.command
    end case
    return
c:  begin case
        case comd eq 'C'                ; * change
          if viewflag then gosub viewonly ; return
          if numb eq '' and dlim eq '' then
              comd = 'RA'
              comi = 'RA1'
              numb = 1
          end
          gosub change.command
        case comd eq 'CAT' ; comd = 'J' ; redo = true
        case comd eq 'CASE'              ; * change casing flag for 'L'
          rest = upcase(rest)
          begin case
              case rest eq 'ON' ; caseflag = true
              case rest eq 'OFF' ; caseflag = false
              case 1 ; caseflag = not(caseflag)
          end case
          if caseflag then
              crt 'Searches are case-sensitive'
          end else crt 'Searches are not case-sensitive'
        case comd eq 'CD'        ; * command delimiter display (change)
          if dlim eq '' then
              crt 'Command delimiter is ':
          end else
              temp = '`,;#$%&~|[]{}/"':"'"
              if index(temp,dlim,1) then
                comdmark = dlim
                crt 'Command delimiter is ':
              end else
                crt dlim:' is not a valid command delimiter.'
                crt 'Characters available for delimiters: ':temp
                crt 'Characters reserved for other uses: \.*!?-+=^@<>_:'
                crt 'Command delimiter is ':
              end
          end
          if comdmark eq '"'
              then crt "'":comdmark:"'"
              else crt '"':comdmark:'"'
        case comd eq 'CLEAR'            ; * Clear the kept buffer
          if kept eq ''
              then crt 'Nothing in KEPT buffer'
              else crt 'KEPT buffer cleared'
          kept = ''
        case comd = 'COPY'                  ; * copy to kept buffer
          if comd eq upcase(comi) then
              if not(beg) and not(fin) then
                crt 'Command requests a block operation, but no block is defined.'
                gosub bad.comd; return
              end
              rest = beg
              numb = fin-beg+1
          end
          rest = trim(rest)
          if numb eq '' then gosub parse.atts
          if rest eq '' then rest = here
          if not(rest matches '1N0N') or numb eq '' then
              crt 'Formats are: "COPY" (from <> block) or "COPYn" or "COPYn/s" or "COPY/s/f".'
              gosub bad.comd ; return
          end
          if numb lt 1 then
              crt 'Nothing done - no lines selected.'
              comi = ''; return
          end
          if numb gt last then
              crt 'Nothing done - record does not have that many lines.'
              comi = '' ; return
          end
          kept = field(this,am,rest,numb)
          numb = dcount(kept,am)
          if numb then crt numb:' lines copied to KEPT buffer starting at line ':rest
        case comd eq 'CM'                ; * changematch command
          if viewflag then gosub viewonly ; return
          if rest eq '' then
              if cmat eq '' then
                crt 'No previous ChangeMatch command to repeat.'
                comi = ''
                return
              end else
                dlim = cmat<1,1>
                rest = cmat<1,2>
                numb = cmat<1,3>
              end
          end
          gosub changematch.command
        case comd eq 'COL'              ; * column display
          temp = ''
          for xx = 1 to 9
              temp = temp:space(9):xx
          next xx
          if lfmt
              then crt begn:space(llen+2):temp[1,span-llen-2]
              else crt begn:temp[1,span]
          temp = str('1234567890',10)
          if lfmt
              then crt begn:space(llen+2):temp[1,span-llen-2]
              else crt begn:temp[1,span]
          temp = ''
        case comd eq 'COUNT'            ; * show the count of a string
          line = rest ; gosub parse.line ; rest = line
          if rest eq '' then
              crt 'No string given to count'
              gosub bad.comd ; return
          end
          gosub set.bounds
          if not(caseflag) then rest = upcase(rest)
          temp = 0
          for here = dawn to dusk
              gosub get.line
              if caseflag
                then temp = temp + count(line,rest)
                else temp = temp + count(upcase(line),rest)
          next here
          here = dusk
          crt temp:' occurances of string.'
        case comd eq 'CRT'          ; * insert crt line for programmer
          if viewflag then gosub viewonly ; return
          if rest eq '' then
              crt 'You have not said what to put on CRT line!'
              comi = ''
              return
          end
          gosub savethat
          here += 1 ; last += 1 ; lnum += 1
          if dlim ne '"' and dlim ne '\' then dlim = "'"
          line = 'CRT ':dlim:rest:' = ':dlim:':':rest
          gosub insert.line
          gosub reset.record
          gosub display.line
        case comd eq 'CUT'              ;* Move lines to kept buffer
          if viewflag then gosub viewonly ; return
          if comd eq upcase(comi) then
              if not(beg) and not(fin) then
                crt 'Command requests a block operation, but no block is defined.'
                gosub bad.comd; return
              end
              rest = beg
              numb = fin-beg+1
          end
          rest = trim(rest)
          if numb eq '' then gosub parse.atts
          if rest eq '' then rest = here
          if not(rest matches '1N0N') or numb eq '' then
              crt 'Formats are: "CUT" (from <> block) or "CUTn" or "CUTn/s" or "CUT/s/f".'
              gosub bad.comd; return
          end
          if numb gt last then
              crt 'Nothing done - record does not have that many lines.'
              comi = '' ; return
          end
          kept = field(this,am,rest,numb)
          numb = dcount(kept,am)
          dawn = rest
          dusk = rest+numb-1
          gosub delete.lines
          if numb then crt numb:' lines moved to KEPT buffer starting at line ':rest
        case 1 ; gosub bad.command
    end case
    return
d:  begin case
        case comd eq 'D'                ; * display current line
          if here gt last then here = last
          gosub display.line
        case comd eq 'DE'                ; * delete lines
          if viewflag then gosub viewonly ; return
          chng = 0 ; save = here ; savl = last
          if rest ne '' then
              patt = rest
              cto = ''
              cfrom = 'DE'
              gosub cm.del.entry
              return
          end
          gosub set.bounds
          gosub delete.lines
          here = dawn
          if here gt last then
              here = last
              crt 'Bottom. Line ':here:' was above the last delete.'
          end else
              crt 'At line ':here:'. Deleted ':chng:' lines.'
              gosub display.line
          end
$ifdef qm
        case comd eq 'DISPLAY'    ; * insert display line for programmer
          if viewflag then gosub viewonly ; return
          if rest eq '' then
              crt 'You have not said what to put on DISPLAY line!'
              comi = ''
              return
          end
          gosub savethat
          here += 1 ; last += 1 ; lnum += 1
          if dlim ne '"' and dlim ne '\' then dlim = "'"
          line = 'DISPLAY ':dlim:rest:' = ':dlim:':':rest
          gosub insert.line
          gosub reset.record
          gosub display.line
$endif
        case comd eq 'DROP'              ; * remove the block
          if viewflag then gosub viewonly ; return
          if not(beg) and not(fin) then
              crt 'Command requests a block operation, but no block is defined.'
              gosub bad.comd ; return
          end
          if beg le 1 then
              temp = 0
          end else
              temp = index(this,am,beg-1)
              if not(temp) then
                crt 'Error - Block start line not defined' ; *Cannot find beginning of block
                gosub bad.comd ; return
              end
          end
          if fin eq last then
              temp -= 1
              temp<2> = len(this)
          end else
              temp<2> = index(this,am,fin)
          end
          if not(temp<2>) then
              crt 'Error - Block end line not defined' ; *Cannot find end of block
              gosub bad.comd ; return
          end
          numb = fin - beg + 1
          if blockflag then
              if beg eq fin
                then stub = 'Delete line ': beg:' '
                else stub = 'Delete block from line ': beg:' to line ': fin:'? '
              gosub get.answ
              if answ ne yes[1,1] then
                crt 'Block command cancelled.'
                return
              end
          end
          dawn = beg; dusk = fin
          gosub delete.lines
          crt 'Dropped (deleted) ':numb:' lines.'
          gosub display.line
        case comd eq 'DTX'              ; * decimal to hex
          if not(rest matches '1N0N') then
              crt 'Numeric value required'
              gosub bad.comd ; return
          end
          if len(rest) gt 9 then
              crt 'Must be less than one billion (1,000,000,000)'
              gosub bad.comd ; return
          end
$ifdef universe
          crt dtx(rest)
$else
          crt oconv(rest,'MX')
$endif
        case comd eq 'DUP'              ; * duplicate previous line
          if viewflag then gosub viewonly ; return
          if here lt 1 then
              crt 'No current line'
              gosub bad.comd ; return
          end
          if numb eq '' and rest matches '1N0N' then numb = rest
          if numb lt 1 then numb = 1
          gosub savethat
          gosub get.line
          for xx = 1 to numb
              gosub insert.line
              last += 1
          next xx
          gosub reset.record
          crt 'Inserted ':numb:' copies of line ':here:' after line ':here:'. Still at ':here:'.'
        case 1 ; gosub bad.command
    end case
    return
e:  begin case
        case comd eq 'EC'        ; * edit called program (in this file)
          if here lt 1 then here = 1
          gosub get.line
          line = trim(line)
          temp = upcase(line)
          good = index(temp,'CALL ',1)
          if good then line = trim(line[good+5,huge])
          line = trim(field(line,'(',1))
          if index(line,' ',1) then good = false
          if line[1,1] eq '@' then
              crt 'Leading "@" is logical pointer'
              good = false
          end
          if not(good) then
              crt 'The EC command requires lines in format "CALL ID" or "CALL ID(..."'
              gosub bad.comd ; return
          end
*          readv temp from file, line, 1 else
*              crt '"':line:'" is not in this file'
*              gosub bad.comd ; return
*          end
*          execute verb:' ':fnam:' ':line
          readv temp from file, line, 1 then
              execute verb:' ':fnam:' ':line:options
          end else
              test = false
              readv vlin from voc, line, 2 then
                vcnt = dcount(vlin,'/')
                vlin = field(vlin,'/',vcnt-1)
                vlin = vlin[1,len(vlin)-2]
                test = trans(vlin,line,-1,'X')
              end
              if test then
                execute verb:' ':vlin:' ':line:options
              end else
                crt '"':line:'" is not in this file'
                gosub bad.comd ; return
              end
          end
***
          test = @(0,0)
          crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
        case comd = 'ECS'        ; * edit command stack
          ttid = whom:'_':levl:'_commands'
          temp = raise(stak)
          write temp on acom, ttid on error crt 'WRITE failure - file not updated' ; return
          crt view:'ing command stack'
          execute verb:' AE_COMS ':ttid:options
          test = @(0,0)
          crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
          read temp from acom, ttid else temp = ''
          temp = field(temp,am,1,staknumb-1)
          stak = lower(temp)
          delete acom, ttid
        case comd eq 'EDITPAGE'
          editpage = not(editpage)
*>
          if editpage then
              begn = @(0) ; goup = @(-10)
              prmt = '*':str('-',llen-1)
          end else
              begn = char(13) ; goup = ''
              prmt = str('-',llen)
          end
          crt 'editpage = ':editpage
*>
        case comd eq 'EF'        ; * edit fields
          numb = numb + 0
          if numb lt 0 or numb gt 255 then
              crt numb:' is outside range 0-255'
              comi = ''
              return
          end
          vmrk = char(numb)
          vals = 'char':numb
          gosub edit.fields
          vmrk = char(numb); gosub reset.fields
        case comd eq 'EI'        ; * edit included code
          if here lt 1 then here = 1
          gosub get.line
          line = field(line,';',1)
          line = trim(line)
          good = true
          temp = field(line,' ',1)
          temp = upcase(temp)
          if temp ne 'INCLUDE' and temp ne '$INCLUDE' then good = false
          line = trim(line[len(temp)+1,len(line)])
          begin case
              case dcount(line,' ') gt 3 ; good = false
              case dcount(line,' ') eq 3
                if field(line,' ',1) ne 'DICT' then good = false
              case dcount(line,' ') eq 1
                readv test from file, line, 1 then
                    line = fnam:' ':line
                end else
                    test = trans('SYSCOM',line,1,'X')
                    if test ne ''
                      then line = 'SYSCOM ':line
                      else line = fnam:' ':line
                end
          end case
          if not(good) then
              crt 'The EI command requires lines in format "$IN... {DICT} {FN} ID"'
              gosub bad.comd ; return
          end
          execute verb:' ':line:options
          test = @(0,0)
          crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
        case comd eq 'EIT'      ; * edit i-types (@)
          if dprt and here eq 2 and upcase(this[1,1]) else
              crt 'EIT is only for line 2 of a dictionary I-type'
              return
          end
          gosub get.line ; temp = line
          gosub split.itype
          ttid = whom:'_':levl:'_IType.in.line#':here
          write bite on acom, ttid on error gosub writerr ; return
          crt view:'ing IType as fields...':
          execute verb:' AE_COMS ':ttid:options
          test = @(0,0)
          crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
          read line from acom, ttid else line = ''
          delete acom, ttid
          vmrk = ';'; gosub reset.fields
*      case comd eq 'EM'        ; * edit MESSAGES
*          if numb eq '' and rest matches '1N0N' then numb = rest
*        if numb then
*            execute verb:' MESSAGES ':numb:options
*          end else
*            if here lt 1 then here = 1
*            gosub get.line
*            line = trim(line)
*            temp = upcase(line)
*            good = index(temp,'SYSMSG',1)
*            if good then line = trim(line[good+6,huge])
*            line = trim(field(line,'(',2))
*            line = trim(field(field(line,')',1),',',1))
*            if not(line matches '1N0N') then good = false
*            if not(good) then
*                crt 'The EM command requires lines in format "...sysmsg(1N0N..."'
*                crt 'Or a command like EMnnnn (nnnn is a message number)'
*                gosub bad.comd ; return
*            end
*            execute verb:' MESSAGES ':line:options
*          end
*          test = @(0,0)
*          crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
        case comd = 'EK'        ; * edit kept buffer
          ttid = whom:'_':levl:'_keptbuffer'
          write kept on acom, ttid on error crt 'WRITE failure - file not updated' ; return
          crt view:'ing kept buffer':
          execute verb:' AE_COMS ':ttid:options
          test = @(0,0)
          crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
          read kept from acom, ttid else kept = ''
          delete acom, ttid
        case comd = 'EPR'        ; * edit prestores
          numb = numb + 0
          if numb lt 0 or numb gt presnumb then
              crt 'PRestore must be in range 1-':presnumb:'.'
              gosub bad.comd ; return
          end
          ttid = whom:'_':levl:'_prestores'
          temp = raise(pres)
          if numb then
              bite = raise(temp<numb>)
              write bite on acom, ttid on error crt 'WRITE failure - file not updated' ; return
              crt view:'ing prestore ':view:
          end else
              write temp on acom, ttid on error crt 'WRITE failure - file not updated' ; return
              crt view:'ing prestores':
          end
          execute verb:' AE_COMS ':ttid:options
          test = @(0,0)
          crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
          if numb then
              read bite from acom, ttid else bite = ''
              temp<numb> = lower(bite)
          end else
              read temp from acom, ttid else temp = ''
          end
          pres = lower(temp)
          delete acom, ttid
        case comd = 'ESS'        ; * edit search stack
          ttid = whom:'_':levl:'_searches'
          temp = raise(look)
          write temp on acom, ttid on error crt 'WRITE failure - file not updated' ; return
          crt view:'ing search stack':
          execute verb:' AE_COMS ':ttid:options
          test = @(0,0)
          crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
          read temp from acom, ttid else look = ''
          look = lower(temp)
          delete acom, ttid
        case comd eq 'ESV'      ; * edit subvalues
          vmrk = sm ; vals = 'subvalues'
          gosub edit.fields
          vmrk = sm; gosub reset.fields
        case comd eq 'ET'        ; * edit tabs
          ttid = whom:'_':levl:'_tabs'
          xxno = dcount(krj<1>,@vm)
          temp = ''
          for xx = 1 to xxno
              temp<xx> = krj<2,xx>:' ':krj<1,xx>
          next xx
          write temp on acom, ttid on error crt 'WRITE failure - file not updated' ; return
          crt view:'ing line tabs':
          execute verb:' AE_COMS ':ttid:options
          test = @(0,0)
          crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
          read temp from acom, ttid else temp = ''
          xxno = dcount(temp,@am)
          krj = @am:@am:krj<3>
          yy = ''
          for xx = 1 to xxno
              bite = trim(temp<xx,1,1>)
              left = field(bite,' ',1)
              rest = field(bite,' ',2,99)
              if left matches '1N0N' then left += 0 else left = 0
              if left gt last then left = 0
              if left then
                yy += 1
                if rest eq '' then rest = 'T':left
                krj<1,yy> = rest
                krj<2,yy> = left
              end
          next xxno
          if krj<3> gt yy then krj<3> = yy
          if krj<1> ne '' and krj<3> lt 1 then krj<3> = 1
          delete acom, ttid
        case comd eq 'EV'        ; * edit values
          vmrk = vm ; vals = 'values'
          gosub edit.fields
          vmrk = vm; gosub reset.fields
        case comd eq 'EW'        ; * edit words (as defined by wordmark)
          vmrk = wordmark ; vals = 'words'
          gosub edit.fields
          vmrk = wordmark; gosub reset.fields
* Various forms for quitting
        case comd eq 'EX' or comd = 'EXIT' ; comd = 'Q' ; redo = true
        case comd eq 'EXK' or comd = 'EXITK' ; comd = 'QK' ; redo = true
        case 1 ; gosub bad.command
    end case
    return
f:  begin case
        case comd eq 'FD'                ; * delete item
          if viewflag then gosub viewonly ; return
          if not(sec.delete.flg) then
              crt 'Delete disabled'
              comi = ''
              return
          end
          gosub write.record
        case comd eq 'FILE' ; comd = 'SV' ; redo = true
        case comd[1,2] eq 'FI'          ; * file item
          if viewflag then gosub viewonly ; return
          if not(sec.write.flg) then
              crt 'File disabled'
              comi = ''
              return
          end
          temp = comd[3,len(comd)]
          convert 'BCRDL' to '' in temp
          if temp eq '' then gosub write.record else gosub bad.command
        case comd eq 'FL' or comd eq 'FLA'  ; * find labels
          if not(caseflag) then rest = upcase(rest)
          if index(comd,'A',1) then
              bump = -1
              dawn = here - 1
              if dawn lt 1 then return
              if numb then dusk = here - numb else dusk = 1
              if dusk lt 1 then dusk = 1
          end else
              bump = 1
              dawn = here + 1
              if dawn gt last then dawn = 1
              if numb then dusk = dawn + numb else dusk = last
              if dusk gt last then dusk = last
          end
          for here = dawn to dusk step bump
              gosub get.line
              gosub find.label
              if not(caseflag) then temp = upcase(temp)
              if temp ne '' then
                if rest eq '' or temp matches rest then
                    gosub display.line
                    if not(numb) then return
                end
              end
          next here
          crt
          gosub display.line
        case comd eq 'FM' or comd eq 'FMA'      ; * find match command
          gosub get.line
* Get rid of any label
          gosub find.label
          thisline = trimf(line)
          if temp ne '' then
              thisline = thisline[len(temp)+1,huge]
              if thisline[1,1] eq ':' then thisline = thisline[2,huge]
              thisline = trimf(thisline)
          end
* Get the first word on the line
          word = field(trim(upcase(thisline)),' ',1)
          begin case
              case rest ne ''
                seek = upcase(rest)
              case word[1,1] eq '*' or word[1,1] eq '!'
                seek = word[1,1]
              case 1
                locate(word,fm.words;posn) then
                    if index(comd,'A' ,1) then
                      seek = fm.finda<posn>
                    end else
                      seek = fm.findf<posn>
                    end
                end else
                    locate(word,endwords;posn) then
                      seek = 'END'
                    end else
                      crt 'Starting word "':word:'" unknown'
                      gosub bad.comd ; return
                    end
                end
          end case
          if seek eq '' then
              crt word:' has no matching word for ':comd
              gosub bad.comd ; return
          end
          posn = index(upcase(line),word,1)
          xxno = dcount(seek,vm)
          for xx = 1 to xxno
              seek<1,xx> = space(posn-1):seek<1,xx>
          next xx
          if index(comd,'A',1) then
              bump = -1
              dawn = here - 1
              if dawn lt 1 then return
              dusk = 1
          end else
              bump = 1
              dawn = here + 1
              if dawn gt last then return
              dusk = last
          end
          save = here
          for here = dawn to dusk step bump
              gosub get.line
              line = upcase(line)
              if line[1,1] ne '' then
                temp = field(line,' ',1)
                if num(temp) or temp[len(temp),1] eq ':' then
                    temp = len(temp)
                    line = space(temp):line[temp+1,len(line)]
                end
              end
              for xx = 1 to xxno
                slen = len(seek<1,xx>)
                if line[1,slen] eq seek<1,xx> then
                    if trim(line[slen+1,1]) eq '' then
                      gosub display.line
                      return
                    end
                end
              next xx
          next here
          here = save
          gosub get.line
        case comd eq 'FOLD'              ; * fold the line
          if viewflag then gosub viewonly ; return
          chng = 0 ; save = here ; savl = last
          if dlim ne '' then fold = ''
          if rest eq '' then rest = fold
          if rest eq '' then rest = span-llen-2
          if not(rest matches '1N0N') then
              crt 'Non-numeric length - try HELP FOLD.'
              comi = ''
              return
          end
          fold = rest
          gosub get.line
          crt 'FOLD line to length ':fold
          bite = line
          gosub parse.bite
          gosub check.line
          if chng then gosub reset.record
        case comd eq 'FOR' or comd eq 'FORMAT'      ; * format this item
          rest = upcase(rest)
          temp = index(rest,'-M',1)
          if temp then fr(1) = field(rest[temp+2,huge],' ',1) ; fr(2) = ''
          if not(fr(1) matches '1N0N') then fr(1) = ''
          if fr(1) eq '' then
              temp = this<1>
              fr(1) = len(temp) - len(trimf(temp))
          end
          temp = index(rest,'-I',1)
          if temp then fr(2) = field(rest[temp+2,huge],' ',1)
          if not(fr(2) matches '1N0N') then fr(2) = ''
          if fr(2) eq '' then
              fr(2) = int((fr(1)+1)/2)
              if fr(2) lt 2 then fr(2) = 2
          end
          if index(rest,'-A',1) then fr(9) = true else fr(9) = ''
          if index(rest,'-N',1) then fr(10) = true else fr(10) = ''
          if index(rest,'-C',1) then
              fr(1) = 0
              fr(2) = 1
              fr(9) = true
              fr(10) = true
          end
          if last lt 1 then return
          gosub savethat
          crt 'Margin=':fr(1):', Indentation=':fr(2)
          gosub indenter
          gosub set.record
        case 1 ; gosub bad.command
    end case
    return
g:  begin case
        case comd eq 'G'                ; * Go to line
          if numb eq '' then
              if dlim eq '<' and beg ne '' then here = beg
              if dlim eq '>' and fin ne '' then here = fin
          end else here = numb
          if here gt last then here = last
          gosub display.line
        case 1 ; gosub bad.command
    end case
    return
h:  begin case
        case comd eq 'H' or comd eq 'HELP'
          gosub show.help
        case comd eq 'HEX'            ; * show this line in hexadecimal
          if not(here) then return
          gosub get.line
          temp = ''
          xxno = len(line)
          for xx = 1 to xxno
              bit = line[xx,1]
$ifdef universe
              bit = dtx(seq(bit))
$else
              bit = oconv(seq(bit),'MX')
$endif
$ifdef unidata
              bit = fmt(bit,'2/0R')
$else
              bit = fmt(bit,'R%2')
$endif
              temp<1> = temp<1>:bit[1,1]
              temp<2> = temp<2>:bit[2,1]
          next xx
          if lfmt then crt fmt(here,lfmt):': ':
          crt temp<1>
          if lfmt then crt space(llen+2):
          crt temp<2>
          temp = ''
        case 1 ; gosub bad.command
    end case
    return
i:  begin case
        case comd eq 'I'                ; * insert lines
          if viewflag then gosub viewonly ; return
          chng = 0 ; save = here ; savl = last
          if rest ne '' then
              if numb lt 1 then numb = 1
              inum = numb
              gosub get.line
              if not(chng) then gosub savethis
              if here gt 0 then
                memr(cell)<lnum> := str(am:rest,inum)
              end else memr(1)<1> = str(rest:am,inum):memr(1)<1>
              if here le beg then beg += inum
              if here le fin then fin += inum
              yyno = dcount(krj<1>,vm)
              for yy = 1 to yyno
                if krj<2,yy> gt here then krj<2,yy> += inum
              next yy
              here = here + inum
              gosub reset.record
              gosub get.line
              gosub display.line
              crt 'At line ':here:'. ':inum:' lines inserted, bottom now at line ':last:'.'
          end else
              if nill ne '' then
                crt 'Terminate input with "':nill:'"'
              end
!&&&
!  if nick then gosub get.line
!&&&
              loop
!&&&
!  if nick
!      then pill = space(len(line)-len(trimf(line)))
!      else pill = ''
!  pick = pill
!  pill := nill
!&&&
                new1 = here + 1
                stub = new1:'='
                if lfmt then stub = fmt(new1,lfmt):'='
                gosub get.rope; line = rope
!&&&
              until line eq nill do
!              until line eq nill or line eq pill do
!&&&
                gosub parse.line
                last += 1
                here += 1
                lnum += 1
                if not(chng) then gosub savethis
                chng += 1
                gosub insert.line
                temp = len(last)
                if lfmt then
                    if temp gt 3 and temp ne llen then gosub get.lfmt
                end
                if line eq nill then
                    crt begn:
                    if lfmt then crt fmt(new1,lfmt):'= ':
                end
                crt
                numb -= 1
                if numb eq 0 then exit
              repeat
              crt begn:ceol:
          end
          if chng then gosub reset.record
        case comd eq 'IC'                ; * iconv
          if viewflag then gosub viewonly ; return
          if rest eq '' then
              crt 'No conversion given'
              gosub bad.comd ; return
          end
          ccom = '*':rest ; gosub conv.command
        case comd eq 'IN'                ; * insert from execute
          if viewflag then gosub viewonly ; return
          if trim(rest) eq '' then
              crt 'No external command given'
              comi = '' ; return
          end
          execute rest capturing bite
          test = @(0,0)
          numb = dcount(bite,am)
          if numb then
              gosub savethat
              this = insert(this,here+1,0,0,bite)
              gosub set.record
              crt 'Inserted ':numb:' lines; still at line ':here:'.'
          end else
              crt 'Nothing done - no output from command.'
              comi = '' ; return
          end
        case 1 ; gosub bad.command
    end case
    return
j:  begin case
        case comd eq 'J'                ; * join lines
          if viewflag then gosub viewonly ; return
          if dlim ne '' then
              line = rest ; gosub parse.line ; join = line
          end
          if here and here lt last then
              chng = 0 ; save = here ; savl = last
              gosub get.line
              test = line
              here += 1
              gosub set.bounds
              for here = dawn to dusk
                gosub get.line
                test = test:join:line
              next here
              gosub delete.lines
              if chng eq 0 then return
              here = save
              oopl = here
              gosub get.line
              memr(cell)<lnum> = test
              gosub reset.record
          end
          gosub display.line
        case 1 ; gosub bad.command
    end case
    return
k:  begin case
        case comd eq 'KEEP' or comd eq 'KEEPA'
          gosub get.load
          if temp eq '' then return
          if comd[len(comd),1] ne 'A' then
              gosub get.lines
              if not(temp) then return
          end
          kept = temp
          temp = dcount(temp,am)
          crt 'At line ':here:', ':temp:' lines loaded into kept buffer.'
          temp = ''
        case comd eq 'KEPT' or comd eq 'K' ; * display kept
          xxno = dcount(kept,am)
          if xxno lt 1 then
              crt 'Nothing in KEPT buffer'
              return
          end
          bit = len(xxno)
          disp = '***** Contents of KEPT buffer (':xxno:' lines) *****'
          stub = 'Press return to continue showing KEPT buffer, Q to quit'
          for xx = 1 to xxno
              temp = oconv(kept<xx>,'MCP')[1,wide-bit-1]
              disp<-1> = fmt(xx,'R#':bit):':':temp
          next xx
          gosub show.disp
        case 1 ; gosub bad.command
    end case
    return
l:  begin case
        case index('\L\LN\LA\LNA\LAN\','\':comd:'\',1)  ; * list or locate
          if upcase(comi) eq 'L' then
              if look<1,1> eq '' then
                crt 'No previous locate command to repeat.'
                comi = ''
                return
              end
              comi = look<1,1>
              gosub parse.command
              if comd eq '' then comd = 'L' ; numb = huge
              redo = true
              return
          end
          finder = ''
          seeker = dlim
          if seeker eq '!' or seeker eq '&' then
              finder = rest
              convert dlim to am in finder
              if finder<2> eq '' then finder = '' else rest = finder<1>
          end
          looper = dcount(finder,am)
          if rest ne '' then
              gosub parse.cols
              if not(good) then return
          end else
              if dlim ne '' then
                crt 'The second field is empty.'
                gosub bad.comd ; return
              end
              cols = ''
          end
          if index(comd,'A',1) then
              bump = -1
              dawn = here - 1
              if dawn lt 1 then dawn = 1
              if numb then dusk = here - numb + 1 else dusk = 1
              if dusk lt 1 then dusk = 1
          end else
              bump = 1
              dawn = here + 1
              if dawn gt last then dawn = 1
              if numb then dusk = dawn + numb - 1 else dusk = last
              if dusk gt last then dusk = last
          end
          if looper then rest = finder else looper = 1
          line = rest ; gosub parse.line ; rest = line
          lastfind = rest<1>
          if not(caseflag) then rest = upcase(rest)
          if spaceflag else convert ' ':char(9) to '' in rest
          for here = dawn to dusk step bump
              gosub get.line
              if cols then line = line[cols,colf]
              if caseflag then temp = line else temp = upcase(line)
              if spaceflag else convert ' ':char(9) to '' in temp
              badder = false ; gooder = false
              for xx = 1 to looper
                if index(temp,rest<xx>,1)
                    then gooder = true
                    else badder = true
              next xx
              if seeker eq '&' then gooder = not(badder)
              if gooder then
                if not(index(comd,'N',1)) then
                    gosub display.line
                    if not(numb) then exit
                end
              end else
                if index(comd,'N',1) then
                    gosub display.line
                    if not(numb) then exit
                end
              end
          next here
          if numb then here = dusk
          crt 'Now at line ':here:
          if here eq last then crt ' (bottom)':
          crt '.'
          if rest ne '' and comi ne '' and comi ne look<1,1> then
              look = insert(look,1,1,0,comi)
              look = field(look,vm,1,looknumb)
          end
        case comd eq 'LC'                ; * lower case (make line in)
          if viewflag then gosub viewonly ; return
          if rest eq '' then ccom = 'MCL' else ccom = 'QMCL'
          gosub conv.command
* Various forms for loading stuff
        case comd eq 'LD' or comd eq 'LOAD' or comd eq 'LDA' or comd eq 'LOADA'
          if viewflag then gosub viewonly ; return
          if not(sec.load.flg) then
              crt 'LOAD disabled'
              comi = ''
              return
          end
          gosub get.load
          if temp eq '' then return
          if prepflag then
              sec.call2.type = 1
              sec.fn2 = ofpt
              sec.id2 = oipt
              sec.dict2.flg = (odpt = 'DICT')
              call @prepprog(mat security)
              if sec.stop.flg then stop
              if not(sec.ok2.flg) then
                gosub bad.comd ; return
              end
          end
          if comd[len(comd),1] ne 'A' then
              gosub get.lines
              if not(temp) then return
          end
          gosub savethat
          this = insert(this,here+1,0,0,temp)
          temp = dcount(temp,am)
          here = here + temp
          crt 'At line ':here:', ':temp:' lines loaded.'
          temp = ''
          gosub set.record
        case comd eq 'LL'                ; * long lines
          if not(rest matches '1N0N') then
              rest = span-llen-2
              crt 'LL':numb:'/':rest
          end
          dawn = here + 1
          if dawn gt last then dawn = 1
          if numb then dusk = here + numb else dusk = last
          if dusk gt last then dusk = last
          for here = dawn to dusk
              gosub get.line
              temp = trim(line[rest,huge])
              if temp ne '' then
                gosub display.line
                if not(numb) then return
              end
          next here
          crt
          gosub display.line
        case 1 ; gosub bad.command
    end case
    return
m:  begin case
        case comd eq 'M'        ; * pattern matching
          rest = field(rest,dlim,1)
          if rest eq '' and mmat ne '' then
              dlim = mmat<1,1>
              rest = mmat<1,2>
          end
          if rest eq '' then
              crt 'No pattern given to match'
              return
          end
          gosub changematch.command
        case comd eq 'MACRO'
          if macn then
              temp = dcount(macc<1,1>,sm)
              macc = delete(macc,1,1,temp)
              macc = delete(macc,1,1,temp)
              if macc ne '' then
                pres<1,macn> = macc<1,1>
                crt 'Macro saved to PRestore ':macn
              end else
                crt 'Macro empty - not saved'
              end
              macc = ''
              macn = 0
          end else
              if numb eq '' then numb = 1
              if numb gt presnumb or numb lt 1 then
                crt 'PRestore must be in range 1-':presnumb:'.'
                comi = ''
                return
              end
              crt 'Macro being recorded for PRestore ':numb
              macn = numb
          end
        case comd eq 'MERGE' or comd eq 'ME'      ; * merge stuff
          if viewflag then gosub viewonly ; return
          if rest eq '' and numb eq '' then
              if not(beg) and not(fin) then
                crt 'Command requests a block operation, but no block is defined.'
                gosub bad.comd
                return
              end
              numb = fin - beg + 1
              if blockflag then
                if beg eq fin
                    then stub = 'Copy line ':beg:' to under line ':here:'? '
                    else stub = 'Copy lines ':beg:'-':fin:' to under line ':here:'? '
                gosub get.answ
                if answ ne yes[1,1] then
                    crt 'Block command cancelled.'
                    return
                end
              end
              dlim = ' '
              rest = beg:' ':fin
              numb = ''
          end
          rest = trim(rest)
          if numb eq '' then gosub parse.atts
          if numb ne '' and rest eq '' then rest = here
          if not(rest matches '1N0N') or numb eq '' then
              crt 'Format of MErge command is: "MEn/s"; eg: "ME10/15" or "ME/s/f"; eg: "ME/15/24"'
              gosub bad.comd ; return
          end
*          if numb gt last then
*              crt 'Nothing done - record does not have that many lines.'
*              comi = '' ; return
*          end
          bite = field(this,am,rest,numb)
          if numb ne 1 or bite ne '' then numb = dcount(bite,am)
          if numb then
              gosub savethat
              this = insert(this,here+1,0,0,bite)
              gosub set.record
              if beg gt here then beg = beg + numb
              if fin gt here then fin = fin + numb
              xxno = dcount(krj<1>,vm)
              for xx = 1 to xxno
                if krj<2,xx> gt here then krj<2,xx> += numb
              next xx
              crt 'Merged ':numb:' lines starting at line ':rest:'; still at line ':here:'.'
          end else
              crt 'Nothing done - this line is within the range.'
              comi = '' ; return
          end
        case comd eq 'MOVE' or comd eq 'MV'      ; * move stuff
          if viewflag then gosub viewonly ; return
          if rest eq '' then
              if not(beg) and not(fin) then
                crt 'Command requests a block operation, but no block is defined.'
                gosub bad.comd
                return
              end
              if here le fin and here ge beg then
                crt 'A block may not be moved into itself. MERGE will work.'
                comi = ''
                return
              end
              numb = fin - beg + 1
              if blockflag then
                if beg eq fin then
                    stub = 'Move line ':beg:' to after line ':here:' OK? ':ny
                end else
                    stub = 'Move lines ':beg:'-':fin:' to after line ':here:' OK? ':ny
                end
                gosub get.answ
                if answ ne yes[1,1] then
                    crt 'Block command cancelled.'
                    return
                end
              end
              dlim = ' '
              rest = beg:' ':fin
              numb = ''
          end
          rest = trim(rest)
          if numb eq '' then gosub parse.atts
          if not(rest matches '1N0N') or numb eq '' then
              crt 'Format of MoVe command is: "MVn/s"; eg: "MV10/15" or "MV/s/f"; eg: "MV/15/24"'
              gosub bad.comd ; return
          end
          dusk = rest + numb - 1
          if dusk gt last then dusk = last
          if here ge rest and here le dusk then
              crt 'Nothing done - this line is within the range.'
              comi = '' ; return
          end
          bite = field(this,am,rest,numb)
          numb = dcount(bite,am)
          if numb then
              gosub savethat
              if here gt dusk then
                this = insert(this,here+1,0,0,bite)
                if rest gt 1
                    then this = this[1,col1()-1]:this[col2(),len(this)]
                    else this = this[col2()+1,len(this)]
              end else
                this = this[1,col1()-1]:this[col2(),len(this)]
                this = insert(this,here+1,0,0,bite)
              end
              gosub set.record
              if here gt dusk then
                here = here - numb
                crt 'Moved ':numb:' lines starting at line ':rest:'; now at line ':here:'.'
              end else
                crt 'Moved ':numb:' lines starting at line ':rest:'; still at line ':here:'.'
              end
!##############
              posn = beg; gosub recalc.posn; beg = posn
              posn = fin; gosub recalc.posn; fin = posn
              xxno = dcount(krj<1>,vm)
              for xx = 1 to xxno
                posn = krj<2,xx>; gosub recalc.posn; krj<2,xx> = posn
              next xx
          end else
              crt 'Nothing done - no lines selected.'
              comi = '' ; return
          end
        case 1 ; gosub bad.command
    end case
    return
n:  begin case
        case comd eq 'N'                ; * same as "+"
          if numb eq '' then numb = 1
          here = here + numb
          if here gt last then here = last
          gosub display.line
        case comd eq 'NULL'              ; * null line input definition
          dlim = trim(dlim):trim(rest)
          dlim = dlim[1,1]
          nill = dlim
          if nill eq '"' then
              bit = "'":nill:"'"
          end else bit = '"':nill:'"'
          crt 'NULL character to terminate INSERT is ':bit:'.'
          comi = ''
        case comd eq 'NUM'              ; * toggle the line numbering
          if lfmt eq '' then
              crt 'Line Numbering is ON'
              gosub get.lfmt
          end else
              crt 'Line Numbering is OFF'
              lfmt = ''
          end
        case 1 ; gosub bad.command
    end case
    return
o:  begin case
        case comd eq 'OC'                ; * oconv
          if viewflag then gosub viewonly ; return
          if rest eq '' then
              crt 'No conversion given'
              gosub bad.comd ; return
          end
          ccom = rest ; gosub conv.command
        case comd[1,2] eq 'OO'          ; * undo last change
          if oopc ne '' then
              this = oops
              here = oopl
              last = oopf
              beg = oopb<1>
              fin = oopb<2>
              krj = oopk
              gosub set.record
              crt '"':oopc:'" undone - now at line ':here:'.'
              oops = '' ; oopc = '' ; oopl = '' ; oopf = ''
              oopb = '' ; oopk = ''
              gosub display.line
          end else
              crt 'last change already "undone" or nothing to undo'
          end
          comi = ''
        case comd eq 'OUT'
          gosub outline
        case 1 ; gosub bad.command
    end case
    return
p:  begin case
        case comd eq 'P'                ; * page on
          if numb else numb = plen
          if here ge last then here = 0
          here += 1
          gosub set.bounds
          for here = dawn to dusk
              gosub display.line
          next here
          here = dusk
        case comd eq 'PA'                ; * print window up to here
          if numb else numb = pwin
          save = here
          here = here - numb
          gosub set.bounds
          for here = dawn to dusk
              gosub display.line
          next here
          here = save
          crt 'Still at line ':here:'.'
        case comd = 'PASTE' and rest eq ''  ; * paste from kept
          if viewflag then gosub viewonly ; return
          if kept eq '' then
              crt 'Nothing in KEPT buffer'
              comi = '' ; return
          end
          gosub savethat
          numb = dcount(kept,am)
          this = insert(this,here+1,0,0,kept)
          gosub set.record
          crt 'Pasted ':numb:' lines from KEPT buffer; still at line ':here:'.'
          if beg gt here then beg += numb
          if fin gt here then fin += numb
          xxno = dcount(krj<1>,vm)
          for xx = 1 to xxno
              if krj<2,xx> gt here then krj<2,xx> += numb
          next xx
        case comd eq 'PASTE'                          ; * save the kept buffer
          if viewflag then gosub viewonly ; return
          if kept eq '' then
              crt 'Nothing in KEPT buffer'
              comi = '' ; return
          end
          gosub save.stuff
        case comd eq 'PE'                ; * page editor mode
          if not(editpage) then
              crt 'Page editing not possible at this terminal'
              comi = ''
              return
          end
          that = this ; savl = here:am:last
          if this eq '' then this = am
          if here lt 1 then here = 1
          ptop = here
          mode = 'PAGE':am:'View'
          if sec.write.flg then mode<2> = 'Ins'
          pchr = 1
          chng = '' ; show = ''
          gosub display.page
*>
          gosub get.line
*>
          temp = line
        case comd eq 'PL'                ; * print window from here
          if numb else numb = pwin
          save = here
          gosub set.bounds
          for here = dawn to dusk
              gosub display.line
          next here
          here = save
          crt 'Still at line ':here:'.'
        case comd eq 'PP'                ; * print window bracketing here
          if numb else numb = pwin
          save = here
          here = here - int(numb/2)
          gosub set.bounds
          for here = dawn to dusk
              gosub display.line
          next here
          here = save
          crt 'Still at line ':here:'.'
        case comd eq 'PR'                ; * prestore processing
          if numb eq '' then
              crt 'Defined prestores (':presnumb:' Maximum)'
              for xx = 1 to presnumb
                temp = pres<1,xx>
                convert sm to comdmark in temp
$ifdef unidata
                crt fmt(xx,'2/0R'):' ':temp
$else
                crt fmt(xx,'R%2'):' ':temp
$endif
              next xx
              return
          end
          if numb gt presnumb or numb lt 1 then
              crt 'PRestore must be in range 1-':presnumb:'.'
              comi = ''
              return
          end
          if dlim ne '' then
              if not(rest eq rest<1,1,1>) then
                crt 'Invalid - delimiter in prestore'
                comi = ''
                return
              end
              pres<1,numb> = change(rest,dlim,sm)
          end else
              salt = pres<1,numb>
          end
        case 1 ; gosub bad.command
    end case
    return
q:  begin case
* Various forms for quitting
        case comd eq 'Q' or comd = 'QK' or comd = 'QUIT' or comd = 'QUITK'
          if not(viewflag) and (orig ne this) then
              stub = '***** Record changed --- OK to Quit? (N/Y)>'
              gosub get.answ
              if answ eq yes[1,1] then stopsign = true
          end else stopsign = true
          if stopsign then
              if orig eq '' then
                crt 'Quit "':item:'" in file "':fnam:'" not created.'
              end else crt 'Quit "':item:'" in file "':fnam:'" unchanged.'
              if index(comd,'K',1) then
                killsign = true
                if idcnt gt 1 then crt 'Select list cancelled.'
              end
          end
        case 1 ; gosub bad.command
    end case
    return
r:  begin case
        case comd eq 'RA'                ; * view or repeat change
          if viewflag then gosub viewonly ; return
          gosub change.command
        case comd eq 'R' and dlim ne '' and index(rest,dlim,1) ; * change
          if viewflag then gosub viewonly ; return
          crt ; comd = 'C'
          gosub change.command
        case comd eq 'R'                ; * replace lines
          if viewflag then crt ; gosub viewonly ; return
          if not(last) then
              crt 'Empty record, use Insert (I) command.'
              comi = ''
              return
          end
          if here lt 1 then here = 1 ; gosub display.line
          chng = 0 ; save = here ; savl = last
          if numb lt 1 then numb = 1
          if dlim ne '' and rest eq '' then rest = ' '
          loop
              crt begn:
              if lfmt then crt fmt(here,lfmt):'=':
              crt ceop:
              if rest eq '' then
                stub = here:'='
                if lfmt then stub = fmt(here,lfmt):'='
                gosub get.rope; line = rope
              end else line = rest
              gosub parse.line
          until line eq '' do
              crt goup:begn:ceol:
              if lfmt then crt fmt(here,lfmt):': ':
              crt line
              if line eq comdmark then
                line = ''
                crt begn:
                if lfmt then crt fmt(here,lfmt):': ':
              end
              if numb gt 1 then crt
              if line eq ' ' then line = ''
              if not(chng) then gosub savethis
              chng += 1
              memr(cell)<lnum> = line
              here += 1 ; numb -= 1
              gosub get.line
              if numb eq 0 then exit
          repeat
          if here ne save then here -= 1
          if chng then gosub reset.record; gosub get.line
          crt begn:ceol:
        case comd eq 'RELEASE'          ; * release the item lock
          release file,item
          lock = false
        case 1 ; gosub bad.command
    end case
    return
s:  begin case
        case comd eq 'S'                ; * search processing
          if numb eq '' then
              crt 'Last ':looknumb:' searches (latest first)'
              for xx = 1 to looknumb
$ifdef unidata
                crt fmt(xx,'2/0R'):' ':look<1,xx>
$else
                crt fmt(xx,'R%2'):' ':look<1,xx>
$endif
              next xx
              return
          end
          if numb gt looknumb or numb lt 1 then
              crt 'Search must be in range 1-':looknumb:'.'
              comi = ''
              return
          end
          comi = look<1,numb>
          if comi eq '' then
              crt 'There is no search number ':numb:'.'
              return
          end
          look = delete(look,1,numb,0)
          look = insert(look,1,1,0,comi)
          gosub parse.command
          if comd eq '' then comd = 'L' ; numb = huge
          comi = ''
          redo = true
        case comd eq 'SAVE' or comd eq 'SV'        ; * save the item
          if viewflag then gosub viewonly ; return
          comd = 'SV'
          if rest eq '' then
              if not(sec.write.flg) then
                crt 'File disabled'
                comi = ''
                return
              end
              gosub write.record
          end else gosub save.stuff
        case comd eq 'SEQ'              ; * build a sequence
          if viewflag then gosub viewonly ; return
          if dlim eq '' then
              crt 'Too few fields in this command.'
              gosub bad.comd ; return
          end
          good = true
          cfrom = field(rest,dlim,1)
          cto = field(rest,dlim,2)
          if cto eq '' then cto = 1
          if not(num(cto)) then
              crt 'Base for sequence command must be a number.'
              good = false
          end
          bit = field(rest,dlim,3)
          if bit eq '' then bit = 1
          if not(num(bit)) then
              crt 'Increment for sequence command must be a number.'
              good = false
          end else
              if not(bit) then
                crt 'Increment for sequence command must not be zero.'
                good = false
              end
          end
          if not(good) then gosub bad.comd ; return
          rest = dlim:field(rest,dlim,4,2)
          if rest ne dlim then
              gosub parse.cols
              if not(good) then return
          end else cols = ''
          chng = 0 ; save = here ; savl = last
          gosub set.bounds
          for here = dawn to dusk
              gosub get.line ; temp = line
              if cols then
                bite = index(line[cols,colf],cfrom,1)
                if bite then bite = bite + cols - 1
              end else
                bite = index(line,cfrom,1)
              end
              if bite then
                temp = line[1,bite-1]:cto
                temp = temp:line[bite+len(cfrom),len(line)]
              end
              if '*':temp ne '*':line then
                cto = cto + bit
                if not(chng) then gosub savethis
                chng += 1
                memr(cell)<lnum> = temp
                gosub display.line
              end
          next here
          here = dusk
          if chng then gosub reset.record
        case comd eq 'SHOW'              ; * show changes flag
          rest = upcase(rest)
          begin case
              case rest eq 'ON' ; shew = true
              case rest eq 'OFF' ; shew = false
              case 1 ; shew = not(shew)
          end case
          if shew
              then crt 'Show changes flag is ON'
              else crt 'Show changes flag is OFF'
        case comd eq 'SORT' or comd eq 'SORTU'    ; * sort the block
          if viewflag then gosub viewonly ; return
          test = index(comd,'U',1)
          if not(beg) and not(fin) then
              crt 'Command requests a block operation, but no block is defined.'
              gosub bad.comd
              return
          end
          if beg le 1 then
              temp = 0
          end else
              temp = index(this,am,beg-1)
              if not(temp) then
                crt 'Cannot find beginning of block'
                gosub bad.comd ; return
              end
          end
          rest = upcase(rest)
          if rest eq '' then rest = 'AL'
          if not(index('*AR*AL*DR*DL*','*':rest:'*',1)) then
              crt 'Invalid sort sequence - use "AL" "AR" "DL" or "DR"'
              gosub bad.comd ; return
          end
          temp<2> = index(this,am,fin)
          if fin eq last then temp<2> = len(this)+1
          if not(temp<2>) then
              crt 'Cannot find end of block'
              gosub bad.comd ; return
          end
          if blockflag then
              stub = 'Sort block beginning at ': beg:' and ending at ': fin:'?'
              gosub get.answ
              if answ ne yes[1,1] then
                crt 'Block command cancelled.'
                return
              end
          end
          gosub savethat
          bits = ''
          for here = beg to fin
              gosub get.line
              locate(line,bits;posn;rest) then
                if test then good = false else good = true
              end else good = true
              if good then bits = insert(bits,posn;line)
          next here
          here = oopl
          if fin ne last
              then this = this[1,temp<1>]:bits:am:this[temp<2>+1,len(this)]
              else this = this[1,temp<1>]:bits
          bits = ''
          gosub set.record
* If any tags are in the sorted block then clear the tags,
* as it really makes no sense to try and sort them.
          good = true
          xxno = dcount(krj<1>,vm)
          for xx = 1 to xxno
              posn = krj<2,xx>
              if posn ge beg and posn le fin then good = false
          next xx
          if not(good) then
              krj = ''
              crt 'Tags cleared'
          end
          gosub display.line
        case comd eq 'SPACE'              ; * change spacing flag for 'L'
          rest = upcase(rest)
          begin case
              case rest eq 'ON' ; spaceflag = true
              case rest eq 'OFF' ; spaceflag = false
              case 1 ; spaceflag = not(spaceflag)
          end case
          if spaceflag then
              crt 'SPACE flag is ON'
          end else crt 'SPACE flag is OFF'
        case comd eq 'SPOOL'            ; * print
          save = here
          if numb eq '' and rest matches '1N0N' then numb = rest
          if numb eq '' then here = 1 ; numb = last
          gosub set.bounds
          head = 'Record - ':item:' File - ':fnam:' Account - ':acct:' '
          head = head:timedate():"'LL'"
          temp = span
          printer on
          temp = temp - llen - 2
          heading head
          for here = dawn to dusk
              gosub get.line
              convert badc to gudc in line
              print fmt(here,lfmt):': ':line[1,temp]
              loop
                line = line[temp+1,len(line)]
              until line eq '' do
                print space(llen+2):line[1,temp]
              repeat
          next here
          printer close
          if dawn ne 1 or dusk ne last then
              crt 'Lines ':dawn:' to ':dusk:' of ':
          end
          crt '"':item:'" spooled to the printer.'
          here = save
        case comd eq 'SPOOLHELP'        ; * print the help
          rest = am
          gosub show.help
        case comd eq 'STAMP'            ; * stamp it
          if viewflag then gosub viewonly ; return
          gosub savethat
          last += 1 ; here += 1 ; lnum += 1
          line = '* Last updated by ':name:' in account ':acct:' at ':timedate()
          gosub insert.line
          gosub reset.record
          gosub display.line
        case 1 ; gosub bad.command
    end case
    return
t:  begin case
        case comd eq 'T'                ; * top
          here = 0
          gosub display.line
        case comd eq 'TC'                ; * text case (make line in)
          if viewflag then gosub viewonly ; return
          if rest eq '' then ccom = 'MCT' else ccom = 'QMCT'
          gosub conv.command
* Various ways to TRIM the line
        case comd eq 'TRIM' or comd = 'TRIMF' or comd = 'TRIMB'
          if viewflag then gosub viewonly ; return
          chng = 0 ; save = here ; savl = last
          if rest and comd eq 'TRIM' then
              seek = field(rest,dlim,1)
              if seek matches '3n' then seek = char(seek)
              mark = field(rest,dlim,2)
              mark = upcase(trim(mark))[1,1]
              if index('ABCDEFLRT',mark,1) else
                crt 'Invalid TRIM argument - must be one of "ABCDEFLRT"'
                gosub bad.comd
                return
              end
          end else seek = ''
          show = shew ; dnum = 1
          if numb eq '' and rest matches '1N0N' then numb = rest
          gosub set.bounds
          for here = dawn to dusk
              gosub get.line
              begin case
                case comd eq 'TRIM'
                    if seek eq ''
                      then temp = trim(line)
                      else temp = trim(line,seek,mark)
                case comd eq 'TRIMF' ; temp = trimf(line)
                case comd eq 'TRIMB' ; temp = trimb(line)
              end case
              gosub check.line
          next here
          here = dusk
          if chng then
              gosub reset.record
              crt chng:' lines changed - now at ':here
          end
        case comd eq 'TWIN' or comd eq 'TRIPLE' ; * sideways cloning of line
          if viewflag then gosub viewonly ; return
          if dlim ne '' then
              line = rest ; gosub parse.line ; join = line
          end
          if here and here le last else return
          chng = 0 ; save = here
          gosub set.bounds
          for here = dawn to dusk
              gosub get.line
              if comd eq 'TWIN'
                then test = line:join:line
                else test = line:join:line:join:line
              if test ne line then
                chng += 1
                memr(cell)<lnum> = test
              end
          next here
          if chng eq 0 then return
          temp = 'Split ':chng:' lines'
          if join ne '' then temp := ' and joined the parts with "':join:'"'
          crt temp
          here = save
          gosub savethat
          gosub reset.record
          gosub display.line
        case 1 ; gosub bad.command
    end case
    return
u:  begin case
        case comd eq 'U'                ; * same as "-"
          if numb eq '' then numb = 1
          here = here - numb
          if here lt 0 then here = 0
          if here gt last then here = last
          gosub display.line
        case comd eq 'UC'                ; * upper case (make line in)
          if viewflag then gosub viewonly ; return
          if rest eq '' then ccom = 'MCU' else ccom = 'QMCU'
          gosub conv.command
        case comd eq 'UNLOAD' ; comd = 'SV' ; redo = true
          if viewflag then gosub viewonly ; return
        case 1 ; gosub bad.command
    end case
    return
v:  begin case
        case comd eq 'V'                ; * version information
          crt (upcase(verb):' = ') 'R#20':help.def
$ifdef qm
          temp = trans('NEWVOC','$RELEASE',2,'X')
          if temp eq '' then
              temp = trans('VOC','$RELEASE',2,'X')
          end
          if temp eq '' then temp = '?'
          crt ('QM = ') 'R#20':temp
*>
          crt ('Licence = ') 'R#20':system(31)
*>
$endif
$ifdef unidata
          crt '    UniData version ':oconv('version','TVOC;X;;1')
$endif
$ifdef universe
          temp =  oconv('RELLEVEL','TNEWACC;X;;2')
          if temp eq '' then
              temp = oconv('RELLEVEL','TVOC;X;;2')
          end
          if temp eq '' then temp = 'not known'
          crt '  UniVerse version ':temp
        case comd eq 'VLIST'
          execute comi capturing disp
          stub = "Press return to continue showing VLIST 'T'op '-'back 'Q'uit"
          gosub show.disp
$endif
        case 1 ; gosub bad.command
    end case
    return
w:  begin case
        case comd eq 'W' or comd eq 'WHERE'      ; * what we are editing
          crt
          if viewflag
              then crt 'Viewing "':item:'" in file "':fnam:'"'
              else crt 'Editing "':item:'" in file "':fnam:'"'
          if idcnt gt 1 then crt ' [':id:'/':idcnt:']':
          crt
          if here gt last then here = last
          gosub display.line
        case comd eq 'WM'            ; * word marker display (change)
          if dlim ne '' then wordmark = dlim
          if wordmark eq '"'
              then crt 'WordMark is ':"'":wordmark:"'"
              else crt 'WordMark is ':'"':wordmark:'"'
        case 1 ; gosub bad.command
    end case
    return
x:  begin case
* Another way of quitting
        case comd eq 'X' ; comd = 'QK' ; redo = true
        case comd eq 'XEQ'              ; * execute a command
          if viewflag then gosub viewonly ; return
          if not(sec.xeq.flg) then
              crt 'XEQ disabled'
              comi = ''
              return
          end
          loop
              if rest ne '' then execute rest
              test = @(0,0)
              stub = '<RETURN> or command :'
              gosub get.rope; rest = rope
              if rest eq '' then
                crt; crt 'Returned - ':
                crt 'Editing "':item:'" in file "':fnam:'"'
              end
          until rest eq '' do
*>
              crt
*>
          repeat
          gosub display.line
        case comd eq 'XTD'              ; * hex to decimal
$ifdef universe
          crt xtd(rest)
$else
          crt iconv(rest,'MX')
$endif
        case 1 ; gosub bad.command
    end case
    return
y:  begin case
        case 1 ; gosub bad.command
    end case
    return
z:  begin case
        case 1 ; gosub bad.command
    end case
    return
set.bounds:
    if numb eq '' then numb = 1
    dawn = here
    if dawn lt 1 then dawn = 1
    dusk = dawn + numb - 1
    if dusk gt last then dusk = last
    numb = 0
    return
null.command:
    if dlim eq ':' then comd = 'XEQ' ; return
    if dlim eq '/' then
        comd = 'L'
        if numb eq '' then numb = huge
        return
    end
    if dlim eq '-' or dlim eq '+' then
        if rest eq '' then rest = 1
    end
    if numb ne '' then comd = numb ; return
    if dlim eq '' and rest eq '' then
        here += 1
        if here gt last then here = 1
        gosub display.line
        return
    end
    crt
    begin case
        case dlim eq '+' and rest matches '1N0N'
          here = here + rest
          if here gt last then here = last
          gosub display.line
        case dlim eq '-' and rest matches '1N0N'
          here = here - rest
          if here lt 0 then here = 0
          if here gt last then here = last
          gosub display.line
        case dlim eq '^'
          wild = not(wild)
          if wild
              then crt 'Expansion of non-printing characters enabled'
              else crt 'Expansion of non-printing characters disabled'
        case dlim eq '='
          crt 'UNIDATA prestore is not implemented - Use "PR"'
        case dlim eq '.'
          gosub dot.command
        case dlim eq '$'
          if not(sec.xcom.flg) then
              crt '$ external commands disabled'
              comi = ''
              return
          end
          save = comi ; comi = rest
          gosub parse.command
          comi = save
          comd = '$':comd
          xcom = oconv(comd,'TAE_XCOMS;X;2;2')
          begin case
              case xcom eq ''
                crt 'Record "':comd:'" does not exist in "AE_XCOMS".'
              case xcom[len(xcom)-2,3] ne '_AE'
                disp = ''
                disp<-1> = "Line 2 of record '":rest:"' in file 'AE_XCOMS'"
                disp<-1> = "contains '":xcom:"'."
                disp<-1> = ''
                disp<-1> = 'This line should contain the name of a Basic subroutine that'
                disp<-1> = "has been written to implement the external command '":rest:"'."
                disp<-1> = "The program name must end in '_AE'."
                stub = 'Press RETURN to continue'
                gosub show.disp
              case 1
                that = this ; savl = here:am:last:beg:am:fin:am:krj
                save = comi:am:comd:am:item:am:fnam
                comd = comd:' ':rest
                call @xcom(mat junk)
                item = save<3>
                fnam = save<4>
                if here lt 0 then here = 0
                gosub set.record
                if here gt last then here = last
                comd = ''
                if that ne this then
                    crt save<2>:' - CHANGES HAVE BEEN MADE'
                    oops = that ; oopc = save<1>
                    oopl = savl<1> ; oopf = savl<2>
                    oopb = savl<3>:am:savl<4> ; oopk = field(savl,am,5,3)
                end
                that = ''
          end case
        case comi eq '?'
          disp = '        Login name = ':name:' (':term:', userno ':whom:')'
          disp<-1> = '            Account = ':acct
          if path ne '' then disp<-1> = '          VOC path = ':path
          disp<-1> = '              Level = ':levl
          disp<-1> = '          File name = ':fnam
          disp<-1> = '          Record id = ':item
          disp<-1> = '      Current line = ':here
          disp<-1> = '              Lines = ':last
          disp<-1> = '        Characters = ':len(this)
          if chan ne '' then
              disp<-1> = 'Last Change command = ':chan<1,1>
          end
          if cmat ne '' then
              temp = 'CM':cmat<1,3>:cmat<1,1>:cmat<1,2>
              disp<-1> = 'Last CMatch command = ':temp
          end
          if olda then
              temp = 'A':olda<1,2>:olda<1,1>
              disp<-1> = 'Last Append command = ':temp
          end
          if beg or fin then
              disp<-1> = '              Block = ':beg:'-':fin
          end
          if comdmark eq '"' then
              temp = "'":comdmark:"'"
          end else temp = '"':comdmark:'"'
          disp<-1> = 'Command Delimiter is ':temp:', '
          if nill eq '"' then
              temp = "'":nill:"'"
          end else temp = '"':nill:'"'
          disp := 'character to end inserting is ':temp:', '
          if wordmark eq '"' then
              temp = "'":wordmark:"'"
          end else temp = '"':wordmark:'"'
          disp := 'WordMark is ':temp
          disp<-1> = 'Page: window for PA/PL/PP is ':pwin:', length for P is ':plen
          if wild
              then disp<-1> = 'Expansion of non-printing characters enabled'
              else disp<-1> = 'Expansion of non-printing characters disabled'
          if caseflag then
              disp<-1> = 'CASE':' flag ON':', '
          end else disp<-1> = 'CASE':' flag OFF':', '
          if spaceflag then
              disp := 'SPACE':' flag ON':', '
          end else disp := 'SPACE':' flag OFF':', '
          if shew then
              disp := 'SHOW':' flag ON':', '
          end else disp := 'SHOW':' flag OFF':', '
          if blockflag then
              disp := 'BLOCK':' flag ON'
          end else disp := 'BLOCK':' flag OFF'
          if oopc ne '' then
              disp<-1> = 'OOPS will restore record prior to command: ':oopc
          end else
              disp<-1> = 'OOPS already executed, or no changes in effect.'
          end
          gosub show.disp
        case comi[1,2] eq '<>' ; gosub botharr
        case comi[1,1] eq '<' ; gosub leftarr
        case comi[1,1] eq '>' ; gosub rightarr
        case dlim eq '\' and rest[1,1] eq '\'    ;* clear the tag pointers
          krj = ''
          crt 'Tags cleared'
        case dlim eq '\'      ;* set a tag pointer
          locate(here,krj,2;posn) then
              crt 'There is already a Tag on line ':here
              return
          end
          if rest eq '' then rest = 'T':here
          rest = upcase(rest)
          locate(rest,krj,1;posn) then
              crt 'There is already a Tag labelled ':rest
              return
          end
          posn = krj<3>
          krj<1> = field(krj<1>,vm,1,posn)
          posn += 1
          krj<1,posn> = rest
          krj<2,posn> = here
          krj<3> = posn
          crt 'Setting Tag labelled ':rest:' at line ':here
        case (dlim eq '[' or dlim eq ']') and (rest[1,1] eq '[' or rest[1,1] eq ']')
          if krj<3> eq ''
              then disp = 'No Tag found'
              else disp = 'Tags at line-Labelled'
          posn = krj<3>
          xxno = dcount(krj<1>,vm)
          for xx = 1 to xxno
              disp<-1> = krj<2,xx> 'r#12'
              if xx eq posn then disp := '>' else disp := ' '
              disp := krj<1,xx>
          next xx
          convert badc to gudc in disp
          gosub show.disp
        case dlim eq '[' and rest eq ''
          posn = krj<3>-1
          if posn gt 0 then
              comd = krj<2,posn>
              krj<3> = posn
              crt 'Moved to line ':comd:' labelled ':krj<1
          end else comd = ''
          if comd eq '' then crt 'No Tag found'
        case dlim eq ']' and rest eq ''
          posn = krj<3>+1
          comd = krj<2,posn>
          if comd eq '' then
              crt 'No Tag found'
          end else
              krj<3> = posn
              crt 'Moved to line ':comd:' labelled ':krj<1
          end
        case dlim eq '[' or dlim eq ']'
          locate(upcase(rest),krj,1;posn) then comd = krj<2,posn> else comd = ''
          if comd ne '' then
              krj<3> = posn
              crt 'Moved to line ':comd:' labelled ':krj<1
              return
          end else crt 'No Tag found'
        case 1
          gosub bad.command
    end case
    return
parse.cols:
    good = true
    cols = field(rest,dlim,2)
    convert ',.' to '--' in cols
    rest = field(rest,dlim,1)
    colf = field(cols,'-',2)
    cols = field(cols,'-',1)
    if colf eq '' then colf = cols
    if cols ne '' then
        if not(cols matches '1N0N') or not(colf matches '1N0N') then
          crt 'Column specifications must be positive whole numbers.'
          gosub bad.comd
          good = false
          return
        end
    end
    if colf lt cols then
        crt 'Ending column # must exceed or equal starting column #.'
        gosub bad.comd
        good = false
        return
    end
    colf = colf - cols + 1
    return
parse.atts:
    convert '-' to dlim in rest
    if dlim eq '"' then temp = "'" else temp = '"'
    temp = '1N0N':temp:dlim:temp:'1N0N'
    if rest matches temp then
        numb = field(rest,dlim,2) - field(rest,dlim,1) + 1
        rest = field(rest,dlim,1)
    end
    return
change.command:
    if comd eq 'RA' then
        if numb eq '' then
          crt 'Last ':channumb:' changes (latest first)'
          for xx = 1 to channumb
$ifdef unidata
              crt fmt(xx,'2/0R'):' ':chan<1,xx>
$else
              crt fmt(xx,'R%2'):' ':chan<1,xx>
$endif
          next xx
          return
        end
        if numb gt channumb or numb lt 1 then
          crt 'Change must be in range 1-':channumb:'.'
          comi = ''
          return
        end
        comi = chan<1,numb>
        if comi eq '' then
          crt 'There is no change number ':numb:'.'
          return
        end
        chan = delete(chan,1,numb,0)
        chan = insert(chan,1,1,0,comi)
        gosub parse.command
        comi = 'RA'
    end
save = upcase(field(rest,dlim,3,2))
if save ne '' then rest = rest[1,col1()]
    gosub get.fromto
temp = save
    if comi eq '' then return
    chng = 0 ; save = here ; savl = last
    glob = index(temp,'G',1)
    show = shew or index(temp,'S',1)
convert dlim:'GS' to '-' in temp
rest = dlim:temp
gosub parse.cols
if not(good) then return
    if numb lt plen then show = true
    dnum = 1
    gosub set.bounds
    for here = dawn to dusk
        gosub get.line
        gosub change.line
        gosub check.line
    next here
    here = dusk
    if comi ne '' and upcase(comi) ne 'RA' then
        chan = insert(chan,1,1,0,comi)
        chan = delete(chan,1,channumb,0)
    end
    if chng then
        gosub reset.record
        if not(show) and dnum gt plen then
          crt chng:' lines changed - now at ':here
        end
    end
    return
get.fromto:
    if count(rest,dlim) gt 2 then
        crt 'Too many delimiters (3 max.).'
        comi = ''
        return
    end
    line = field(rest,dlim,1)
    gosub parse.line
    cfrom = line
    line = field(rest,dlim,2)
    gosub parse.line
    cto = line
    if cto eq '' and count(rest,dlim) lt 2 then
        crt 'Missing required TO field (for "CHANGE/FROM/TO").'
        comi = ''
        return
    end
    return
change.line:
    if cfrom eq '' then
        temp = cto:line
    end else
        if glob then
          temp = change(line,cfrom,cto)
        end else
          temp = index(line,cfrom,1)
          if temp then
              temp = line[1,temp-1]:cto:line[temp+len(cfrom),len(line)]
          end else temp = line
        end
    end
    return
conv.command:
    chng = 0 ; save = here ; savl = last
    show = shew or index(rest,'S',1) or index(rest,'s',1)
    dnum = 1
    if numb lt plen then show = true
    if numb eq '' and rest matches '1N0N' then numb = rest
    gosub set.bounds
    ctyp = ccom[1,1]
    begin case
* ICONV
        case ctyp eq '*' ; ccom = ccom[2,huge]
* Text conversion LC, TC, or UC command
        case ctyp eq 'Q' ; ccom = ccom[2,huge]
    end case
    for here = dawn to dusk
        gosub get.line
        begin case
          case ctyp eq '*'
              temp = iconv(line,ccom)
          case ctyp eq 'Q'
              temp = field(trim(line),' ',1)
              flag = false
              if temp ne 'REMOVE' then
                if temp[1,3] eq 'REM' then flag = true
                if temp[1,1] eq '*' then flag = true
                if temp[1,1] eq '!' then flag = true
              end
              if flag then
                temp = line
              end else
                xxno = len(line)
                temp = ''
                flag = ''
                for xx = 1 to xxno
                    bit = line[xx,1]
                    begin case
                      case bit eq flag ; flag = ''
                      case flag ne ''
                      case index(qt,bit,1) ; flag = bit
*>
                      case bit eq ';'
                          test = trim(line[xx+1,huge])[1,1]
                          if test eq '*' or test eq '!' then flag = am
*>
                      case 1 ; bit = oconv(bit,ccom)
                    end case
                    temp = temp:bit
                next xx
              end
          case 1
              temp = oconv(line,ccom)
        end case
        if temp eq '' then temp = line
        gosub check.line
    next here
    here = dusk
    if chng then
        gosub reset.record
        if not(show) and dnum gt plen then
          crt chng:' lines changed - now at ':here
        end
    end
    return
dot.command:
    if trim(comi) eq '.' then comi = '.L1'
    save = comi
    comi = field(comi,dlim,2,huge)
    gosub parse.command
    begin case
        case comd eq 'A'                ; * append to line
          if numb eq '' then numb = 1
          if numb gt dcount(stak,vm) then
              crt 'History command ':numb:' does not exist.'
          end else
              stak<1,numb> := rest
$ifdef unidata
              crt fmt(numb,'3/0R'):'. ':stak<1,numb>
$else
              crt fmt(numb,'R%3'):'. ':stak<1,numb>
$endif
          end
        case comd eq 'C'                ; * change lines
          if numb eq '' then numb = 1
          if numb gt dcount(stak,vm) then
              crt 'History command ':numb:' does not exist.'
          end else
              gosub get.fromto
              if comi eq '' then comd = '' ; return
              glob = index(field(rest,dlim,3),'G',1)
              glob = glob + index(field(rest,dlim,3),'g',1)
              line = stak<1,numb>
              gosub change.line
              stak<1,numb> = temp
$ifdef unidata
              crt fmt(numb,'3/0R'):'. ':temp
$else
              crt fmt(numb,'R%3'):'. ':temp
$endif
          end
        case comd eq 'D'                ; * delete lines
          if numb eq '' then numb = 1
          if numb gt dcount(stak,vm) then
              crt 'History command ':numb:' does not exist.'
          end else
              stak = delete(stak,1,numb,0)
              crt 'History #':numb:' DELETEd.'
          end
        case comd eq 'I'                ; * insert a new line
          if numb eq '' then numb = 1
          if numb gt dcount(stak,vm) then
              crt 'History command ':numb:' does not exist.'
          end else
              if rest ne '' then
                stak = insert(stak,1,numb,0,rest)
                stak = delete(stak,1,staknumb,0)
$ifdef unidata
                crt fmt(numb,'3/0R'):'. ':stak<1,numb>
$else
                crt fmt(numb,'R%3'):'. ':stak<1,numb>
$endif
              end
          end
        case comd eq 'L'                ; * list lines
          if numb eq '' then numb = plen
          if numb gt dcount(stak,vm) then numb = dcount(stak,vm)
          temp = rem(numb+1,plen)
          for xx = numb to 1 step -1
$ifdef unidata
              crt fmt(xx,'3/0R'):'. ':stak<1,xx>
$else
              crt fmt(xx,'R%3'):'. ':stak<1,xx>
$endif
              if xx gt 1 and rem(xx,plen) eq temp then
                stub = 'Press return to continue, Q to quit'
                rlen = 1
                gosub get.rope; crt begn:ceol:
                wait = trim(upcase(rope))[1,1]
                if wait eq 'Q' then exit
              end
          next xx
        case comd eq 'R'                ; * restore a line to latest
          if numb eq '' then numb = 1
          if numb le dcount(stak,vm) then
              temp = stak<1,numb>
              stak = insert(stak,1,1,0,temp)
              stak = delete(stak,1,staknumb,0)
          end
        case comd eq 'S'
          if numb eq '' then numb = 1
          if numb gt presnumb then
              crt numb:' is greater than pre-store limit of ':presnumb
              return
          end
          rest = trim(rest)
          dawn = field(rest,dlim,1) ; if dawn eq '' then dawn = 1
          dusk = field(rest,dlim,2) ; if dusk eq '' then dusk = 1
          if not(dawn matches '1N0N' and dusk matches '1N0N') then
              crt 'One of the values was not a number'
              return
          end
          if dawn gt dusk then temp = dawn ; dawn = dusk ; dusk = temp
          temp = ''
          for xx = dusk to dawn step -1
              temp<1,1,-1> = stak<1,xx>
          next xx
          pres<1,numb> = temp
        case comd eq 'U'                ; * upcase line
          if numb eq '' then numb = 1
          if numb gt dcount(stak,vm)
              then crt 'History command ':numb:' does not exist.'
              else stak<1,numb> = upcase(stak<1,numb>)
        case comd eq 'UL'                ; * downcase line
          if numb eq '' then numb = 1
          if numb gt dcount(stak,vm)
              then crt 'History command ':numb:' does not exist.'
              else stak<1,numb> = downcase(stak<1,numb>)
        case comd eq 'UT'                ; * mixed case line
          if numb eq '' then numb = 1
          if numb gt dcount(stak,vm)
              then crt 'History command ':numb:' does not exist.'
              else stak<1,numb> = oconv(stak<1,numb>,'mct')
        case comd eq 'X'              ; * re-execute an editor command
          if numb eq '' then numb = 1
          if numb gt dcount(stak,vm) then
              crt 'History command ':numb:' does not exist.'
          end else
              salt = stak<1,numb>
              stak = delete(stak,1,numb,0)
          end
        case 1
          comi = save
          gosub bad.command
    end case
    comi = '' ; comd = ''
    return
viewonly:
    crt 'That command is not allowed in VIEW mode':bell
    comi = ''
    return
bad.command:
    crt 'Command not understood - try "H" for help.'
bad.comd:
    xxno = len(comi)
    temp = ''
    for xx = 1 to xxno
        bite = comi[xx,1]
        bite = seq(bite)
        if bite ge 127 or bite lt 32 then
$ifdef unidata
          bite = '^':fmt(bite,'3/0R')
$else
          bite = '^':fmt(bite,'R%3')
$endif
        end else bite = char(bite)
        temp = temp:bite
    next xx
    crt 'Command was: "':temp:'"'
    temp = ''
    comi = ''
    return
save.stuff:
    if not(sec.unload.flg) then
        crt 'Unload disabled'
        comi = ''
        return
    end
    keepquot = false
    gosub parse.rest
    odpt = '' ; ofpt = bite<1> ; oipt = bite<2>
    onam = ofpt
    if ofpt eq 'DICT' then
        odpt = ofpt ; ofpt = oipt ; oipt = bite<3>
        onam = onam:' ':ofpt
    end
    if oipt eq '' then
        if odpt ne '' then
          crt 'Cannot save to null item.'
          gosub bad.comd ; return
        end
        oipt = ofpt ; odpt = dprt ; ofpt = fprt ; onam = fnam
    end
    if dprt eq odpt and fprt eq ofpt then
        ofil = file
    end else
        open odpt, ofpt to ofil else
          crt 'Cannot open ':'"':fnam:'"'
          gosub bad.comd ; return
        end
    end
    if prepflag then
        sec.call2.type = 2
        sec.fn2 = ofpt
        sec.id2 = oipt
        sec.dict2.flg = (odpt = 'DICT')
        call @prepprog(mat security)
        if sec.stop.flg then stop
        if not(sec.ok2.flg) then
          gosub bad.comd ; return
        end
    end
    if source.control then
        dict.flag = odpt
        file.name = ofpt
        record.name = oipt
        record.data = this
        caller = '3'
        write.allowed = '1'
        updated = '0'
        call source.control(dict.flag,file.name,
        record.name,record.data,caller,write.allowed,updated)
        if write.allowed ne '1' then
          crt 'WRITE NOT ALLOWED'
          return
        end
    end
    readv test from ofil, oipt, 1 then
        stub = 'Record already exists. Overwrite (y/n)? '
        gosub get.answ
        if answ ne yes[1,1] then return
    end
    if comd eq 'PASTE' then
        write kept on ofil, oipt on error gosub writerr ; return
    end else
        write this on ofil, oipt on error gosub writerr ; return
    end
    crt 'Record "':oipt:'" saved in "':onam:'".'
    return
write.record:
    if rest ne '' then
        if comd eq 'FD' then
          crt '"FD" operates only on the current record & file.'
        end else
          crt '"FI" only for current record & file. Use SAVE.'
        end
        gosub bad.comd ; return
    end
    if source.control then
        dict.flag = dprt
        file.name = fprt
        record.name = item
        if comd eq 'FD' then record.data = '' else record.data = this
        caller = '3'
        write.allowed = '1'
        updated = '0'
        call source.control(dict.flag,file.name,
        record.name,record.data,caller,write.allowed,updated)
        if write.allowed ne '1' then
          crt 'WRITE NOT ALLOWED'
          return
        end
    end
    if not(lock) then
        crt 'Record lock has been released!  Write not allowed.'
        comi = ''
        return
    end
    if comd eq 'FD' then
        stub = '***** You are about to DELETE the record! OK? ':ny
        gosub get.answ
        if answ ne yes[1,1] then return
        delete file, item on error gosub writerr ; return
        crt 'Deleted "':item:'" from file "':fnam:'".'
    end else
        if comd eq 'SV' then
          writeu this on file, item on error gosub writerr ; return
          orig = this ; oops = '' ; oopc = '' ; oopl = '' ; oopf = ''
          oopb = '' ; oopk = ''
          crt 'Saved "':item:'" in "':fnam:'" - now at line ':here:'.'
          return
        end else
          write this on file, item on error gosub writerr ; return
          if orig eq this then
              crt 'Filed "':item:'" in file "':fnam:'" UNCHANGED.'
          end else crt 'Filed "':item:'" in file "':fnam:'".'
          oops = '' ; oopc = '' ; oopl = '' ; oopf = ''    ; * ewd
        end
    end
    stopsign = true
    if index(comd,'B',1) then
        temp = 'BASIC'
$ifdef qm
        if index(comd,'D',1) then temp<2> = ' DEBUGGING'
$endif
        gosub exec.that
    end
    if index(comd,'C',1) then
        temp = 'CATALOG'
        begin case
          case index(comd,'L',1) ; temp<2> = ' LOCAL'
*          case index(comd,'G',1) ; temp<2> = ' GLOBAL'
        end case
        gosub exec.that
    end
    if index(comd,'R',1) then temp = 'RUN' ; gosub exec.that
    return
edit.fields:
    if here lt 1 then here = 1
    gosub get.line ; temp = line
    convert vmrk to am in line
    ttid = whom:'_':levl:'_':vals:'.in.line#':here
    write line on acom, ttid on error gosub writerr ; return
    crt view:'ing ':vals:' as fields...':
    execute verb:' AE_COMS ':ttid:options
    test = @(0,0)
    crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
    read line from acom, ttid else line = ''
    delete acom, ttid
    return
reset.fields:
    convert am to vmrk in line
    if temp ne line then
        gosub savethat
        memr(cell)<lnum> = line
        gosub reset.record
    end
    return
get.load:
    temp = ''
    if trim(rest) eq '' then
        stub = 'Record name, or file name and record name >'
        gosub get.rope; rest = rope; crt
        if trim(rest) eq '' then temp = ''; return
    end
    keepquot = false
    gosub parse.rest
    onam = bite<1>
    onid = bite<2>
    if onam eq 'DICT' then
        onam = onam:' ':onid
        onid = bite<3>
        if onid eq '' then onid = item
    end
    if onid eq '' then onid = onam ; onam = ''
    if onid eq '' then return
    if onam eq '' then
        onam = fnam
        odpt = dprt
        ofpt = fprt
        ofil = file
    end else
        odpt = field(onam,' ',1)
        ofpt = field(onam,' ',2)
        if ofpt eq '' then ofpt = odpt ; odpt = ''
        open odpt, ofpt to ofil else
          crt 'Cannot open ':onam
          gosub bad.comd ; return
        end
    end
    read temp from ofil, onid else
        if dcount(bite,am) eq 1 then
          open onid to ofil then
              read temp from ofil, item then return
          end
        end
        crt 'Record "':onid:'" was not found on file "':onam:'".'
        gosub bad.comd ; return
    end
    return
changematch.command:
    patt = field(rest,dlim,1)
    gosub parse.pattern
    if not(good) then
        crt 'Pattern: character "':bit:'" is not allowed unless quoted.'
        comi = ''
        return
    end
    if comd eq 'CM' then cmat = dlim:vm:rest:vm:numb
    cto = field(rest,dlim,3,huge)
    line = cto ; gosub parse.line ; cto = line
    cfrom = upcase(field(rest,dlim,2))
    if cfrom eq '' then cfrom = 'L'
    if cfrom eq 'L' then mmat = dlim:vm:rest
    if numb eq '' and cto eq '' and (cfrom eq 'L' or cfrom eq 'N') then
        numb = last
        flag = true
    end else flag = false
    if len(cfrom) eq 1 and index('ADLNPR',cfrom,1) then
    end else
        gosub parse.cols
        if not(good) then return
        cfrom = ''
        colf = cols + colf - 1
    end
cm.del.entry:
    gosub set.bounds
    show = shew ; dnum = 1
    chng = 0 ; save = here ; savl = last ; dnum = 2
    test = ''
    for here = dawn to dusk
        gosub get.line
        if cfrom eq 'DE'
          then good = index(line,patt,1)
          else good = (line matches patt)
        if not(good) then
          if cfrom eq 'N' then
              numb += 1
              if show or numb lt plen then gosub display.line
              if flag then dusk = here
          end
          continue
        end
        numb += 1
        temp = line
        begin case
          case cfrom eq 'A'
              temp = line:cto
          case cfrom[1,1] eq 'D'
              if show or numb lt plen then crt fmt((here + chng),lfmt):'+ ':line
              test<-1> = here
          case cfrom eq 'L'
              gosub display.line
              if flag then dusk = here
          case cfrom eq 'P'
              temp = cto:line
          case cfrom eq 'R'
              temp = cto
          case cfrom eq 'N'
              numb -= 1
          case 1
              gosub parse.temp
        end case
        if not(index('DL',cfrom,1)) or cfrom eq '' then
          gosub check.line
        end
    next here
    if cfrom[1,1] eq 'D' and numb then
        gosub savethis
        for here = numb to 1 step -1
          temp = test<here>
          cell = int((temp-1)/cellsize) + 1
          coff = rem(temp,cellsize)
          if coff eq 0 then coff = cellsize
          del memr(cell)<coff>
          if beg eq temp then beg = 0
          if beg gt temp then beg -= 1
          if fin eq temp then fin = 0
          if fin gt temp then fin -= 1
          for xx = dcount(krj<1>,vm) to 1 step -1
              begin case
                case krj<2,xx> gt temp ; krj<2,xx> -= 1
                case krj<2,xx> eq temp
                    del krj<1,xx> ; del krj<2,xx> ; krj<3> -= 1
              end case
          next xx
        next here
        test = ''
        gosub reset.record
        here = dusk - numb
    end else
        here = dusk
    end
    if dawn ne dusk then
        if here lt last
          then crt 'At line ':here:'.'
          else crt 'Bottom at ':here:'.'
    end
    if not(numb) then
        if cfrom eq 'N' then
          crt 'No lines (in ':dawn:'-':dusk:') NOT matching pattern "':patt:'"'
        end else crt 'No lines (in ':dawn:'-':dusk:') matching pattern "':patt:'"'
    end else
        begin case
          case cfrom[1,1] eq 'D'
              crt 'Deleted ':numb:' lines matching "':patt:'"'
          case cfrom eq 'L'
              crt 'Found ':numb:' lines matching "':patt:'"'
          case cfrom eq 'N'
              crt 'Found ':numb:' lines NOT matching "':patt:'"'
        end case
    end
    if chng then
        gosub reset.record
        begin case
          case dawn eq dusk
              return
          case cfrom eq 'A'
              crt '"':cto:'" appended to ':
          case cfrom[1,1] eq 'D'
              crt 'Deleted ':
          case cfrom eq 'P'
              crt '"':cto:'" prefixed to ':
          case cfrom eq 'R'
              crt 'Replaced with "%", ':
          case cfrom eq 'L' or cfrom eq 'N'
          case cols eq colf
              crt 'Element ':cols:' changed to "':cto:'" in ':
          case cols
              crt 'Element ':cols:'-':colf:' changed to "':cto:'" in ':
        end case
        if chng eq 1
          then crt '1 line matching "':patt:'"'
          else crt chng:' lines matching "':patt:'"'
    end
    return
parse.pattern:
* bits<1> are the pattern pieces
*    <2> quote or 'p'attern flag
*    <3> partial patterns
    cntr = 1
    bits = ''
    flag = ''
    good = true
    first = true
    xxno = len(patt)
    gosub quote.pattern
    for xx = 1 to xxno
        bit = patt[xx,1]
        begin case
          case bit = flag
              flag = ''
              first = true
              cntr = cntr + 1
          case flag ne ''
              bits<1,cntr> = bits<1,cntr>:bit
          case index(qt,bit,1)
              bits<2,cntr> = bit
              flag = bit
          case first
              if not(bit matches '1n') then
                good = false
                return
              end
              first = false
              bits<2,cntr> = 'p'
              bits<1,cntr> = bits<1,cntr>:bit
              if bit eq '0' then bits<3,cntr> = patt[xx+2,xxno]
          case 1
              if not(index('AaNnXx',bit,1)) then
                good = false
                return
              end
              bits<1,cntr> = bits<1,cntr>:oconv(bit,'mcu')
              first = true
              cntr = cntr + 1
        end case
    next xx
    cntr = cntr - 1
    return
quote.pattern:
* Adds quotes to the pattern if required
* If they use any quotes at all, we don't do a thing
    if index(patt,'"',1) then return
    if index(patt,'\',1) then return
    if index(patt,"'",1) then return
    xx = 1
    temp = ''
    test = ''
    loop
        left = patt[xx,2]:'*'
        if index('0123456789',left[1,1],1) and index('AaNnXx',left[2,1],1) then
          if test ne '' then temp := "'":test:"'"
          temp := patt[xx,2]
          test = ''
          xx += 1
        end else test := patt[xx,1]
    until xx gt xxno do
        xx += 1
    repeat
    patt = temp
    if test ne '' then patt := "'":test:"'"
    return
parse.temp:
    temp = ''
    posn = 1
    xxno = len(line)
    for xx = 1 to cntr
        what = bits<1,xx>
        type = bits<2,xx>
        nmbr = what[1,1]
        begin case
          case xx gt colf
              temp<xx> = line[posn,xxno]
              xx = cntr
          case type ne 'p'
              temp<xx> = line[posn,len(what)]
              posn = posn + len(what)
          case xx = cntr
              temp<xx> = line[posn,xxno]
          case nmbr = '0'
* look to match the rest of the line with the partial pattern
              test = bits<3,xx>
              yy = posn
              bit = ''
              loop
              until yy gt xxno do
                chit = line[yy,xxno]
              until chit matches test do
                bit := chit[1,1]
                yy += 1
              repeat
              posn += len(bit)
              temp<xx> = bit
          case 1
              bit = line[posn,nmbr]
              posn += len(bit)
              temp<xx> = bit
        end case
    next xx
    temp<cols> = cto
    for xx = cols+1 to colf
        temp = delete(temp,cols+1)
    next xx
    convert am to '' in temp
    return
get.lines:
    stub = '"Q"uit, or starting line > '
    pick = 1
    gosub get.rope; dawn = rope
    dawn = upcase(trim(dawn))
    if dawn eq '' then dawn = 'Q'
    if dawn[1,1] eq 'Q' then temp = false ; crt ; return
    if not(dawn matches '1N0N') then
        crt
        crt 'Nothing done - starting and ending lines must be numeric.'
        gosub bad.comd ; return
    end
    if dawn gt dcount(temp,am) then
        crt
        crt 'Nothing done - record does not have that many lines.'
        gosub bad.comd ; return
    end
    stub = stub:dawn:' ':', ending line > '
    pick = dcount(temp,am)
    gosub get.rope; dusk = rope
    dusk = upcase(trim(dusk))
    if dusk eq '' then dusk = 'Q'
    if dusk[1,1] eq 'Q' then temp = false ; crt ; return
    if not(dusk matches '1N0N') then
        crt
        crt 'Nothing done - starting and ending lines must be numeric.'
        gosub bad.comd ; return
    end
    if dusk gt dcount(temp,am) then
        dusk = dcount(temp,am)
        crt begn:'File is ':onam:': "Q"uit, or starting line > ':dawn:', ':dusk:
    end
    temp = field(temp,am,dawn,dusk-dawn+1)
    crt
    return
parse.bite:
    temp = ''
    loop
    while bite ne '' do
        bite = trimf(bite)
        xx = fold
        if count(bite[1,xx],' ') and trim(bite[xx+1,1]) ne '' then
          loop
          until trim(bite[xx,1]) eq '' do
              xx -=1
          repeat
          temp<-1> = bite[1,xx-1]
        end else
          temp<-1> = bite[1,xx]
        end
        bite = bite[xx+1,len(bite)]
    repeat
    return
show.help:
    crt
    if help eq '' then
        help = ''
        help<-1> = ' ':verb:' version ':help.def
        help<-1> = ' This program can be called with the following formats:'
        help<-1> = " ":verb:"              file and record id's are prompted for"
        help<-1> = " ":verb:" file          record id's are prompted for"
        help<-1> = " ":verb:" file id      ":view:" the record 'id' in 'file'"
        help<-1> = " ":verb:" file id id... ":view:" multiple records in 'file'"
        help<-1> = " ":verb:" file *        ":view:" all records in 'file'"
        help<-1> = " SELECT            may precede '":verb:" file' command"
        help<-1> = ' Special ASCII characters may be entered as:'
        help<-1> = '    ^nnn  where nnn is the decimal character code (like ^027)'
        help<-1> = '    ^    will enter a single UP ARROW character.'
        help<-1> = ' The following commands may be used in the Editor:'
        help<-1> = 'A#          - Do the last Append command again for # lines.'
        help<-1> = "A# any      - Append 'any' to # lines (default 1)."
        help<-1> = 'B            + Set the current line pointer to the BOTTOM line.'
        help<-1> = "B# any      - BREAK # lines (default 1) after string 'any' into two lines."
        help<-1> = 'BC# posn    = Break Column - Break # lines (default 1) after posn into two.'
        help<-1> = 'BCD# posn    = Break Column and Discard the second part.'
        help<-1> = 'BCK# posn    = Break Column and Keep only the second part.'
        help<-1> = 'BCR# posn    = Break Column and Reverse the order of the two parts.'
        help<-1> = 'BCS# posn    = Break Column and Swap the parts about the character at posn.'
        help<-1> = "BD# any      - BREAK after string 'any' and Discard the second part."
        help<-1> = "BK# any      - BREAK after string 'any' and Keep only the second part."
        help<-1> = "BR# any      - BREAK after string 'any' and Reverse the order of the two parts."
        help<-1> = "BS# any      - BREAK after string 'any' and Swap the parts about 'any'."
        help<-1> = 'BLEACH ON/OFF# Switch colourisation flag.'
        help<-1> = 'BLOCK ON/OFF + Switch block operation confirmation flag.'
        help<-1> = '              If neither ON nor OFF is used, then toggle BLOCK flag.'
        help<-1> = "C            - Do the last 'CHANGE' command again."
        help<-1> = 'C///        - CHANGE one or more lines. Full formats is:'
        help<-1> = '              C[#]/from/to/[G][S]'
        help<-1> = '              where    / - is any delimiter character.'
        help<-1> = '                        # - number of lines to CHANGE (default 1).'
        help<-1> = '                    from - is the character string to be replaced.'
        help<-1> = '                      to - is the character string to substitute.'
        help<-1> = "                        G - 'G'lobal flag - CHANGE all instances in line."
        help<-1> = "                        S - 'S'how flag - display all changes made."
        help<-1> = 'CASE ON/OFF  + Switch CASE flag for FL, FLA, L, LA, LN, LNA commands.'
        help<-1> = '              If neither ON nor OFF is used, then toggle CASE flag.'
        help<-1> = '              OFF means that the commands are not case sensitive.'
        help<-1> = "CAT          - Synonym for 'J'oin."
        help<-1> = 'CD          + Show or change the command delimiter.'
        help<-1> = '              (this is the input for a blank line).'
        help<-1> = 'CLEAR        # Clear the kept buffer.'
        help<-1> = 'CM///        - ChangeMatch one or more lines. Full formats is:'
        help<-1> = '              CM[#]/pattern[/range/to]'
        help<-1> = '              where      / - is any delimiter character.'
        help<-1> = '                          # - number of lines to CHANGE (default 1).'
        help<-1> = '                    pattern - is the pattern match for the line.'
        help<-1> = '                        to - is the character string to substitute/add.'
        help<-1> = '                      range - Can be numeric, which field(s) to change,'
        help<-1> = "                          or 'A'ppend or 'P'refix to the line,"
        help<-1> = "                          or 'D'elete, 'R'eplace, 'L'ocate (default) the line."
        help<-1> = "              EG 'CM/6X' will scan to the line matching '6X'."
        help<-1> = "              Also; 'N'ot - locate the next non-matching line."
        help<-1> = 'COL          + Display relative COLUMN POSITIONS on the Terminal.'
        help<-1> = 'COPY        # Copy the predefined block to the kept buffer.'
        help<-1> = 'COPY#        # Copy the next # lines to the kept buffer.'
        help<-1> = 'COPYx/y      # Copy x lines starting at line y to the kept buffer.'
        help<-1> = 'COPY/x/y    # Copy lines from x to y inclusive to the kept buffer.'
        help<-1> = "COUNT#/any  + Count of 'any' in next # lines (default 1)."
        help<-1> = "CRT xxxx    - Inserts a line CRT 'xxxx = ':xxxx"
        help<-1> = '              Use double quote or backslash as delimiter to change quotes.'
        help<-1> = 'CUT          = Move the predefined block to the kept buffer.'
        help<-1> = 'CUT#        = Move the next # lines to the kept buffer.'
        help<-1> = 'CUTx/y      = Move x lines starting at line y to kept buffer.'
        help<-1> = 'CUT/x/y      = Move lines from x to y inclusive to kept buffer.'
        help<-1> = 'D            + Display the current line.'
        help<-1> = 'DE          - DELETE the current line.'
        help<-1> = "DE#          - DELETE '#' lines (default 1)."
        help<-1> = "DE#/any      - DELETE as above, but only if the line contains 'any'."
        help<-1> = "DISPLAY xxxx - Inserts a line DISPLAY 'xxxx = ':xxxx"
        help<-1> = '              Just like CRT, handy to distinguish debug code.'
        help<-1> = 'DROP        - Remove the predefined block.'
        help<-1> = "DTX any      + Convert decimal string 'any' to hexadecimal and display it."
        help<-1> = 'DUP          - DUPLICATE the current line.'
        help<-1> = "DUP#        - DUPLICATE the current line '#' times."
        help<-1> = 'EC          + Edit a called subroutine in this file.'
        help<-1> = 'ECS          # Edit the command stack.'
        help<-1> = 'EF#          + Edit fields delimited by CHAR(#) as lines.'
        help<-1> = 'EI          + Edit the included code.'
        help<-1> = 'EIT          + Edit I-type (not just a split on semi-colon).'
        help<-1> = 'EK          # Edit the kept buffer.'
        help<-1> = 'EPR          + Edit the prestored commands.'
        help<-1> = 'EPR#        # Edit prestored commqnd #.'
        help<-1> = 'ESS          # Edit Search Stack.'
        help<-1> = 'ESV          + Edit subvalues as 1ines.'
        help<-1> = 'ET          # Edit the line tabs.'
        help<-1> = 'EV          + Edit multivalues as lines.'
        help<-1> = 'EW          + Edit words as lines.'
        help<-1> = 'EXIT (EX)    + QUIT - EXIT the program.'
        help<-1> = 'EXITK (EXK)  + QUITKill - EXIT the program, abandon any active SELECT list.'
        help<-1> = 'FD          - DELETE the entire record from the file.'
        help<-1> = 'FI          - FILE the record. You can also process it.'
        help<-1> = '              FIB = BASIC, FIC = CATALOG, FIR = RUN'
        help<-1> = '              You can have up to three processes (EG. FIBCR).'
        help<-1> = '              You can modify BASIC with D for DEBUGGING (EG. FIBD).'
        help<-1> = '              You can modify CATALOG with L for LOCAL (EG. FICL).'
        help<-1> = 'FILE        - Synonym for SAVE.'
        help<-1> = 'FL          + Find the next Label.'
        help<-1> = "FL any      + Find the label 'any' or matching pattern 'any'."
        help<-1> = 'FL#          + Find (display) the labels in next # lines.'
        help<-1> = 'FLA          + Find label above this line.'
        help<-1> = 'FM          + Find Matching logic by position.'
        help<-1> = 'FMA          + Find Matching logic by position above this line.'
        help<-1> = 'FOLD/length  - Split current line (on blanks if possible) to fit width.'
        help<-1> = 'FORMAT (FOR) + FORMAT a BASIC program to show logical structure by'
        help<-1> = '              indenting. This has the following keywords;'
        help<-1> = "              '-Mx' = Set margin to x."
        help<-1> = "              '-Iy' = Set Indentation to y."
        help<-1> = "              '-A' = Align comments with code."
        help<-1> = "              '-N' = No CASE indentation."
        help<-1> = "              '-C' = Compress - same as '-M0 -I1 -A -N'."
        help<-1> = "G#          + GO TO line '#' ('G' is optional)."
        help<-1> = 'HELP (H)    + Prompt user to display HELP information on the Terminal.'
        help<-1> = "HELP any    + Display HELP information on Terminal for 'any'."
        help<-1> = 'HELP NEW    + Display HELP information on new features.'
        help<-1> = 'HEX          + Displays the current line in hexadecimal.'
        help<-1> = 'I            - INSERT new lines AFTER the current line. Prompt for'
        help<-1> = '              successive lines. INPUT until NULL input. An INPUT line'
        help<-1> = '              of a single space will store an empty line.'
        help<-1> = "I any        - INSERT (INPUT) the line 'any' AFTER the current line."
        help<-1> = "I#/any      - INSERT # lines of 'any' AFTER the current line."
        help<-1> = "IC any      - IConv the line using the conversion 'any'."
        help<-1> = 'IN command  - Insert the results of the command AFTER the current line.'
        help<-1> = '              It is not a good idea to use a command requiring input.'
        help<-1> = "J#/any      - Join next '#' lines (default 1), separated by 'any'."
        help<-1> = "KEEP name    # Copy the record 'name' into the kept buffer."
        help<-1> = "              line #'s will be prompted."
        help<-1> = "KEEP f name  # Copy the record 'name' from file 'f' into the kept buffer,"
        help<-1> = "              line #'s will be prompted."
        help<-1> = 'KEEPA        # KEEPAll - KEEP without line # prompting.'
        help<-1> = 'KEPT (K)    # Display the kept buffer.'
        help<-1> = "L            + Repeat the last 'LOCATE' command (L, LA, LN, or LNA)."
        help<-1> = "L any        + LOCATE the next line that contains the string 'any'."
        help<-1> = "L#/any/10-20 + LOCATE in next # lines those with 'any' in columns 10 to 20."
        help<-1> = "              So 'L#' effectively lists # lines."
        help<-1> = "L#!any!THING # LOCATE in next # lines those with 'any' OR 'THING'."
        help<-1> = "L#&any&THING # LOCATE in next # lines those with 'any' AND 'THING'."
        help<-1> = '              ! and & work this way for LA, LN, and LNA commands too.'
        help<-1> = 'LA#/any/1-20 + Locate lines above this one (reverse order).'
        help<-1> = "LC#          - Change '#' lines to lower case (default 1)."
        help<-1> = 'LC# any        Comments and quoted strings are unchanged.'
        help<-1> = "LL#/length  + Show lines 'length' or longer (null '#' is a search)."
        help<-1> = "LN#/any/1-20 + LOCATE NOT - line without 'any' in columns 10 to 20."
        help<-1> = "LNA#/an/1-20 + LOCATE line above this without 'an' in columns 1 to 20."
        help<-1> = "LOAD name    - LOAD the record 'name' from the current FILE,"
        help<-1> = "              line #'s will be prompted."
        help<-1> = "LOAD f name  - LOAD the record 'name' from file 'f',"
        help<-1> = "              line #'s will be prompted."
        help<-1> = 'LOADA        - LOADAll - LOAD without line # prompting.'
        help<-1> = 'LD          - Synonym for LOAD.'
        help<-1> = 'LDA          - Synonym for LOADA.'
        help<-1> = 'M pattern    + Search for a line matching the pattern.'
        help<-1> = 'MACRO#      + Toggle macro recording into #th PRESTORE command.'
        help<-1> = 'MERGE (ME)  = Merge a copy of the predefined block after the current line.'
        help<-1> = 'MERGEx/y    = Merge x lines starting at line y.'
        help<-1> = 'MERGE/x/y    = Merge lines starting at x to line y inclusive.'
        help<-1> = 'MOVE (MV)    - Move the predefined block to after the current line.'
        help<-1> = 'MOVEx/y      = Move the x lines starting at line y.'
        help<-1> = 'MOVE/x/y    = Move the lines starting at x to line y inclusive.'
        help<-1> = 'NUM          + Toggle the line numbering.'
        help<-1> = "NULL/symbol  + Change the null line input for 'I' to 'symbol'."
        help<-1> = "OC# any      - OConv '#' lines using the conversion 'any'."
        help<-1> = 'OOPS        - RESTORE the record to the condition prior to last change.'
        help<-1> = "OUT#        # Outline (labels, gotos, gosubs) for '#' lines (default all)."
        help<-1> = 'OUT# CEPS      Show Calls, Executes, Performs, and caSe also (* for all).'
        help<-1> = 'P            + PRINT on Terminal one page worth of lines.'
        help<-1> = "P#          + PRINT on Terminal '#' lines starting with the current line."
        help<-1> = "PA#          + PRINT the current line and the prior '#' lines,"
        help<-1> = '              do not change the current line pointer.'
        help<-1> = "PASTE        = Paste the kept buffer after the current line'."
        help<-1> = "PASTE name  = Copy the kept buffer under the specified 'name'."
        help<-1> = "PASTE f name = Copy the kept buffer as record 'name' in file 'f'."
        help<-1> = 'PE          + Page Edit mode.'
        help<-1> = "PL#          + PRINT the current line and the next '#' lines,"
        help<-1> = '              do not change the current line pointer.'
        help<-1> = "PP#          + PAGE.PRINT a window of '#' lines around the current line,"
        help<-1> = '              do not change the current line pointer.'
        help<-1> = 'PR          + Show the PRESTORE commands.'
        help<-1> = 'PR#          + Run the #th PRESTORE command.'
        help<-1> = 'PR#/any      + Change the #th PRESTORE command.'
        help<-1> = '              where / - is any delimiter character which will also be'
        help<-1> = '                        used as the command separator.'
        help<-1> = 'QUIT (Q)    + QUIT - EXIT the program.'
        help<-1> = 'QUITK (QK)  + QuitKill - EXIT the program, abandon any active SELECT list.'
        help<-1> = 'R            - Replace the line with prompted for text.'
        help<-1> = "R any        - REPLACE this line with 'any'."
        help<-1> = "R#/any      - REPLACE # lines with 'any'."
        help<-1> = 'R///        - CHANGE one or more lines (same as C/// command).'
        help<-1> = "RA          = Show last 20 'CHANGE' commands."
        help<-1> = "RA#          = Repeat #th 'CHANGE' command."
        help<-1> = 'RELEASE      + RELEASE the update record LOCK for this file.'
        help<-1> = "S            - Show last 20 'LOCATE' commands."
        help<-1> = "S#          - Repeat #th 'LOCATE' command."
        help<-1> = 'SAVE        - SAVE a copy of this record under the original name.'
        help<-1> = "SAVE name    - SAVE a copy of this record under the specified 'name'."
        help<-1> = "SAVE f name  - SAVE a copy of this record as record 'name' in file 'f'."
        help<-1> = 'SEQ#////    - Build a sequence. Format is:'
        help<-1> = '              SEQ#/from/base/inc/cols'
        help<-1> = '              where    / - is any delimiter character.'
        help<-1> = '                        # - number of lines to CHANGE (default 1).'
        help<-1> = '                    from - is the character string to be replaced.'
        help<-1> = '                    base - is the start number (defaults to 1).'
        help<-1> = '                      inc - is the increment (defaults to 1).'
        help<-1> = '                    cols - restricts the change to a column range.'
        help<-1> = "SHOW ON/OFF  + toggle overriding 'S'how flag for 'C' command."
        help<-1> = "              OFF won't show more than a page of changes."
        help<-1> = '              If neither ON nor OFF is used, then toggle SHOW flag.'
        help<-1> = "SORT seq    - Sort the predefined block (seq defaults to 'AL')."
        help<-1> = "SORTU seq    # Sort unique predefined block ('AL' default seq)."
        help<-1> = 'SPACE ON/OFF + Switch SPACE flag for L, LA, LN, LNA commands.'
        help<-1> = '              If neither ON nor OFF is used, then toggle SPACE flag.'
        help<-1> = '              OFF means that the commands will ignore spaces and tabs.'
        help<-1> = 'SPOOL        + SPOOL entire record to PRINTER.'
        help<-1> = "SPOOL#      + SPOOL '#' lines to the PRINTER."
        help<-1> = 'SPOOLHELP    + SPOOL the HELP listing to the default PRINTER.'
        help<-1> = "SPOUT#      # SPOO outline (labels, gotos, gosubs) for '#' lines (default all)."
        help<-1> = 'SPOUT# CEPS    Show Calls, Executes, Performs, and caSe also (* for all).'
        help<-1> = "STAMP        - INSERT a 'last modified' stamp into the record, which"
        help<-1> = "              begins with a '*' (for BASIC 'comment'), and contains the"
        help<-1> = '              account name, LOGIN name (if different from account name),'
        help<-1> = '              date and time. Used to mark when record was last changed.'
        help<-1> = 'SV          - Synonym for SAVE.'
        help<-1> = 'T            + Set current line to the TOP (before first line).'
        help<-1> = "TC#          - Change '#' lines to text or mixed case (default 1)."
        help<-1> = 'TC# any        Comments and quoted strings are unchanged.'
        help<-1> = "TRIM#        - TRIM '#' lines (default 1)."
        help<-1> = "TRIM# a b    = TRIM '#' lines of character 'a' with argument 'b'."
        help<-1> = "TRIMB#      - TRIMB '#' lines (default 1)."
        help<-1> = "TRIMF#      - TRIMF '#' lines (default 1)."
        help<-1> = "TRIPLE#/any  = Copy '#' lines (default 1) into three clones, joined by 'any'."
        help<-1> = "TWIN#/any    = Copy '#' lines (default 1) into two clones, joined by 'any'."
        help<-1> = "UC#          - Change '#' lines to upper case (default 1)."
        help<-1> = 'UC# any        Comments and quoted strings are unchanged.'
        help<-1> = 'UNLOAD      - Synonym for SAVE.'
        help<-1> = 'V            + Version information.'
        help<-1> = 'WHERE (W)    + Show the item and file being ':view:'ed.'
        help<-1> = 'WM          + Show or change the word marker.'
        help<-1> = 'X            + QuitKill - EXIT the program, abandon any active SELECT list.'
        help<-1> = 'XEQ          - The XEQ command allows a user to execute any legal PERFORM'
        help<-1> = '                command from within the program. Upon completion of the'
        help<-1> = '                command, control will be returned back to the program.'
        help<-1> = "XTD any      + Convert hexadecimal string 'any' to decimal and display it."
        help<-1> = '/any        + Same as L99999999/any - NOTE you are left at the bottom.'
        help<-1> = ".A# any      + APPEND 'any' to command '#' (default 1)."
        help<-1> = ".C#///      + CHANGE stack command '#' (default 1). Syntax is like 'C'."
        help<-1> = ".D#          + DELETE stack command '#' (default 1)."
        help<-1> = ".I# any      + INSERT 'any' at stack position '#' (default 1)."
        help<-1> = ".L#          + LIST on the Terminal the last '#' stack commands."
        help<-1> = ".R#          + RECALL (copy) command '#' to stack position 1."
        help<-1> = ".S# n m      + SAVE stack n to m as prestore '#' (all default to 1)."
        help<-1> = ".U#          # UPCASE stack command '#' (default 1)."
        help<-1> = ".UL#        # lower case stack command '#' (default 1)."
        help<-1> = ".UT#        # text case stack command '#' (default 1)."
        help<-1> = ".X#          + EXECUTE stack command '#' (default 1)."
        help<-1> = '              The command will be put in stack position 1.'
        help<-1> = "+#          + Advance current line pointer by '#' lines (default 1)."
        help<-1> = "-#          + Back up current line pointer by '#' lines (default 1)."
        help<-1> = "\            # Set a line tag with default label like 'T#'."
        help<-1> = "\any        # Set a line tag labelled 'any'."
        help<-1> = '\\          # Clear the line tags.'
        help<-1> = "]any        # Go to the line tag 'any'."
        help<-1> = "[any        # Go to the line tag 'any'."
        help<-1> = ']            # Go to the next line tag.'
        help<-1> = '[            # Go to the previous line tag.'
        help<-1> = ']]          # Display the line tags.'
        help<-1> = '[[          # Display the line tags.'
        help<-1> = "#            + Set the current line pointer to the '#' line."
        help<-1> = '<#          + Sets the starting block pointer to # (current line default).'
        help<-1> = '>#          + Sets the ending block pointer to # (current line default).'
        help<-1> = '<># #        + Set both block pointers at the same time.'
        help<-1> = '^            + Switch UP ARROW on/off to show non-printing characters as'
        help<-1> = '              ^nnn where nnn is the decimal equivalent of ASCII code.'
        help<-1> = '?            + Show various parameters - easier to use than explain.'
    end
    rest = trim(upcase(rest))
    if rest eq am then
        hard = true
        rest = ''
    end else hard = false
    disp = ''
    stub = ''
    if rest eq '' then flag = true else flag = false
    if rest eq 'NEW' then disp = 'New Features':am
    good = false
    xxno = dcount(help,am)
    for xx = 1 to xxno
        temp = help<xx>
        bite = temp[1,len(rest)]
        bit = temp[14,1]
        if index('-+=#',bit,1)
          then temp = temp[1,13]:'-':temp[15,huge]
          else bit = ''
        if bit ne '' then
          flag = false
          if bit eq '#' and rest eq 'NEW'              then flag = true
          if (bit eq '#' or bit eq '+') and rest eq ''  then flag = true
          if not(viewflag) then
              if bit eq 'eq' and rest eq 'NEW'            then flag = true
              if bit eq '=' or bit eq '-' and rest eq '' then flag = true
          end
        end
        if not(flag) and rest ne '' and bite eq rest then
          if bit eq '#' or bit eq '+' then flag = true
          if not(viewflag) then
              if bit eq '=' or bit eq '-' then flag = true
          end
        end
        if flag then
          disp<-1> = temp
          good = true
        end
    next xx
    if not(good) then
        disp := am
        disp<-1> = 'No explanation of "':rest:'" is available.'
        disp<-1> = 'For a list of words that have explanations, type "HELP".'
        disp := am
    end
    if hard then gosub print.disp else gosub show.disp
    return
show.disp:
    write disp on voc,'&DISP.':whom
    if stub eq '' then stub = 'Press return to continue showing explanation, Q to quit'
    xxno = dcount(disp,am)
    pg = 0
    for xx = 1 to xxno
        pg += 1
        if pg ge system(3) then
          loop
              rlen = 1
              gosub get.rope; answ = rope
              crt begn:ceol:
              answ = trim(upcase(answ))[1,1]
          until index('QT-',answ,1) do
          repeat
          if answ eq 'Q' then return
          if answ eq 'T' then xx = 1
          if answ eq '-' then
              xx -= 2*(system(3)-1)
              if xx lt 1 then xx = 1
          end
          pg = 1
        end
        crt disp<xx>
    next xx
    disp = ''
    return
print.disp:
    printer on
    heading upcase(verb):" help file    ":timedate():"'LL'"
    xxno = dcount(disp,am)
    for xx = 1 to xxno
        print disp<xx>
    next xx
    printer close
    return
get.page.comd:
    gosub get.keyc
do.page.comd:
    locate(keyc,keys;cpos) then cpos = acts<cpos> else cpos = 0
    begin case
        case cpos eq uarr ;* up key
          if here le 1 then crt bell:; return
          gosub check.page
          here -= 1
          if prow le 1 then
              ptop = ptop - botl
              if ptop lt 1 then ptop = 1
              gosub disp.page
          end
          gosub get.line; temp = line
        case cpos eq darr ;* down key
          if here ge last then crt bell:; return
          gosub check.page
          here += 1
          if prow ge botl then
              ptop = ptop + botl
              if ptop ge last then ptop = last - botl + 1
              if ptop le 1 then ptop = 1
              gosub display.page
          end
          gosub get.line; temp = line
        case cpos eq larr ;* left key
          if pchr le 1 then crt bell:; return
          pchr -= 1
          if pchr lt ppos then
              gosub check.page
              gosub disp.page
          end
        case cpos eq rarr ;* right key
          pchr += 1
          if pchr-ppos ge span then
              gosub check.page
              gosub disp.page
          end
        case cpos eq upag ;* page up key
          gosub check.page
          ptop -= botl
          if ptop lt 1 then ptop = 1
          here -= botl
          if here lt 1 then here = 1
          pchr = 1
          gosub get.line; temp = line
          gosub disp.page
        case cpos eq dpag ;* page down key
          gosub check.page
          ptop = ptop + botl
          if ptop ge last then ptop = last - botl + 1
          here = here + botl
          if here gt last then here = last
          pchr = 1
          gosub get.line; temp = line
          gosub disp.page
        case cpos eq lpag ;* start of line key
          pchr = 1
          if pchr lt ppos then gosub check.page; gosub disp.page
        case cpos eq rpag ;* end of line key
          pchr = len(temp)+1
          if pchr lt ppos then gosub check.page; gosub disp.page
          if pchr-ppos ge span then
              gosub check.page
              gosub disp.page
          end
        case cpos eq tpag ;* top page key
          gosub check.page
          here = 1
          ptop = 1
          pchr = 1
          gosub disp.page
          gosub get.line; temp = line
        case cpos eq bpag ;* bottom page key
          gosub check.page
          here = last
          ptop = last - botl + 1
          gosub get.line
          pchr = len(line)+1
          gosub disp.page
          gosub get.line; temp = line
        case cpos eq escp ;* escape key
          if this ne that then
              crt @(0,botl):ceol:revb:'ABANDONING CHANGES':revf
          end
          this = that
          here = savl<1>
          gosub set.record
          mode = 'LINE'
        case cpos eq phlp ;* help key
          gosub check.page
          gosub page.help
        case cpos eq zoom ;* Go to line key
          crt bott:
          stub = 'Go to line :'
          stay = pchr
          gosub get.rope; numb = trim(rope)
          pchr = stay
          crt bott:revb:'Press <F1> for help.':revf:
          if not(numb matches '1N0N') then numb = here
          if numb gt last then numb = last
          if numb eq here then return
          gosub check.page
          here = numb
          ptop = here
          pchr = 1
          gosub disp.page
          gosub get.line; temp = line
        case cpos eq skey ;* forward search
          crt bott:
          stub = 'Search: ':'> '
          stay = pchr
          pick = lastfind; gosub get.rope; lastfind = rope
          pchr = stay
          crt bott:revb:'Press <F1> for help.':revf:
          if lastfind eq '' then return
* is it in this line or the rest of the item?
          test = index(temp[pchr+1,huge],lastfind,1)
          save = here
          gosub check.page
          if test then
              test += pchr
          end else
              dawn = here+1
              dusk = last
              for here = dawn to dusk until test
                gosub get.line
                test = index(line,lastfind,1)
                if test then save = here
              next here
          end
          if test then
              if save lt ptop or save ge (ptop+botl) then ptop = save
              here = save
              pchr = test
              gosub disp.page
          end else here = save
          gosub get.line; temp = line
        case cpos eq rkey ;* reverse search
          crt bott:
          stub = 'Search: ':'< '
          stay = pchr
          pick = lastfind; gosub get.rope; lastfind = rope
          pchr = stay
          crt bott:revb:'Press <F1> for help.':revf:
          if lastfind eq '' then return
* is it in this line before the cursor position or the rest of the item above?
          test = index(temp[1,pchr-1],lastfind,1)
          save = here
          gosub check.page
          if not(test) then
              dawn = 1
              dusk = here-1
              for here = dusk to dawn step -1 until test
                gosub get.line
                what = count(line,lastfind)
                if what then
                    test = index(line,lastfind,what)
                    save = here
                end
              next here
          end
          if test then
              if save lt ptop or save ge (ptop+botl) then ptop = save
              here = save
              pchr = test
              gosub disp.page
          end else here = save
          gosub get.line; temp = line
        case not(sec.write.flg)
          crt bell:
        case cpos eq delc ;* delete character key
          if temp eq '' then return
          if pchr eq 1 then
              temp = temp[2,len(temp)]
          end else
              temp = temp[1,pchr-1]:temp[pchr+1,len(temp)]
          end
          crap = temp[pchr,span-pcol]
          convert badc to gudc in crap
          crt @(pcol,prow):ceol:crap:
        case cpos eq dell ;* delete line key
          del this<here>
          gosub set.record
          gosub disp.page
          gosub get.line; temp = line
        case cpos eq delr ;* delete to end of line key
          if pchr gt len(temp) then
              if here ge last then crt bell:; return
              line = fmt(temp,'l#':pchr-1):this<here+1>
              del this<here>
              this<here> = line
              gosub set.record
              gosub disp.page
              gosub get.line; temp = line
          end else
              temp = temp[1,pchr-1]
              this<here> = temp
              memr(cell)<lnum> = temp
              line = temp
              crt @(pcol,prow):ceol:
          end
        case cpos eq back ;* backspace key
          if pchr eq 1 then crt bell:; return
          pchr -= 1
          temp = temp[1,pchr-1]:temp[pchr+1,len(temp)]
          if pchr lt ppos then
              gosub check.page
              gosub disp.page
          end else
              pcol = rem(pchr-1,span)
              crt @(pcol,prow):ceol:
              crap = temp[pchr,span-pcol]
              convert badc to gudc in crap
              crt crap:
          end
        case cpos eq carr ;* carriage return key
          if pchr eq 1 then
              line = ''
          end else
              line = temp[1,pchr-1]
              temp = temp[pchr,len(temp)]
          end
          if lnum eq 0 then lnum = 1
          memr(cell)<lnum> = line
          last += 1
          lnum += 1
          line = temp
          gosub insert.line
          gosub reset.record
          here += 1
          pchr = 1
          if prow ge botl then
              ptop = ptop + botl
              if ptop ge last then ptop = last - botl + 1
              if ptop le 1 then ptop = 1
              gosub display.page
          end else gosub disp.page
          gosub get.line; temp = line
        case cpos eq togg ;* toggle mode key
          if mode<2> eq 'Ins' then
              mode<2> = 'Rep'
          end else mode<2> = 'Ins'
        case cpos eq writ ;* write away data key
          gosub check.page
          mode = 'LINE'
        case seq(keyc) lt 28 or seq(keyc) gt 127 or len(keyc) gt 1
          crt bell:
        case seq(keyc) eq 30 or seq(keyc) eq 31
          crt bell:
        case 1
          if seq(keyc) eq 28 then keyc = char(252)
          if seq(keyc) eq 29 then keyc = char(253)
          if pchr and len(temp) lt (pchr-1) then
              temp = temp:str(' ',pchr)
              temp = temp[1,pchr-1]
          end
          if mode<2> eq 'Ins'
              then offset = pchr
              else offset = pchr+1
          if pchr eq 1
              then temp = keyc:temp[offset,len(temp)]
              else temp = temp[1,pchr-1]:keyc:temp[offset,len(temp)]
          if mode<2> eq 'Ins' then
              crt @(pcol,prow):ceol:
              crap = temp[pchr,span-pcol]
          end else crap = keyc
          convert badc to gudc in crap
          crt @(pcol,prow):crap:
          pchr += 1
          if pchr-ppos ge span then
              gosub check.page
              gosub disp.page
          end
    end case
    return
check.page:
    if '*':temp ne '*':line then
        memr(cell)<lnum> = temp
        gosub reset.record
    end
    return
page.help:
    gosub clear.page
    if pagehelp eq '' then
        if sec.write.flg then
          pagehelp = ''
          pagehelp<-1> = '                              Page editing help'
          pagehelp<-1> = ''
          pagehelp<-1> = ' Cursor movement keys                    Line movement keys'
          pagehelp<-1> = ''
          pagehelp<-1> = '      UP = <UP arrow> or ^Z              LEFT END = <Home> or ^A'
          pagehelp<-1> = '    DOWN = <DOWN arrow> or ^J            RIGHT END = <End> or ^E'
          pagehelp<-1> = '    LEFT = <LEFT arrow> or ^U          GO TO LINE = ^G'
          pagehelp<-1> = '    RIGHT = <RIGHT arrow> or ^F                (prompts for desired line)'
          pagehelp<-1> = ''
          pagehelp<-1> = ' Page movement keys                      Deleting keys'
          pagehelp<-1> = ''
          pagehelp<-1> = ' PREVIOUS = <Page Up> or ^P                DELETE CHAR = <Delete> or ^D'
          pagehelp<-1> = '    NEXT = <Page Down> or ^N              DELETE LINE = <Ctrl-Home> or ^X'
          pagehelp<-1> = '      TOP = <Ctrl-Page Up> or ^T        DELETE TO EOL = <Ctrl-End> or ^K or ^R'
          pagehelp<-1> = '  BOTTOM = <Ctrl-Page Down> or ^B'
          pagehelp<-1> = '                                        <Ctrl-]> = Value Mark'
          pagehelp<-1> = ' <Backspace> is destructive              <Ctrl-\> = Sub-value Mark'
          pagehelp<-1> = ' <Enter> splits the line'
          pagehelp<-1> = ' <Insert> or <Tab> toggles between the insert and overwrite modes'
          pagehelp<-1> = ''
          pagehelp<-1> = ' <F2> or ^W Returns to line editor mode WITH changes'
          pagehelp<-1> = ' <Esc> or ^Q Returns without changes'
        end else
          pagehelp = ''
          pagehelp<-1> = '                              Page viewing help'
          pagehelp<-1> = ''
          pagehelp<-1> = ' Cursor movement keys                    Line movement keys'
          pagehelp<-1> = ''
          pagehelp<-1> = '      UP = <UP arrow> or ^Z              LEFT END = <Home> or ^A'
          pagehelp<-1> = '    DOWN = <DOWN arrow> or ^J            RIGHT END = <End> or ^E'
          pagehelp<-1> = '    LEFT = <LEFT arrow> or ^U          GO TO LINE = ^G'
          pagehelp<-1> = '    RIGHT = <RIGHT arrow> or ^F                (prompts for desired line)'
          pagehelp<-1> = ''
          pagehelp<-1> = ' Page movement keys          '
          pagehelp<-1> = ''
          pagehelp<-1> = ' PREVIOUS = <Page Up> or ^P  '
          pagehelp<-1> = '    NEXT = <Page Down> or ^N '
          pagehelp<-1> = '      TOP = <Ctrl-Page Up> or ^T'
          pagehelp<-1> = '  BOTTOM = <Ctrl-Page Down> or ^B'
          pagehelp<-1> = ''
          pagehelp<-1> = ''
          pagehelp<-1> = ' <Esc> or ^Q Returns without changes'
        end
    end
    disp = pagehelp ; stub = ''
    gosub show.disp
    crt bott:
    stub = 'Press RETURN to continue'
    gosub get.rope
    gosub display.page
    return
get.line:
    line = ''
    if here eq 0 then
        cell = 1
        lnum = 0
        return
    end
    if here gt last then return
    cell = int((here-1)/cellsize) + 1
    coff = rem(here,cellsize)
    if ooff and ocel eq cell and ooff eq coff - 1 then
        lnum = ooff ; ooff = coff
    end else
        tlin = memr(cell)
        lnum = 0 ; ocel = cell ; ooff = coff
    end
    loop
        remove bite from tlin setting dlim
        line = line:bite
    while dlim do
        if dlim eq 2 then
          lnum += 1
          if lnum eq coff then exit
          line = ''
        end else
          line = line:char(256-dlim)
        end
    repeat
    if not(dlim) then lnum += 1
    return
delete.lines:
    chng = 0
    if dawn gt dusk then
        crt 'No deletion possible - ':dawn:' > ':dusk:'.'
        return
    end
    gosub savethat
    chng = dusk - dawn + 1
    begin case
        case dawn le 1 and dusk ge last
          krj = ''
          this = ''
          beg = 0
          fin = 0
        case dusk ge last
          temp = index(this,am,dawn-1)
          this = this[1,temp-1]
          if beg gt dawn then beg = 0
          if fin gt dawn then fin = 0
          for xx = dcount(krj<1>,vm) to 1 step -1
              if krj<2,xx> gt dawn then
                del krj<1,xx> ; del krj<2,xx> ; krj<3> -= 1
              end
          next xx
        case dawn eq 1
          temp = index(this,am,dusk)
          this = this[temp+1,len(this)]
          if beg le dusk then beg = 0 else beg = beg - chng
          if fin le dusk then fin = 0 else fin = fin - chng
          for xx = dcount(krj<1>,vm) to 1 step -1
              if krj<2,xx> le dusk then
                del krj<1,xx> ; del krj<2,xx> ; krj<3> -= 1
              end
          next xx
        case 1
          temp = index(this,am,dawn-1)
          temp<2> = index(this,am,dusk)
          this = this[1,temp<1>]:this[temp<2>+1,len(this)]
          if beg ge dawn and beg le dusk then beg = 0 else
              if beg gt dusk then beg -= chng
          end
          if fin ge dawn and fin le dusk then fin = 0 else
              if fin gt dusk then fin -= chng
          end
          for xx = dcount(krj<1>,vm) to 1 step -1
              begin case
                case krj<2,xx> gt dusk ; krj<2,xx> -= chng
                case krj<2,xx> ge dawn
                    del krj<1,xx> ; del krj<2,xx> ; krj<3> -= 1
              end case
          next xx
    end case
    begin case
        case here gt dusk
          here = here - dusk + dawn - 1
        case here gt dawn
          here = dawn
    end case
    gosub set.record
    return
check.line:
    if '*':temp ne '*':line then
        if not(chng) then gosub savethis
        chng += 1
        memr(cell)<lnum> = temp
        if shew or dnum lt plen then gosub display.line
    end
    return
insert.line:
    if here le beg then beg += 1
    if here le fin then fin += 1
    yyno = dcount(krj<1>,vm)
    for yy = 1 to yyno
        if krj<2,yy> gt here then krj<2,yy> += 1
    next yy
    memr(cell) = insert(memr(cell),lnum,0,0,line)
    if lfmt and len(last) gt 3 and len(last) ne llen then gosub get.lfmt
    return
display.line:
    begin case
        case last eq 0
          here = 0
          gosub get.line
          crt begn:'Top of empty record.'
        case here eq 0
          gosub get.line
          crt 'Top.'
        case here gt last
          crt 'Bottom.'
        case 1
          gosub get.line
          if wild then
              xxno = len(line)
              temp = ''
              for xx = 1 to xxno
                bite = line[xx,1]
                bite = seq(bite)
                if bite ge 127 or bite lt 32 then
$ifdef unidata
                    bite = '^':fmt(bite,'3/0R')
$else
                    bite = '^':fmt(bite,'R%3')
$endif
                end else bite = char(bite)
                temp = temp:bite
              next xx
              line = temp
          end else convert badc to gudc in line
          crt begn:ceol:
          if lfmt then
              blk = ': '
              if here eq beg then blk = '< '
              if here eq fin then blk = '> '
              if here eq beg and here eq fin then blk = '<>'
              if lfmt then crt (here lfmt):blk:
          end
          if bleach then
              crt line
          end else
              if here ge beg and here le fin
                then showline = @(-13):@(-5):line:@(-6):@(-14)
*                else call SORT.LINE(showline,line,1,len(line),lastfind,caseflag)
                else setoff = 1 ; width = len(line) ; gosub getshowline
              crt showline
          end
          dnum += 1
          if here eq last then crt 'Bottom at line ':last:'.'
    end case
    return
clear.page:
    for xx = system(3)-1 to 0 step -1
        crt @(00,xx):ceol:
    next xx
    return
display.page:
    crt clpg
disp.page:
    if pchr lt 1 then pchr = 1
    gosub clear.page
    gosub get.lfmt
    crt bott:revb:'Press <F1> for help.':revf:
    crt @(0,0):ceol:revb:
    if viewflag
        then crt 'Viewing "':item:'" in file "':fnam:'"':
        else crt 'Editing "':item:'" in file "':fnam:'"':
    crt revf:
    if idcnt gt 1 then crt ' <':id:'/':idcnt:'> ':
    crt
    ppos = int((pchr-1)/span)
    ppos = span*ppos+1
    save = here:am:lnum:am:cell:am:line
    for xx = 1 to botl
        here = ptop + xx - 1
        gosub get.line
        if bleach then
          disp = line[ppos,span]
          convert badc to gudc in disp
        end else
          convert badc to gudc in line
          disp = line
          if here ge beg and here le fin
              then showline = @(-13):@(-5):disp[ppos,span]:@(-6):@(-14)
*              else call SORT.LINE(showline,disp,ppos,span,lastfind,caseflag)
              else setoff = ppos ; width = span ; gosub getshowline
          disp = showline
        end
        crt @(0,xx):disp:
    next xx
    here = save<1>; lnum = save<2>; cell = save<3>; line = save<4>
    return
savethis:
    oops = this ; oopc = comi ; oopl = save ; oopf = savl
    oopb = beg:am:fin ; oopk = krj
*    if level eq 0 then write oops on voc, '&LED.':whom
    return
savethat:
    oops = this ; oopc = comi ; oopl = here ; oopf = last
    oopb = beg:am:fin ; oopk = krj
*    if level eq 0 then write oops on voc, '&LED.':whom
    return
reset.record:
    matbuild this from memr using am
set.record:
    gosub parse.record
    gosub get.line
    if len(last) gt 3 and len(last) ne llen then gosub get.lfmt
    return
parse.record:
    this = this
    ocel = '' ; ooff = ''
    last = dcount(this,am)
    if last eq 0 then
        dim memr(1)
        mat memr = ''
        cell = 1 ; lnum = 0
        return
    end
    numcells = int((last-1)/cellsize)+1
    dim memr(numcells)
    mat memr = ''
    cell = 1
    lnum = 0
    for cell = 1 to numcells
        memr(cell) = field(this,@am,(cell-1)*cellsize+1,cellsize)
    next cell
!    line = ''
!    loop
!      remove bite from this setting mark
!      line = line:bite
!      begin case
!          case mark eq 0
!            if line ne '' then
!                line = line[1,len(line)]
!            end
!            memr(cell) = line
!          case mark eq 2
!            lnum += 1
!            if lnum ge cellsize then
!                memr(cell) = line
!                line = ''
!                cell += 1
!                lnum = 0
!            end else
!                line = line:char(256-mark)
!            end
!          case 1
!            line = line:char(256-mark)
!      end case
!    while mark do
!    repeat
    cell = 1
    lnum = 0
    return
locked.record:
    stub = 'Record is currently locked by another user. Try again? ':ny:' '
    gosub get.rope; answ = rope
    answ = upcase(trim(answ))
    if answ eq 'PASSWORD' then
        lock = false
        read this from file, item then goto carry.on
    end
    if answ[1,1] eq yes[1,1] then goto edit.item
    return
exec.that:
    temp = temp<1>:' ':fnam:' ':item:temp<2>
    if fileinfo(file,3) ne '4' then
        crt 'Cannot ':temp:' - must be type 1 or 19'
        return
    end
    execute temp
    test = @(0,0)
    return
parse.rest:
    bite = ''
    flag = ''
    posn = 1
    xxno = len(rest)
    for xx = 1 to xxno
        bit = rest[xx,1]
        if flag eq '' then
          if bit eq ' ' then
              if bite<posn> ne '' then posn += 1
          end else
              if index(qt,bit,1) then
                flag = bit
                if keepquot then bite<posn> = bite<posn>:bit
              end else
                if bit eq '(' then
                    flag = ')'
                    if bite<posn> ne '' then posn += 1
                    bite<posn> = '('
                end else bite<posn> = bite<posn>:bit
              end
          end
        end else
          if bit ne flag then
              bite<posn> = bite<posn>:bit
          end else
              if keepquot or bit eq ')' then bite<posn> = bite<posn>:bit
              posn += 1
              flag = ''
          end
        end
    next xx
    return
split.itype:
    bite = ''
    flag = ''
    posn = 1
    xxno = len(line)
    for xx = 1 to xxno
        bit = line[xx,1]
        if flag eq '' then
          if bit eq ';' then
              posn += 1
          end else
              if index(qt,bit,1) then flag = bit
              if bit eq '(' then flag = ')'
              bite<posn> = bite<posn>:bit
          end
        end else
          if bit eq flag[1,1] then flag = flag[2,huge]
          if bit eq '(' and flag[1,1] eq ')' then flag := ')'
          bite<posn> = bite<posn>:bit
        end
    next xx
    return
get.lfmt:
* set up the line format
    llen = len(last)
    if llen lt 3 then llen = 3
$ifdef unidata
    lfmt = llen:'/0R'
$else
    lfmt = 'R%':llen
    if index(item,'_IType.',1) then lfmt = llen:'@R'
$endif
    prmt = '*':str('-',llen-1)
    return
leftarr: *
    numb = oconv(trim(comi[2,len(comi)]),'MCN')
    if numb eq '' then numb = here
    if numb gt last then numb = ''
    if numb ge 0 then
        crt 'Block starts at line ':numb:
        beg = numb
        if fin and beg gt fin then
          crt '; End moved from ':fin:' to ':beg
          fin = beg
          mov = 1
        end else
          if fin then mov = fin - beg + 1 else mov = last - beg
          crt ' (':mov:' lines)'
        end
        if numb eq here then gosub display.line
    end else crt 'Cannot mark line ':numb
    return
rightarr: *
    numb = oconv(trim(comi[2,len(comi)]),'MCN')
    if numb eq '' then numb = here
    if numb gt last then numb = ''
    if numb ge 0 then
        crt 'Block ends at line ':numb:
        fin = numb
        if beg gt fin then
          crt '; Start moved from ':beg:' to ':fin
          beg = fin
          mov = 1
        end else
          if beg then mov = fin - beg + 1 else mov = fin
          crt ' (':mov:' lines)'
        end
        if numb eq here then gosub display.line
    end else crt 'Cannot mark line ':numb
    return
botharr: *
    numb = trim(comi[3,len(comi)])
    begin case
        case numb matches '1N0N'
          numb = numb:am:numb
        case numb matches '1N0N"-"1N0N'
          numb = field(numb,'-',1):am:field(numb,'-',2)
        case numb matches '1N0N" "1N0N'
          numb = field(numb,' ',1):am:field(numb,' ',2)
        case numb eq ''
          numb = here:am:here
        case 1
          numb = ''
    end case
    if numb<2> gt last then numb<2> = last
    if numb<1> gt last then numb = ''
    if numb<2> lt numb<1> then
        crt 'Block starts at ':numb<1>:' and ends at ':numb<2>:' => ':
        numb = ''
    end
    if numb ne '' then
        beg = numb<1>
        fin = numb<2>
        if beg eq fin then
          crt 'Block starts and ends at line ':beg
        end else
          crt 'Block starts at ':beg:' and ends at ':fin
        end
        if here eq beg or here eq fin then
          gosub display.line
        end
    end else crt 'Cannot mark Block'
    return
recalc.posn:
    begin case
        case posn lt rest and posn le oopl
        case posn lt rest and posn gt oopl
          posn += numb
        case posn ge rest and posn lt (rest+numb)
          posn += (here+1-rest)
        case posn ge (rest+numb) and posn le oopl
          posn -= numb
    end case
    return
find.label:
    temp = field(trimf(line),' ',1)
    temp = trim(temp,char(13),'B')
    chit = temp[1,1]
    begin case
        case chit eq '*' or chit eq '!' ; temp = ''
        case chit matches '1N' or chit eq '.'
          temp = field(temp,'*',1)
          temp = field(temp,'!',1)
          temp = field(temp,':',1)
          test = convert('.0123456789','',temp)
          if test ne '' then temp = ''
        case chit matches '1A' and index(temp,':',1)
          temp = field(temp,':',1)
          test = oconv(oconv(temp,'MC/A'),'MC/N')
          test = convert('._%$','',test)
          if test ne '' then temp = ''
        case 1
          temp = '' 
    end case
    return
get.answ:
    loop
*>
        rlen = 1
*>
        gosub get.rope
        answ = upcase(trim(rope)[1,1])
    until answ eq yes[1,1] or answ eq no[1,1] do
        crt 'Please answer Y or N'
    repeat
    crt
    return
writerr:
$ifdef qm
    if status() eq er$trigger then
        crt 'Data validation error: ': @trigger.return.code
    end else
        crt 'Write error ': status():' (o/s error %2) - Data not saved. Original data will be lost if you leave the editor now.'
    end
$else
    crt 'Write error ': status():' (o/s error %2) - Data not saved. Original data will be lost if you leave the editor now.'
$endif
    return
indenter:
    marg = fr(1) ;* the margin
    dent = fr(2) ;* the indentation
    supp = fr(6) ;* flag - suppress '!' output
    astx = not(fr(9)) ;* flag - keep '*' comments on page edge
    suit = not(fr(10)) ;* flag - indent 'CASE' statements
    dead = 'ACDGHIJKMPQSVXYZ'
    push = 'LOOP\WHILE\UNTIL\FOR\THEN\ELSE\BEGIN\LOCKED\ON~ERROR'
    pull = 'UNTIL\WHILE\REPEAT\NEXT\END'
    convert '\' to am in push
    convert '\' to am in pull
    skip = ';:" (' : "'"
    marx = '\"' : "'"
    bang = false
    xxno = dcount(this,am)
    dim part(100)
    matparse part from this, am
    this = ''
    bite = ''
    first = true
    for xx = 1 to xxno
        there = rem(xx,100)
        if not(there) then
          if first then this = bite else this = this:am:bite
          first = false
          bite = ''
          thisline = part(100)
          temp = part(0)
          matparse part from temp, am
          if not(supp) then bang = true; crt '!':
        end else thisline = part(there)
        if trim(thisline) eq '' then
          if first then bite<there> = '' else bite<there+1> = ''
          continue
        end
        note = false
        wcnt = 0; more = 0; less = 0
        mark = ''; tags = ''; lastword = ''
        zz = 1
        thisline = trimf(thisline)
        if thisline matches '1N0N"*"0X' then
          temp = field(thisline,'*',1)
          thisline = temp:' ':thisline[col2(),len(thisline)]
        end
        thatline = upcase(thisline)
        thatline = change(thatline, 'ON ERROR', 'ON~ERROR')
        left = field(thatline,' ',1)
        if num(left) or left[len(left),1] eq ':' then
          if not(index(left,'=',1)) then tags = thisline[1,len(left)]
        end
        if tags gt '' then
          thisline = trimf(thisline[col2()+1,len(thisline)])
          thatline = trimf(thatline[col2()+1,len(thatline)])
        end
        zzno = len(thisline)
        loop
        while zz lt zzno and not(note) do
          loop
              thisun = thatline[zz,1]
              begin case
                case mark eq '' and index(marx,thisun,1)
                    mark = thisun
                case mark ne ''
                    if thisun eq mark then mark = ''
                case wcnt and thisun eq ';'
                    that = field(trim(thatline[zz+1,zzno]),' ',1)
                    if that[1,3] eq 'REM' then that = ''
                    if that[1,1] eq '*' then that = ''
                    if that[1,1] eq '!' then that = ''
                    if that eq '' then zz = zzno
                case wcnt
                case thisun eq '!' or thisun eq '$'
                    note = true; zz = zzno
                case thisun eq '*'
                    if astx then note = true
                    zz = zzno
                case field(thatline,' ',1) eq 'REM'
                    note = true; zz = zzno
              end case
          while (index(skip,thisun,1) or mark) and zz lt zzno do
              zz += 1
          repeat
          left = zz
          loop
              thisun = thatline[zz,1]
          until index(skip,thisun,1) or zz gt zzno do
              zz += 1
          repeat
          word = thatline[left,zz-left]
          wcnt += 1
          if wcnt ne 1 then
              if word eq 'WHILE' or word eq 'UNTIL' then word = ' '
              if word eq 'NEXT' or word eq 'REPEAT' then
                word = ' '
                more -= dent
              end
              if lastword eq 'LOCKED' then more -= dent
          end else
              if word eq 'LOCKED' or word eq 'THEN' then
                if word eq trim(thatline) then less += dent
              end
          end
          if word eq 'CASE' then
              if lastword ne 'BEGIN' and lastword ne 'END' then
                more += dent
                less += dent
              end
              if suit and lastword eq 'BEGIN' then more += dent
              if suit and lastword eq 'END' then less += dent
          end
          if not(index(dead,word[1,1],1)) then
              locate(word,pull;rubbish) then less += dent
              test = word ne 'THEN' & word ne 'ELSE' & word ne 'ON~ERROR'
              that = trim(thisline[zz,zzno])
              if that[1,1] eq ';' then
                that = trim(that[2,zzno])[1,3]
                if that[1,3] eq 'REM' then that = ''
                if that[1,1] eq '*' then that = ''
                if that[1,1] eq '!' then that = ''
              end
              if test or that eq '' then
                locate(word,push;rubbish) then
                    more += dent
                end
              end
              if word eq 'THEN' or word eq 'LOCKED' then
                if that eq '' and lastword eq '' then less -= dent
              end
              if that ne '' and lastword eq '' then
                if word eq 'THEN' or word eq 'ELSE' then
                    more -= dent
                    less -= dent
                end
                if word eq 'LOCKED' and trim(that)[1,1] ne '='
                    then more -= dent ; less -= dent
              end
          end
          lastword = word
        repeat
        marg -= less
        if tags eq '' then pict = '' else pict = 'L#':(len(tags)+1)
        if marg gt len(tags) then pict = 'L#':marg
        if thisline eq '!' or thisline eq '$' then note = true
        if thatline eq 'REM' then note = true
        if astx and thisline eq '*' then note = true
        if note then
          if tags eq '' then pict = '' else pict = 'L#':(len(tags)+1)
        end
        thisline = trimb(fmt(tags,pict):thisline)
        if first then
          bite<there> = thisline
        end else bite<there+1> = thisline
        marg += more
    next xx
    if bang then crt
    if bite ne '' then
        if first then this = bite else this = this:am:bite
    end
    that = ''
    return
get.rope:
* If the terminal doesn't support screen addressing, do simple input
    if not(editpage) then
        crt begn:stub:
*>        input rope:
        if rlen then
          input rope,rlen:
          rlen = 0
        end else input rope:
*>
        return
    end
*
* The following variables are used
*
*    BARE - what you are going to reveal (the displayed part)
*    CRAM - insert mode on (vs overwrite mode)
*    PCOL - display position
*    STEM - the prefix part of the display line
*    ICON - a picture of what you last displayed
*    PANS - the PAN increment
*    PPOS - the PAN origin
*    WIDE - the PAN width
*    PULP - SEQ(COMI) - what you get from a key press
*    PURE - untouched, a virgin
*    POSN - the stack position
*    PCHR - text position
    pans = int(span/2)
    posn = 0
    rope = pick; pick = ''
    loop
        if heap then
          stem = prmt:': '
          if posn then stem = '*':fmt(posn, "3'0'R"):stem[5,huge]
        end else stem = '*':stub
        wide = span - len(stem) - 1
        pans = int(wide/2)
        ppos = 1
        pchr = 1
        cram = true
        icon = space(span)
        crt begn : ceol :
        pure = true
!&&&
!  if nick and trim(rope) = '' then pchr = len(rope)+1 ; pure = false
!&&&
        loop
          begin case
*>            case pchr lt ppos ; ppos -= pans
              case pchr lt ppos
                loop while pchr lt ppos ; ppos -= pans ; repeat
              case pchr ge (ppos+wide)
                loop while pchr ge(ppos+wide) ; ppos += pans ; repeat
*>            case pchr ge (ppos+wide) ; ppos += pans
          end case
          bare = stem : rope[ppos, wide]
          pcol = 0
          if icon ne bare then
              yyno = 0
              for yy = 1 to span until yyno
                if bare[yy,1] ne icon[yy,1] then yyno = yy
              next yy
              crt @(yyno-1):bare[yyno,span-yyno]:ceol:@(pcol):
              icon = bare[1,span]
          end
          pcol = len(stem) + pchr - ppos
          crt @(pcol) :
          gosub get.keyc
          locate(keyc,keys;cpos) then cpos = acts<cpos> else cpos = 0
          pulp = seq(keyc)
          if pulp lt 32 or pulp gt 128 then keyc = ''
          if pure then
              if cpos eq 0 and keyc ne '' then
                rope = ''
                pchr = 1
              end
              crt @(0):
              if cram then crt '>': else crt '#':
              crt @(pcol):
              pure = false
          end
          begin case
              case heap and (cpos = uarr or cpos = upag)
                if posn lt dcount(stak, vm) then
                    posn += 1
                    rope = stak<1,posn>
                end
                exit
              case heap and (cpos = darr or cpos = dpag)
                if posn gt 1 then
                    posn -= 1
                    rope = stak<1,posn>
                end else
                    posn = 0
                    rope = ''
                end
                exit
              case heap and cpos = skey
                if rope eq '' then
                    if look<1> eq '' then continue
                    comi = look<1,1>
                    gosub parse.command
                    rope = 'L':dlim:rest
                end else rope = 'L/':rope
                if rope eq look<1> then rope = 'L'
                return
              case heap and cpos = rkey
                if rope eq '' then
                    if look<1> eq '' then continue
                    comi = look<1,1>
                    gosub parse.command
                    rope = 'LA':dlim:rest
                end else rope = 'LA/':rope
                if rope eq look<1> then rope = 'L'
                return
              case heap and cpos = writ and pulp ne 23
                rope = 'PE'
                return
              case heap and cpos = phlp
                stub = '' ; heap = false ; rest = ''
                gosub show.help
                rope = 'D'
                return
              case cpos = larr
                if pchr gt 1 then pchr -= 1
              case cpos = rarr
                if pchr le len(rope) then pchr += 1
              case cpos = lpag
                pchr = 1
              case cpos = rpag
                pchr = len(rope) + 1
              case cpos = escp
                posn = 0
                rope = ''
                exit
              case cpos = delc
                rope = rope[1, pchr-1] : rope[pchr+1, huge]
              case cpos = delr
                rope = rope[1, pchr-1]
              case cpos = back
                if pchr gt 1 then
                    pchr -= 1
                    rope = rope[1, pchr-1] : rope[pchr+1, huge]
                end
              case cpos = carr
                if heap then
                    crt begn : ceol : ':' : rope:
                    if posn then
                      if rope eq stak<1,posn> then del stak<1,posn>
                    end
                end
                return
              case cpos = togg
                cram = not(cram)
                crt @(0):
                if cram then crt '>': else crt '#':
                crt @(pcol):
              case pulp eq 23        ;* ctrl-w
                dope = downcase(rope)
                mope = upcase(rope)
                tope = oconv(rope,'MCT')
                begin case
                    case rope eq tope and dope eq tope ; rope = mope
                    case rope eq tope ; rope = dope
                    case rope eq mope ; rope = tope
                    case 1 ; rope = mope
                end case
              case pulp ge 32 and pulp lt 128
                if cram then
                    rope = rope[1, pchr-1] : keyc : rope[pchr, huge]
                end else
                    if pchr le len(rope)
                      then rope[pchr, 1] = keyc
                      else rope := keyc
                end
                pchr += 1
              case 1
                crt bell:
          end case
          if rlen and len(rope) ge rlen then
              crt keyc:
              rlen = 0
              return
          end
        repeat
    repeat
    return
get.keyc:
$ifdef qm
    if not(index(upcase(system(7)),'EEEPC',1)) then
        keyc = keycode()
        return
    end
$endif
    common /keys$krj/ termtype,eseq,keyd,base,full
    if not(assigned(termtype)) then termtype = ''
    if termtype ne oconv(system(7),'MCU') then gosub setup.keys
    keyc = ''
    loop
$ifdef unidata
        mine = in()
$else
        mine = keyin()
$endif
        locate(mine,base;post) then gosub get.rest
        locate(mine,eseq;cmd)
          then keyc = char(keyd<cmd>)
          else if len(mine) eq 1 then keyc = mine
    while keyc eq '' do repeat
    return
get.rest:
    loop
$ifdef unidata
        a = system(12)
        loop
        until system(12) ge (a+5) do
        repeat
$else
        nap 5
$endif
        input your,-1
    while your do
$ifdef unidata
        mine := in()
$else
        mine := upcase(keyin())
$endif
        locate(mine,full,post;your) then return
    repeat
    return
setup.keys:
* Define the key numbers - these are based on QM keycode()
*======================================================================
* Arrow keys
    equ lark to 203, rark to 204, uark to 205, dark to 206
* Page up and down, home and end
    equ upak to 207, dpak to 208, homk to 209, endk to 210
* Insert, delete, backtab, delete line, backspace
    equ insk to 211, deck to 212, btbk to 213, delk to 127, bspk to 8
* Control - Page up and down, homk and end
    equ cupk to 214, cdpk to 215, chok to 216, cenk to 217
* Function, Control+Function, Alt+Function, Shift+Function
    equ f1  to 128, cf1  to 140, af1  to 152, sf1  to 164
    equ f2  to 129, cf2  to 141, af2  to 153, sf2  to 165
    equ f3  to 130, cf3  to 142, af3  to 154, sf3  to 166
    equ f4  to 131, cf4  to 143, af4  to 155, sf4  to 167
    equ f5  to 132, cf5  to 144, af5  to 156, sf5  to 168
    equ f6  to 133, cf6  to 145, af6  to 157, sf6  to 169
    equ f7  to 134, cf7  to 146, af7  to 158, sf7  to 170
    equ f8  to 135, cf8  to 147, af8  to 159, sf8  to 171
    equ f9  to 136, cf9  to 148, af9  to 160, sf9  to 172
    equ f10  to 137, cf10 to 149, af10 to 161, sf10 to 173
    equ f11  to 138, cf11 to 150, af11 to 162, sf11 to 174
    equ f12  to 139, cf12 to 151, af12 to 163, sf12 to 175
*======================================================================
* Stash the escape sequences and key codes in labelled common
    termtype = oconv(system(7),'MCU')
* Set up keys good for many terminals and as defaults
    eseq = '' ; keyd = ''
    keyd<-1> = lark; eseq<-1> = char(21)
    keyd<-1> = rark; eseq<-1> = char(6)
    keyd<-1> = uark; eseq<-1> = char(26)
    keyd<-1> = dark; eseq<-1> = char(10)
    keyd<-1> = homk; eseq<-1> = char(1)
    keyd<-1> = endk; eseq<-1> = char(5)
    keyd<-1> = deck; eseq<-1> = char(4)
    keyd<-1> = upak; eseq<-1> = char(27):'[5~'
    keyd<-1> = dpak; eseq<-1> = char(27):'[6~'
* Now do settings that don't interfere between terminals
* VT-type terminals - cater for alternative arrow sequences
    keyd<-1> = rark; eseq<-1> = char(27):'[C'
    keyd<-1> = rark; eseq<-1> = char(27):'OC'
    keyd<-1> = uark; eseq<-1> = char(27):'[A'
    keyd<-1> = uark; eseq<-1> = char(27):'OA'
    keyd<-1> = dark; eseq<-1> = char(27):'[B'
    keyd<-1> = dark; eseq<-1> = char(27):'OB'
    keyd<-1> = insk; eseq<-1> = char(27):'[1~'
    keyd<-1> = deck; eseq<-1> = char(27):'[4~'
    keyd<-1> = btbk; eseq<-1> = char(27):'[Z'
    keyd<-1> = f1  ; eseq<-1> = char(27):'OP'
    keyd<-1> = f2  ; eseq<-1> = char(27):'OQ'
    keyd<-1> = f3  ; eseq<-1> = char(27):'OR'
    keyd<-1> = f4  ; eseq<-1> = char(27):'OS'
    keyd<-1> = f5  ; eseq<-1> = char(27):'OT'
    keyd<-1> = f6  ; eseq<-1> = char(27):'[17~'
    keyd<-1> = f7  ; eseq<-1> = char(27):'[18~'
    keyd<-1> = f8  ; eseq<-1> = char(27):'[19~'
    keyd<-1> = f9  ; eseq<-1> = char(27):'[20~'
    keyd<-1> = f10 ; eseq<-1> = char(27):'[21~'
    keyd<-1> = f11 ; eseq<-1> = char(27):'[23~'
    keyd<-1> = f12 ; eseq<-1> = char(27):'[24~'
* Wyse-type terminals
    keyd<-1> = insk; eseq<-1> = char(27):'Q'
    keyd<-1> = deck; eseq<-1> = char(27):'W'
    keyd<-1> = btbk; eseq<-1> = char(27):'I'
    keyd<-1> = f1  ; eseq<-1> = char(1):'@':char(13)
    keyd<-1> = f2  ; eseq<-1> = char(1):'A':char(13)
    keyd<-1> = f3  ; eseq<-1> = char(1):'B':char(13)
    keyd<-1> = f4  ; eseq<-1> = char(1):'C':char(13)
    keyd<-1> = f5  ; eseq<-1> = char(1):'D':char(13)
    keyd<-1> = f6  ; eseq<-1> = char(1):'E':char(13)
    keyd<-1> = f7  ; eseq<-1> = char(1):'F':char(13)
    keyd<-1> = f8  ; eseq<-1> = char(1):'G':char(13)
    keyd<-1> = f9  ; eseq<-1> = char(1):'H':char(13)
    keyd<-1> = f10 ; eseq<-1> = char(1):'I':char(13)
    keyd<-1> = f11 ; eseq<-1> = char(1):'J':char(13)
    keyd<-1> = f12 ; eseq<-1> = char(1):'K':char(13)
* ADDS-type terminals
    keyd<-1> = f1  ; eseq<-1> = char(2):'1':char(13)
    keyd<-1> = f2  ; eseq<-1> = char(2):'2':char(13)
    keyd<-1> = f3  ; eseq<-1> = char(2):'3':char(13)
    keyd<-1> = f4  ; eseq<-1> = char(2):'4':char(13)
    keyd<-1> = f5  ; eseq<-1> = char(2):'5':char(13)
    keyd<-1> = f6  ; eseq<-1> = char(2):'6':char(13)
    keyd<-1> = f7  ; eseq<-1> = char(2):'7':char(13)
    keyd<-1> = f8  ; eseq<-1> = char(2):'8':char(13)
    keyd<-1> = f9  ; eseq<-1> = char(2):'9':char(13)
    keyd<-1> = f10 ; eseq<-1> = char(2):':':char(13)
    keyd<-1> = f11 ; eseq<-1> = char(2):';':char(13)
    keyd<-1> = f12 ; eseq<-1> = char(2):'<':char(13)
* xterm type - like my ASUS eeePC
    keyd<-1> = bspk ; eseq<-1> = char(127)
    keyd<-1> = delk ; eseq<-1> = char(27):'[3;2~'
    keyd<-1> = f5  ; eseq<-1> = char(27):'[15~'
    keyd<-1> = sf1  ; eseq<-1> = char(27):'O2P'
    keyd<-1> = sf2  ; eseq<-1> = char(27):'O2Q'
    keyd<-1> = sf3  ; eseq<-1> = char(27):'O2R'
    keyd<-1> = sf4  ; eseq<-1> = char(27):'O2S'
    keyd<-1> = sf5  ; eseq<-1> = char(27):'[15;2~'
    keyd<-1> = sf6  ; eseq<-1> = char(27):'[17;2~'
    keyd<-1> = sf7  ; eseq<-1> = char(27):'[18;2~'
    keyd<-1> = sf8  ; eseq<-1> = char(27):'[19;2~'
    keyd<-1> = sf9  ; eseq<-1> = char(27):'[20;2~'
    keyd<-1> = sf10 ; eseq<-1> = char(27):'[21;2~'
    keyd<-1> = sf11 ; eseq<-1> = char(27):'[23;2~'
    keyd<-1> = sf12 ; eseq<-1> = char(27):'[24;2~'
* Now do terminal-specific settings
* VT-type terminals
    if termtype[1,2] eq 'VT' or termtype[1,5] eq 'XTERM' then
        keyd<-1> = lark; eseq<-1> = char(27):'[D'
        keyd<-1> = lark; eseq<-1> = char(27):'OD'
    end else
        keyd<-1> = insk; eseq<-1> = char(27):'[D'
        keyd<-1> = deck; eseq<-1> = char(27):'OD'
    end
* Wyse-type terminals
    if termtype[1,2] eq 'WY' then
        keyd<-1> = lark; eseq<-1> = char(8)
        keyd<-1> = rark; eseq<-1> = char(12)
        keyd<-1> = uark; eseq<-1> = char(11)
        keyd<-1> = btbk; eseq<-1> = char(27):'O' ;* !
    end
*  for my lttle ASUS eeePC & Linux - What a cool thing it is!
    if index(termtype,'EEEPC',1) then
        keyd<-1> = chok; eseq<-1> = char(27):'[2H' ;* Shift-Home actually
        keyd<-1> = homk; eseq<-1> = char(27):'[H'
        keyd<-1> = endk; eseq<-1> = char(27):'[F'
        keyd<-1> = insk; eseq<-1> = char(27):'[2~'
        keyd<-1> = deck; eseq<-1> = char(27):'[3~'
    end else
        keyd<-1> = homk; eseq<-1> = char(27):'[2~'
        keyd<-1> = endk; eseq<-1> = char(27):'[3~'
    end
* Populate the escape sequence test variables
    base = ''; full = ''
    amax = dcount(eseq,am)
    for anum = 1 to amax
        temp = eseq<anum>
        if len(temp) le 1 then continue
        locate(temp[1,1],base;post) else
          post = dcount(base,am)+1
        end
        base<post> = temp[1,1]
        full<post,-1> = temp
    next anum
    return
outline:
* to display logic simplisticly
    rest = oconv(rest,'MCU')
    if index(rest,'*',1) then rest = 'CEPS'
    bot = here + 1
    if bot gt last then bot = 1
    if numb then msup = here + numb else msup = last
    if msup gt last then msup = last
    for here = bot to msup
        gosub get.line
        gosub find.label
        line = ' ':upcase(line)
        begin case
          case chit eq '*' or chit eq '!' ; line = ''
          case index(line,' GOTO ',1)
          case index(line,' GO ',1)
          case index(line,' GOSUB ',1)
          case rest eq '' ; line = ''
          case index(rest,'C',1) and index(line,' ':'CALL',1)
          case index(rest,'E',1) and index(line,' ':'EXECUTE',1)
          case index(rest,'P',1) and index(line,' ':'PERFORM',1)
          case index(rest,'S',1) and index(line,' ':'CASE',1)
          case 1 ; line = ''
        end case
        if temp ne '' or line ne '' then gosub display.line
    next here
    return
getshowline:
    if unassigned(puncs) then
        puncs = ', []()<>=+-/*:#!'
        funcs  = 'ABS\ABSS\ACOS\ADDS\ALPHA\ANDS\ASCII\ASIN\ASSIGNED\'
        funcs := 'ATAN\BITAND\BITNOT\BITOR\BITRESET\BITSET\BITTEST\'
        funcs := 'BITXOR\CATS\CHANGE\CHAR\CHARS\CHECKSUM\COL1\COL2\'
        funcs := 'CONTINUE\CONVERT\COS\COSH\COUNT\COUNTS\DATE\DCOUNT\'
        funcs := 'DELETE\DIV\DIVS\DOWNCASE\DQUOTE\DTX\EBCDIC\EQS\'
        funcs := 'EREPLACE\EXCHANGE\EXP\EXTRACT\FADD\FDIV\FFIX\FFLT\'
        funcs := 'FIELD\FIELDS\FIELDSTORE\FILEINFO\FIX\FMT\FMTDP\'
        funcs := 'FMTS\FMTSDP\FMUL\FOLD\FOLDDP\FSUB\GES\GET\'
        funcs := 'GETLOCALE\GETREM\GROUP\GTS\ICHECK\ICONV\ICONVS\'
        funcs := 'IFS\ILPROMPT\INDEX\INDEXS\INDICES\INMAT\INSERT\INT\'
        funcs := 'ISNULL\ISNULLS\ITYPE\KEYIN\LEFT\LEN\LENDP\LENS\'
        funcs := 'LENSDP\LES\LN\LOWER\LTS\MATCHFIELD\MAXIMUM\MINIMUM\'
        funcs := 'MOD\MODS\MULS\NEG\NEGS\NES\NOT\NOTS\NUM\NUMS\OCONV\'
        funcs := 'OCONVS\ORS\PWR\QUOTE\RAISE\REAL\RECORDLOCKED\REM\'
        funcs := 'REMOVE\REPLACE\REUSE\RIGHT\RND\RPC.CALL\RPC.CONNECT\'
        funcs := 'RPC.DISCONNECT\SADD\SCMP\SDIV\SEEK\SELECTINFO\SEND\'
        funcs := 'SENTENCE\SEQ\SEQS\SETLOCALE\SIN\SINH\SLEEP\SMUL\'
        funcs := 'SOUNDEX\SPACE\SPACES\SPLICE\SQRT\SQUOTE\SSUB\STATUS\'
        funcs := 'STR\STRS\SUBR\SUBS\SUBSTRINGS\SUM\SUMMATION\SYSTEM\'
        funcs := 'TAN\TANH\TERMINFO\TIME\TIMEDATE\TPARM\TRANS\TRIM\'
        funcs := 'TRIMB\TRIMBS\TRIMF\TRIMFS\TRIMS\UNASSIGNED\'
        funcs := 'UNICHAR\UPCASE\XLATE\XTD'
        convert '\' to @am in funcs
        keywords  = 'ABORT\AUTHORIZATION\AUXMAP\BEGIN\BREAK\BSCAN\'
        keywords := 'BYTE\BYTELEN\BYTETYPE\BYTEVAL\CALL\CASE\CHAIN\'
        keywords := 'CLEAR\CLEARDATA\CLEARFILE\CLEARPROMPTS\CLEARSELECT\'
        keywords := 'CLOSE\CLOSESEQ\COMMIT\COMMON\COMPARE\CONSTANTS\'
        keywords := 'CONVERT\CREATE\CRT\DATA\DEBUG\DEFFUN\DEL\DELETE\'
        keywords := 'DELETELIST\DELETEU\DIM\DIMENSION\DISPLAY\DO\ECHO\ELSE\'
        keywords := 'END\ENTER\EQU\EQUATE\ERRMSG\EXECUTE\EXIT\FILELOCK\'
        keywords := 'FILEUNLOCK\FIND\FINDSTR\FLUSH\FOOTING\FOR\FORMLIST\'
        keywords := 'FUNCTION\GET\GETLIST\GETX\GO\GOSUB\GOTO\GROUPSTORE\'
        keywords := 'HEADING\HUSH\IF\INCLUDE\INPUT\INPUTCLEAR\INPUTDISP\'
        keywords := 'INPUTDP\INPUTERR\INPUTIF\INPUTNULL\INPUTTRAP\INS\'
        keywords := 'KEYEDIT\KEYEXIT\KEYTRAP\LET\LOCALEINFO\LOCATE\LOCK\'
        keywords := 'LOOP\MAT\MATBUILD\MATCH\MATCHES\MATPARSE\MATREAD\MATREADL\'
        keywords := 'MATREADU\MATWRITE\MATWRITEU\NAP\NEXT\NOBUF\NULL\'
        keywords := 'NUMERIC.DATA\ON\OPEN\OPENCHECK\OPENDEV\OPENPATH\'
        keywords := 'OPENSEQ\PAGE\PERFORM\PRECISION\PRINT\PRINTER\'
        keywords := 'PRINTERR\PROCREAD\PROCWRITE\PROGRAM\PROMPT\'
        keywords := 'RANDOMIZE\READ\READBLK\READL\READLIST\READNEXT\'
        keywords := 'READSEQ\READT\READU\READV\READVL\READVU\RECORDLOCK\'
        keywords := 'RELEASE\REM\REMOVE\REPEAT\RETURN\REVREMOVE\REWIND\'
        keywords := 'ROLLBACK\SEEK\SELECT\SELECTE\SELECTINDEX\SETREM\'
        keywords := 'SSELECT\START\STATUS\STOP\STORAGE\SUBROUTINE\'
        keywords := 'TABSTOP\THEN\TIMEOUT\TO\TPRINT\TRANSACTION\TTYCTL\'
        keywords := 'TTYGET\TTYSET\UNICHARS\UNISEQ\UNISEQS\UNLOCK\UNTIL\'
        keywords := 'UPRINT\WEOF\WEOFSEQ\WRITE\WRITEBLK\WRITELIST\'
        keywords := 'WRITESEQ\WRITESEQF\WRITET\WRITEU\WRITEV\WRITEVU'
        convert '\' to @am in keywords
        si.label    = 1
        si.comment  = 2
        si.string    = 3
        si.key      = 4
        si.operator  = 5
        si.function  = 6
        si.directive = 7
        si.highlight = 8
        si.doc      = 9
        bi.hiword  = 10
* Highlights for HostAccess
        bo = @(-58) ; bf = @(-59)
        wo = @(-5)  ; wf = @(-6)
        ro = @(-13) ; rf = @(-12)
        uo = @(-15) ; uf = @(-12)
        hi.commenton  = uo:bo
        hi.commentoff = uf:bf
        hi.labelon    = bo
        hi.labeloff  = bf
        hi.selecton  = ro:wo
        hi.selectoff  = wf:rf
        hi.stringon  = wo
        hi.stringoff  = wf
        hi.keyon      = uo
        hi.keyoff    = uf
        hi.opon      = ''
        hi.opoff      = ''
        hi.funcon    = bo
        hi.funcoff    = bf
        hi.diron      = wo
        hi.diroff    = wf
        hi.docon      = ro:bo
        hi.docoff    = rf:bf
    end
    l = len(line)
* If the line is too long, don't colourise it
    if l gt 2000 then
        showline = line[setoff,width]
        return
    end
    myline = line
    oldmyline = myline
    myline = trimf(myline)
    mask = space(l - len(myline))
    word = myline[' ',1,1]
    if word[' ',1,1] match '1N0N' or word match '1A0X":"' then
        mask := str(si.label,len(word)):' '
        myline = myline[' ',2,999]
        word = myline[' ',1,1]
    end
    begin case
        case word[1,1] eq '*' or word[1,1] eq '!'
          if count(myline,'@@') then
              mask := str(si.doc, l)
          end else
              mask := str(si.comment, l)
          end
        case word[1,1] eq '$' or word[1,1] eq '#'
          mask := str(si.directive, l)
        case 1
          dc = count(myline,';')
          if not(dc) then
              mask := space(l)
          end else
              foundcomment = false
              for z = 1 to dc until foundcomment
                word = trimf(myline[';',z+1,1])
                if word[1,1] eq '*' or word[1,1] eq '!' then
                    foundcomment = z
                end
              next
              if foundcomment then
                mask := space(len(myline[';',1, foundcomment])):str(si.comment, l)
              end else
                mask := space(l)
              end
          end
    end case
    lin = convert(puncs,str(@fm,len(puncs)), upcase(oldmyline))
    dc3 = dcount(lin,@fm)
    for q = 1 to dc3
        word = lin[@fm,q,1]
        st = col1()+ 1
        if st gt 1 then
          if mask[st-1,1] eq ' ' and oldmyline[st-1,1] ne ' ' then
              mask[st-1,1] = si.operator          ; * operators too
          end
        end
        begin case
          case word[1,1] eq '"'
              ix = index(lin[st+1,huge],'"',1)
              if ix then
                if mask[st,1] eq ' ' then
                    q = dcount(lin[1, ix+st],@fm)
                    mask[st, ix+1] = str(si.string, ix+1)
                end
              end
          case word[1,1] eq "'"
              ix = index(lin[st+1,huge],"'",1)
              if ix then
                if mask[st,1] eq ' ' then
                    q = dcount(lin[1, ix+st],@fm)
                    mask[st, ix+1] = str(si.string, ix+1)
                end
              end
          case 1
              locate(word,keywords;dpos;'AL') then
                if mask[st,1] eq ' ' then
                    mask[st, len(word)] = str(si.key, len(word))
                end
              end else
                locate(word,funcs;dpos;'AL') then
* Functions are followed by a bracket
                    brak = ''
                    fpos = len(lin[@fm,1,q])+1
                    if fpos then brak = trim(oldmyline[fpos,999])[1,1]
                    if brak eq '(' and mask[st,1] eq ' ' then
                      mask[st,len(word)] = str(si.function, len(word))
                    end
                end
              end
        end case
    next
    word = lastfind
    if word ne '' then
        oc = 1
        loop
          if caseflag
              then ix = index(oldmyline,word,oc)
              else ix = index(upcase(oldmyline),upcase(word),oc)
        while ix do
          oc += 1
          mask[ix, len(word)] = str(si.highlight, len(word))
        repeat
    end
    myline = oldmyline[setoff,width]
    mask = mask[setoff,width]
    showline = ''
    old = ''
    l = len(myline)
    for k = 1 to l
        c = mask[k,1]
        if c ne old then
          begin case
              case old eq si.label
                showline := hi.labeloff
              case old eq si.comment
                showline := hi.commentoff
              case old eq si.key
                showline := hi.keyoff
              case old eq si.string
                showline := hi.stringoff
              case old eq si.key
                showline := hi.keyoff
              case old eq si.operator
                showline := hi.opoff
              case old eq si.function
                showline := hi.funcoff
              case old eq si.directive
                showline := hi.diroff
              case old eq si.highlight
                showline := hi.selectoff
          end case
          begin case
              case c eq si.label
                showline := hi.labelon
              case c eq si.comment
                showline := hi.commenton
              case c eq si.key
                showline := hi.keyon
              case c eq si.string
                showline := hi.stringon
              case c eq si.operator
                showline := hi.opon
              case c eq si.function
                showline := hi.funcon
              case c eq si.directive
                showline := hi.diron
              case c eq si.highlight
                showline := hi.selecton
              case c eq si.doc
                showline := hi.docon
          end case
          old = mask[k,1]
        end
        showline := myline[k,1]
    next
    begin case
        case old eq si.label
          showline := hi.labeloff
        case old eq si.comment
          showline := hi.commentoff
        case old eq si.key
          showline := hi.keyoff
        case old eq si.string
          showline := hi.stringoff
        case old eq si.function
          showline := hi.funcoff
        case old eq si.operator
          showline := hi.opoff
        case old eq si.directive
          showline := hi.diroff
        case old eq si.highlight
          showline := hi.selectoff
        case old eq si.doc
          showline := hi.docoff
    end case
    return
</PRE>

Latest revision as of 14:58, 10 October 2024

Back to BasicSource

My version of Unidata's AE that was written to cope with a move to Universe when we were relying on AE's security capabilities. This has a few extra things like an embedded full-page editor and search and change histories. The original source code (version 1.03) was released to public domain by Public Trust of New Zealand as a way of thanking the Pick community for assistance given over the years.

https://sites.google.com/site/nzpickie/home/programs 

     program led

* This editor reproduces the UniData Alternate Editor for QM/U2
* The code is based on LED, a line editor released into
* the public domain by Public Trust of New Zealand.
* Written by Keith Robert Johnson.

*====================================================================
* Version information
*  2.00 - Simplified code - No longer supporting R83
*         Downcased the source to comply with QM standards.
*====================================================================

$define universe
$ifdef qm
$include err.h
     voc = @voc
$else
     open 'VOC' to voc else stop 201,'VOC'
$endif
$ifdef universe
$options information
$endif
$ifdef unidata
$basictype 'U'
$endif

* INITIALISE
     prompt ''

     am = char(254); vm = char(253); sm = char(252)
     true = 1 = 1; false = not(true); qt = '"\':"'"

     common /led$data/ edkeep,secure,kept

     equ cellsize to 100
     dim memr(1)

* List of verbs for viewing data only
     viewverb = 'VIEW':am:'BROWSE':am:'LOOK'

* XCOM data - YES this editor will do $commands like AE does
     dim junk(100)
     equ this to junk(1)
     equ item to junk(2)
     equ here to junk(3)
     equ x$cc to junk(11)
     equ comi to junk(13)
     equ comd to junk(14)
     equ last to junk(15)
     equ comdmark to junk(19)
     equ wordmark to junk(20)
     equ fnam to junk(24)
     equ xsep to junk(25)
     mat junk = ''
     xsep = ' '
     wordmark = ' '
     comdmark = '`'

* Local data
     begn = @(0) ; ceop = @(-3) ; ceol = @(-4) ; goup = @(-10)
     revb = @(-13) ; revf = @(-14) ; undb = @(-15) ; undf = @(-16)

     heap = false ; salt = '' ; rlen = 0
     plen = system(3)-1 ; pwin = plen-1 ; line = '' ; here = 0
     dim fr(10) ; mat fr = '' ; fr(3) = 'MCU'
     oops = '' ; oopc = '' ; oopl = '' ; oopf = ''
     oopb = '' ; oopk = ''
     join = '' ; nill = '' ; fold = ''
     macn = 0 ; macc = ''
     pick = '' ; lastfind = '' ; huge = 99999999

* Turn off page prompt
     test = @(0,0)

* Find Match words - a LOOP can have multiple WHILE and UNTIL conditions
     fm.words = '' ; fm.findf = '' ; fm.finda = ''
     fm.words<1> = 'END' ; fm.findf<1> = 'END'
     fm.finda<1> = 'IF':vm:'END':vm:'OPEN':vm:'OPENSEQ':vm:'BEGIN':vm:'LOCATE'
     fm.words<2> = 'LOOP' ; fm.findf<2> = 'REPEAT':vm:'UNTIL':vm:'WHILE'
     fm.words<3> = 'UNTIL'; fm.findf<3> = fm.findf<2>
     fm.finda<3> = 'LOOP':vm:'UNTIL':vm:'WHILE'
     fm.words<4> = 'WHILE'
     fm.findf<4> = fm.findf<2>; fm.finda<4> = fm.finda<3>
     fm.words<5> = 'FOR' ; fm.findf<5> = 'NEXT'
     fm.words<6> = 'NEXT' ; fm.finda<6> = 'FOR'
     fm.words<7> = 'BEGIN' ; fm.findf<7> = 'END CASE':vm:'CASE'
     fm.words<8> = 'CASE' ; fm.findf<8> = 'CASE':vm:'END CASE'
     fm.finda<8> = 'BEGIN CASE':vm:'CASE'
     fm.words<9> = 'LOCKED' ; fm.findf<9> = 'END'
     fm.finda<9> = 'READU':vm:'READVU':vm:'MATREADU'
     fm.words<10> = 'REPEAT' ; fm.finda<10> = fm.finda<3>
* Special for C code
     fm.words<11> = '{' ; fm.findf<11> = '}'
     fm.words<12> = '}' ; fm.finda<12> = '{'
*
     endwords = 'IF\OPEN\OPENSEQ\READNEXT\READ\READU\READV\READVU\'
     endwords := 'MATREAD\MATREADU\LOCATE'
     convert '\' to am in endwords

* page editor stuff
     botl = system(3) - 2; clpg = @(-1)
*     bell = char(7) ; span = system(2)
     bell = @sys.bell ; span = system(2)
     bott = @(0,system(3)-1):ceol

* Define key activity numbers - 22 keys defined
     equ uarr to 1, darr to 2, larr to 3, rarr to 4
     equ upag to 5, dpag to 6, lpag to 7, rpag to 8
     equ tpag to 9, bpag to 10
     equ escp to 11, phlp to 12, zoom to 13
     equ delc to 14, dell to 15, delr to 16
     equ back to 17, carr to 18, togg to 19, writ to 20
     equ skey to 21, rkey to 22

* Set up the keys - In QM we can use generic key mapping (YAY)
* but I also like to have default keys
     acts = '' ; keys = ''
* Arrow keys
     acts<-1> = uarr ; keys<-1> = char(205)
     acts<-1> = uarr ; keys<-1> = char(26)
     acts<-1> = darr ; keys<-1> = char(206)
     acts<-1> = darr ; keys<-1> = char(10)
     acts<-1> = larr ; keys<-1> = char(203)
     acts<-1> = larr ; keys<-1> = char(21)
     acts<-1> = rarr ; keys<-1> = char(204)
     acts<-1> = rarr ; keys<-1> = char(6)
* Page movement keys
     acts<-1> = upag ; keys<-1> = char(207)
     acts<-1> = upag ; keys<-1> = char(16)
     acts<-1> = dpag ; keys<-1> = char(208)
     acts<-1> = dpag ; keys<-1> = char(14)
     acts<-1> = lpag ; keys<-1> = char(209)
     acts<-1> = lpag ; keys<-1> = char(1)
     acts<-1> = rpag ; keys<-1> = char(210)
     acts<-1> = rpag ; keys<-1> = char(5)
     acts<-1> = tpag ; keys<-1> = char(214)
     acts<-1> = tpag ; keys<-1> = char(20)
     acts<-1> = bpag ; keys<-1> = char(215)
     acts<-1> = bpag ; keys<-1> = char(2)
* delete character, line, and delete to end of line keys
     acts<-1> = delc ; keys<-1> = char(212)
     acts<-1> = delc ; keys<-1> = char(4)
     acts<-1> = dell ; keys<-1> = char(216)
     acts<-1> = dell ; keys<-1> = char(127)
     acts<-1> = dell ; keys<-1> = char(24)
     acts<-1> = delr ; keys<-1> = char(217)
     acts<-1> = delr ; keys<-1> = char(11)
     acts<-1> = delr ; keys<-1> = char(18) ;* for Wyse terminals
* backspace and carriage return keys
     acts<-1> = back ; keys<-1> = char(008)
     acts<-1> = carr ; keys<-1> = char(013)
* escape, help, Go to line, toggle insert/overwrite mode, save keys
     acts<-1> = escp ; keys<-1> = char(027)
     acts<-1> = escp ; keys<-1> = char(017)
     acts<-1> = phlp ; keys<-1> = char(128)
     acts<-1> = zoom ; keys<-1> = char(007)
     acts<-1> = togg ; keys<-1> = char(211)
     acts<-1> = togg ; keys<-1> = char(009)
     acts<-1> = writ ; keys<-1> = char(129)
     acts<-1> = writ ; keys<-1> = char(023)
* search key, reverse search key
     acts<-1> = skey ; keys<-1> = char(130) ;* F3 for search
     acts<-1> = rkey ; keys<-1> = char(166) ;* shift-F3 for reverse search

     mode = 'LINE'

* The saved stuff
     pres = '' ; look = '' ; stak = ''
     wild = false ; shew = false
     chan = '' ; olda = '' ; cmat = '' ; mmat = ''
     caseflag = false ; spaceflag = true ; blockflag = true

* Save the standard defaults in the session variable if it's not set
$ifdef universe
     if unassigned(edkeep) then edkeep = '0'
$else
     if assigned(edkeep) else edkeep = '0'
$endif
     if edkeep eq '0' then
        edkeep = pres:am:look:am:stak:am:wild:am:chan:am:olda:am:shew
        edkeep := am:cmat:am:mmat:am:not(caseflag):am:not(spaceflag)
        edkeep := am:not(blockflag)
        kept = ''
     end

* Get the 'as-is' settings from the session variable
     pres = edkeep<1>
     look = edkeep<2>
     stak = edkeep<3>
     wild = edkeep<4> ; wild = not(not(wild))
     chan = edkeep<5>
     olda = edkeep<6>
     shew = edkeep<7> ; shew = not(not(shew))
     cmat = edkeep<8>
     mmat = edkeep<9>
     caseflag = not(edkeep<10>)
     spaceflag = not(edkeep<11>)
     blockflag = not(edkeep<12>)

* Get forced default flags
!&&&
! nick = true
!&&&
     read temp from voc, '&ED.OPTIONS' then
        line = upcase(trim(remove(temp, dlim)))
        if line[1,1] eq 'X' then
           loop
              line = upcase(trim(remove(temp, dlim)))
              begin case
                 case line[1,8] eq 'BLOCK ON'
                    blockflag = true
                 case line[1,9] eq 'BLOCK OFF'
                    blockflag = false
                 case line[1,7] eq 'CASE ON'
                    caseflag = true
                 case line[1,8] eq 'CASE OFF'
                    caseflag = true
                 case line[1,8] eq 'SPACE ON'
                    spaceflag = true
                 case line[1,9] eq 'SPACE OFF'
                    spaceflag = true
                 case line[1,7] eq 'SHOW ON'
                    shew = true
                 case line[1,8] eq 'SHOW OFF'
                    shew = true
              end case
           while dlim repeat
        end
     end

$ifdef universe
     if unassigned(secure) then secure = '0'
$else
     if assigned(secure) else secure = '0'
$endif

     prepprog = '' ; prepflag = false
     postprog = '' ; postflag = false

*********** UniData AE-style security start
$ifdef unidata
     prepprog = getenv('PREPROG_AE_UDT')
$endif
$ifdef universe
     execute 'ENV' capturing temp
     xxno = dcount(temp,am)
     for xx = 1 to xxno
        line = temp<xx>
        if field(line,'=',1) eq 'PREPROG_AE_UDT' then
           prepprog = field(line,'=',2)
           xxno = xx
        end
     next xx
$endif
$ifdef qm
* QM doesn't allow underscores in environmental variables, so
* this is the closest I can get to AE environmental variable name.

     call !atvar(prepprog,'@PREPROG.AE.UDT')
$endif

* These next two tests are from the AE security documentation
* They may not be required, but you can set them up if you want
*    if prepprog[1,3] eq 'AE_' then prepprog = ''
*    if prepprog[len(prepprog)-2,3] ne '_AE' then prepprog = ''
     if prepprog ne '' then prepflag = true

* The following security definitions mirror those of I_AE_SECURITY
* in UniData.  I have only copied the functionality for SEC.SET
* being "NONE" (that is, this user cannot edit) and the general
* disabling of LOAD via the SEC.LOAD.FLG at first call to @PREPPROG;
* and inhibiting of file updates via subsequent @PREPPROG calls.
     dim security(40)
     equ sec.set to security(1) ;* set by preprog on very first call
* These fields are set in preprog
     equ sec.read.flg   to security(2) ;* read ok or not
     equ sec.write.flg  to security(3) ;* write ok or not
     equ sec.delete.flg to security(4) ;* delete ok or not
     equ sec.unload.flg to security(5) ;* unload ok or not
     equ sec.load.flg   to security(6) ;* load ok or not
     equ sec.xeq.flg    to security(7) ;* xeq ok or not
     equ sec.xcom.flg   to security(8) ;* xcoms ok or not
* the following 5 fields pass information to preprog & postprog,
     equ sec.fn         to security(9) ;* file name
     equ sec.id         to security(10);* record id
     equ sec.dir.flg        to security(11);* 1 if file is a directory
     equ sec.newfile.flg    to security(12);* 1 if new file name
     equ sec.active.sel.flg to security(13);* 1 if select list is active
* this is how to make AE stop and return to calling program or ecl
     equ sec.stop.flg   to security(14);* set to 1 to force ae to stop
* for secondary calls to preprog; the first 3 cannot be changed
     equ sec.call2.type to security(15);* 1 load, 2 unload
     equ sec.fn2        to security(16);* second file - for load/unload
     equ sec.id2        to security(17);* second id - for load or unload
     equ sec.ok2.flg    to security(18);* if 1, ok to load/unload
* 19-22 are used by postprog, which I have not implemented
     equ sec.dict.flg  to security(23) ;* 1 if fn is dict ...
     equ sec.dict2.flg to security(24) ;* 1 if fn2 is dict ...
* field 25 is specific to UNIDATA AE, this and all other fields unused
* WARNING: preprog programs should not use the STOP or ABORT statements
*          they should use the SEC.STOP.FLG to end nicely.
*********** UniData AE-style security end

* QM has it's own source control system depending on a callable program
* named SOURCE.CONTROL existing.  It has the following fields
*
* DICT.FLAG     - 'DICT' if a dictionary, otherwise ''
* FILE.NAME     - name of file to be written
* RECORD.NAME   - name of record to be written
* RECORD.DATA   - the record to write
* CALLER        - calling program identifier, I have used '3'
* WRITE.ALLOWED - 1 on call, returns 1 if write allowed and 0 otherwise
* UPDATED       - 0 on call, returns 1 if RECORD.DATA is changed

     source.control = false
$ifdef qm
     if catalogued('SOURCE.CONTROL') then source.control = true
$else
* We can implement QM-style security if we want
     if prepprog eq 'SOURCE.CONTROL' then source.control = true
$endif
     if source.control then prepflag = false ; prepprog = ''

     name = @logname
     levl = @level
     path = @path
     term = @tty
     whom = @userno
     acct = @who

* This is to display unprintable characters safely
     badc = char(255)
     for xx = 0 to 31    ; badc := char(xx) ; next xx
     for xx = 127 to 250 ; badc := char(xx) ; next xx
     gudc = str('~',len(badc))
* eeePC does not distinguish between these
     if index(upcase(system(7)),'EEEPC',1) then
        badc := char(251):char(252):char(253); gudc := '[\]'
     end else
        badc := char(251):char(252):char(253)
        gudc := char(179):char(178):char(185)
     end

* The yes/no can be language independant!
     yes = 'Yes' ; yes = upcase(trim(yes))
     no = 'No' ; no = upcase(trim(no))
     ny = '(':no[1,1]:'/':yes[1,1]:') >'

* Want to see these thing in a single page
     presnumb = system(3)-2
     if presnumb gt 20 then presnumb = 20
     looknumb = presnumb; channumb = presnumb

* Want this to be no more than five pages
     staknumb = (presnumb+1)*5+1

* Parse the command line - long way in before work starts, eh?
* Anything in brackets is an option - but we do not use them at all.
* "verb" is how this was called so it should work to call again
     verb = ''

$ifdef qm
$include parser.h
     call !parser(parser$reset, 0, @sentence, 0)
     opts = false
     options = ''
     sentence = ''
     loop
        call !parser(parser$get.token, type, param, keyword)
     until type eq parser$end do
        begin case
           case type eq 4 ; opts = true
           case type eq 5 ; opts = false
           case opts      ; options<-1> = param
           case 1         ; sentence<-1> = param
        end case
     repeat
$else
     rest = @sentence
     keepquot = false
     gosub parse.rest
     sentence = bite
     temp = dcount(sentence,am)
     options = sentence<temp>
     if options[1,1] eq '(' then
        options = field(field(options,'(',2),')',1)
        sentence = delete(bite,temp,0,0)
     end else options = ''
$endif

if options ne '' then options = ' (':options:')'

* The C option allows the user to build paragraphs
* using DATA statements to control the editor.
* Otherwise they are restricted to an interactive mode.
     if index(upcase(options),'C',1)
        then editpage = false
        else editpage = true

     if upcase(sentence<1>) eq 'RUN' then
        verb = sentence<1>:' ':sentence<2>:' '
        sentence = delete(sentence,1,0,0)
        sentence = delete(sentence,1,0,0)
     end
     verb = verb:sentence<1>
     sentence = delete(sentence,1,0,0)

* Check if a viewing verb has been used
* If so, we can turn off both security systems (I mope I'm right!)
* The security flags are set safe, and each command is tested
* individually, so I think it's pretty safe.
* FORMAT is still allowed, but no other change command.

     viewflag = false ; view = 'edit'
     locate(upcase(verb),viewverb;posn) then
        viewflag = true
        view = 'view'
        source.control = false
        prepflag = false
     end
* OR, they used the V option
     if index(upcase(options),'V',1) then
        viewflag = true
        view = 'view'
        source.control = false
        prepflag = false
     end

* HELP location
     help.def = '2.00'
     help = ''
     pagehelp = ''

     fnam = sentence<1>
     sentence = delete(sentence,1,0,0)
     if upcase(fnam) eq 'DICT' then
        fnam = 'DICT ':sentence<1>
        sentence = delete(sentence,1,0,0)
     end
     idlist = sentence

     if system(11) and idlist ne '' then
        crt 'A select list was active, but specific ids were entered.'
        crt 'Select list will be ignored.'
        crt str('-',len('Select list will be ignored.'))
        clearselect
     end

     open 'AE_COMS' to acom else
$ifdef qm
        execute 'CREATE.FILE AE_COMS'
$else
        execute 'CREATE.FILE AE_COMS 1 7'
$endif
        open 'AE_COMS' to acom else stop 'Cannot open ':'AE_COMS'
        test = @(0,0)
     end

* Get file
     loop
        got.file = false
        if fnam eq '' then
           stub = 'File name? '
           gosub get.rope; fnam = rope; crt
        end
        if fnam eq '' then stop
        dprt = field(fnam,' ',1)
        fprt = field(fnam,' ',2)
        if fprt eq '' then fprt = dprt ; dprt = ''
        open dprt, fprt to file then
           got.file = true
        end else
           open upcase(dprt),upcase(fprt) to file then
              got.file = true
           end else
              crt 'Cannot open ':'"':fnam:'"'
              fnam = ''
           end
        end
     until got.file do
     repeat
     if fileinfo(file,3) eq '4' then bleach = false else bleach = true
     bleach = upcase(fileinfo(file,2))
     if bleach[2] = 'BP' or bleach[7] = 'SFPROGS'
        then bleach = false
        else bleach = true

* Get the record
     if idlist eq '*' then
        idlist = ''
        execute 'SELECT ':dprt:' ':fprt
        test = @(0,0)
     end
     if system(11) then
        eof = false
        loop
           readnext id else eof = true
        until eof do
           idlist<-1> = id
        repeat
     end

     loop
        killsign = false
        if idlist eq '' then
           stub = 'Record name? '
           gosub get.rope; rest = rope ; crt
           keepquot = false
           gosub parse.rest
           idlist = bite
           bite = '' ; rest = ''
        end
        idcnt = dcount(idlist,am)
        for id = 1 to idcnt until killsign
           item = idlist<id>
           gosub edit.item
        next id
     while killsign do
        idlist = ''
     repeat

     edkeep = pres:am:look:am:stak:am:wild:am:chan:am:olda:am:shew
     edkeep := am:cmat:am:mmat:am:not(caseflag):am:not(spaceflag)
     edkeep := am:not(blockflag):am:lower(kept)
     stop


* SUBROUTINES
* ***********
edit.item:
     stopsign = false
     here = 0 ; dnum = 0
     beg = 0 ; fin = 0 ; krj = ''
     crt
     if idcnt gt 1 then crt '<':id:'/':idcnt:'> ':

     if prepflag then
        if secure eq '0' then
           mat security = ''
           sec.set = ''
           call @prepprog(mat security)
           if sec.set eq 'NONE' then stop
           if sec.stop.flg then stop
           secure = sec.set
        end
        mat security = ''
        sec.set = secure
        if sec.set then
           sec.fn = fprt
           sec.id = item
           sec.dir.flg = fileinfo(file,3) = '4'
           sec.newfile.flg = false
           sec.active.sel.flg = false
           sec.dict.flg = (dprt = 'DICT')
           call @prepprog(mat security)
           if sec.stop.flg then stop
           if not(sec.read.flg) then return
        end
     end else
        sec.stop.flg = false
        sec.read.flg = true
        sec.write.flg = true
        sec.delete.flg = true
        sec.xcom.flg = true
        sec.unload.flg = true
        sec.load.flg = true
        sec.xeq.flg = true
        sec.ok2.flg = true
* Apply the viewing flag
        if viewflag then
           crt 'VIEW ONLY - NO UPDATES ALLOWED'
           sec.write.flg = false
           sec.delete.flg = false
           sec.xcom.flg = false
           sec.unload.flg = false
           sec.load.flg = false
           sec.xeq.flg = false
           sec.ok2.flg = false
        end
     end

     readu this from file, item locked goto locked.record then
        lock = true
carry.on:
        gosub parse.record
        crt 'Top of "':item:'" in "':fnam:'", ':last:' lines, ':len(this):' characters.'
     end else
        lock = true
        this = ''
        gosub parse.record
        crt 'Top of new "':item:'" in "':fnam:'".'
     end
     orig = this
     gosub get.lfmt

* Edit the record
     loop
        if mode<1> eq 'PAGE' then
           pcol = rem(pchr-1,span)
           prow = here+1-ptop
           crt @(60,0):ceol:revb:mode<2>:revf:' ':fmt(here,'R#4'):
           crt ',':fmt(pchr,'L#4'):
           bite = temp[pchr,1]
           if bite ne '' then crt ' (':seq(bite):')':
           crt @(pcol,prow):
           gosub get.page.comd
           if mode eq 'LINE' then
              crt bott:'Line Editor Mode':
              if that ne this then
                 crt ' - CHANGES HAVE BEEN MADE':
                 oops = that ; oopc = 'PE'
                 oopl = savl<1> ; oopf = savl<2>
                 oopb = beg:am:fin ; oopk = krj
              end
              crt
              that = ''
              gosub display.line
           end
        end

        if mode<1> eq 'LINE' then
* Get the command
           if x$cc ne '' then
              comi = x$cc<1>
              x$cc = delete(x$cc,1,0,0)
           end else
              if mode<1> eq 'PAGE' then continue
              if salt ne '' then
                 comi = salt<1,1,1>; del salt<1,1,1>
              end else
                 stub = prmt:': '; heap = true
                 gosub get.rope; comi = rope; heap = false
              end
              if macn then macc<1,1,-1> = comi
           end
           gosub parse.command
           if not(numb eq '' or numb matches '1N0N') then
              crt ; gosub bad.command
              continue
           end
           if comd eq '' then
              gosub null.command
              if comd eq '' then continue
           end
* Save command to list
           if comi ne '' and comi ne stak<1,1> and comd ne 'D' then
              stak = insert(stak,1,1,0,comi)
              stak = delete(stak,1,staknumb,0)
           end
* Apply the command
           if comd ne 'R' then crt
           if comd matches '1N0N' then
              here = comd
              if here gt last then here = last
              gosub display.line
              continue
           end
           loop
              redo = false
              first = comd[1,1]
              posn = index('ABCDEFGHIJKLMNOPQRSTUVWXYZ',first,1)
              on posn gosub a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z
           while redo do repeat
           if stopsign then release file, item ; lock = false ; return
        end
     repeat
     return

parse.command:
     comi = trimf(comi)
     dlim = oconv(oconv(comi,'MC/A'),'MC/N')[1,1]
     if dlim eq '' then
        rest = ''
        comd = upcase(comi)
     end else
        posn = index(comi,dlim,1)
        rest = comi[posn+1,huge]
        comd = upcase(comi[1,posn-1])
     end
     temp = oconv(comd,'MCN')[1,1]
     if temp ne '' then
        temp = index(comd,temp,1)
        numb = comd[temp,huge]
        comd = comd[1,temp-1]
     end else numb = ''
     return

parse.line:
     if line eq comdmark then line = ''
     xx = 1
     loop
        temp = index(line,'^',xx)
     while temp do
        bite = line[temp,5]
        if bite matches '"^^"3N' then
           line = line[1,temp-1]:line[temp+1,len(line)]
           xx += 1
        end else
           bite = bite[1,4]
           if bite matches '"^"3N' then
              line= line[1,temp-1]:char(bite[2,3]):line[temp+4,len(line)]
           end else xx += 1
        end
     repeat
     return

a:   begin case
        case comd eq 'A'                 ; * append
           if viewflag then gosub viewonly ; return
           if rest eq '' then rest = olda<1,1>
           if rest eq '' then
              crt 'No previous append command to repeat'
              gosub bad.comd
              return
           end
           olda = rest:vm:dlim
           line = rest ; gosub parse.line ; rest = line
           chng = 0 ; save = here ; savl = last
           dnum = 1
           gosub set.bounds
           for here = dawn to dusk
              gosub get.line
              line = line:rest
              if not(chng) then gosub savethis
              memr(cell)<lnum> = line
              chng += 1
              if shew or dnum lt plen then gosub display.line
           next here
           here = dusk
           if chng then
              gosub reset.record
              crt chng:' lines changed - now at ':here
           end
        case 1 ; gosub bad.command
     end case
     return

b:   begin case
        case comd eq 'B' and dlim eq ''   ; * bottom
           here = last ; gosub display.line
        case index('\B\BD\BK\BR\BS\','\':comd:'\',1)   ; * break line
           if viewflag then gosub viewonly ; return
           if rest eq '' then
              crt 'The second field is empty.'
              gosub bad.comd
              return
           end
           chng = 0 ; save = here ; savl = last ; show = ''
           gosub set.bounds
           for here = dusk to dawn step -1
              gosub get.line
              posn = index(line,rest,1)
              if posn then
                 left = line[1,posn-1]
                 temp = line[posn+len(rest),len(line)]
                 if temp ne '' or comd eq 'BS' then
                    begin case
                       case comd eq 'BD' ; line = left:rest
                       case comd eq 'BK' ; line = temp
                       case comd eq 'BR' ; line = temp:left:rest
                       case comd eq 'BS' ; line = temp:rest:left
                       case 1 ; line = left:rest
                    end case
                    memr(cell)<lnum> = line
                    show = insert(show,1,0,0,here)
                    numb += 1
                    chng += 1
                    if comd eq 'B' then
                       dusk += 1
                       last += 1
                       lnum += 1
                       line = temp
                       gosub insert.line
                    end
                 end
              end
           next here
           if chng then
              gosub savethis
              gosub reset.record
              zzno = dcount(show,am)
              savl = 0 ; dnum = 1
              for zz = 1 to zzno
                 here = show<zz> + savl
                 if shew or dnum lt plen then gosub display.line
                 if comd eq 'B' and zzno gt 1 then
                    here += 1
                    savl += 1
                    if shew or dnum lt plen then gosub display.line
                 end
              next zz
              show = ''
           end
           if comd eq 'B'
              then here = dusk + numb - 2
              else here = dusk
           if here gt last then here = last
           if chng then
              crt 'Split ':numb:' records.  Now at line ':here
           end
           gosub get.line
       case index('\BC\BCD\BCK\BCR\BCS\','\':comd:'\',1)   ; * Break @ Column
          if viewflag then gosub viewonly ; return
          posn = trim(field(rest,dlim,1))
          if not(posn matches '1n0n') then
             crt 'No column position given'
             gosub bad.comd
             return
          end
          chng = 0 ; save = here ; show = ''
          gosub set.bounds
          for here = dusk to dawn step -1
             gosub get.line
             if len(line) gt posn then
                left = line[1,posn-1]
                temp = line[posn+1,len(line)]
                if temp ne '' or comd eq 'BCS' then
                   begin case
                      case comd eq 'BCD' ; line = left:rest
                      case comd eq 'BCK' ; line = temp
                      case comd eq 'BCR' ; line = temp:left:rest
                      case comd eq 'BCS' ; line = temp:rest:left
                      case 1 ; line = left:rest
                   end case
                   memr(cell)<lnum> = line
                   show = insert(show,1,0,0,here)
                   numb += 1
                   chng += 1
                   if comd eq 'BC' then
                      dusk += 1
                      last += 1
                      lnum += 1
                      line = temp
                      gosub insert.line
                   end
                end
             end
          next here
           if chng then
              gosub savethis
              gosub reset.record
              zzno = dcount(show,am)
              savl = 0 ; dnum = 1
              for zz = 1 to zzno
                 here = show<zz> + savl
                 if shew or dnum lt plen then gosub display.line
                 if comd eq 'BC' and zzno gt 1 then
                    here += 1
                    savl += 1
                    if shew or dnum lt plen then gosub display.line
                 end
              next zz
              show = ''
           end
           if comd eq 'BC'
              then here = dusk + numb - 2
              else here = dusk
           if here gt last then here = last
           if chng then
              crt 'Split ':numb:' records.  Now at line ':here
           end
           gosub get.line
        case comd eq 'BLEACH'               ; * change BLEACH flag
           rest = upcase(rest)
           begin case
              case rest eq 'ON' ; bleach = true
              case rest eq 'OFF' ; bleach = false
              case 1 ; bleach = not(bleach)
           end case
           if bleach
              then crt 'Colours disabled'
              else crt 'Colours enabled'
        case comd eq 'BLOCK'               ; * change BLOCK flag
           rest = upcase(rest)
           begin case
              case rest eq 'ON' ; blockflag = true
              case rest eq 'OFF' ; blockflag = false
              case 1 ; blockflag = not(blockflag)
           end case
           if blockflag then
              crt 'Verification of block actions enabled'
           end else crt 'Verification of block actions disabled'
        case 1 ; gosub bad.command
     end case
     return

c:   begin case
        case comd eq 'C'                 ; * change
           if viewflag then gosub viewonly ; return
           if numb eq '' and dlim eq '' then
              comd = 'RA'
              comi = 'RA1'
              numb = 1
           end
           gosub change.command
        case comd eq 'CAT' ; comd = 'J' ; redo = true
        case comd eq 'CASE'               ; * change casing flag for 'L'
           rest = upcase(rest)
           begin case
              case rest eq 'ON' ; caseflag = true
              case rest eq 'OFF' ; caseflag = false
              case 1 ; caseflag = not(caseflag)
           end case
           if caseflag then
              crt 'Searches are case-sensitive'
           end else crt 'Searches are not case-sensitive'
        case comd eq 'CD'        ; * command delimiter display (change)
           if dlim eq '' then
              crt 'Command delimiter is ':
           end else
              temp = '`,;#$%&~|[]{}/"':"'"
              if index(temp,dlim,1) then
                 comdmark = dlim
                 crt 'Command delimiter is ':
              end else
                 crt dlim:' is not a valid command delimiter.'
                 crt 'Characters available for delimiters: ':temp
                 crt 'Characters reserved for other uses: \.*!?-+=^@<>_:'
                 crt 'Command delimiter is ':
              end
           end
           if comdmark eq '"'
              then crt "'":comdmark:"'"
              else crt '"':comdmark:'"'
        case comd eq 'CLEAR'             ; * Clear the kept buffer
           if kept eq ''
              then crt 'Nothing in KEPT buffer'
              else crt 'KEPT buffer cleared'
           kept = ''
        case comd = 'COPY'                   ; * copy to kept buffer
           if comd eq upcase(comi) then
              if not(beg) and not(fin) then
                 crt 'Command requests a block operation, but no block is defined.'
                 gosub bad.comd; return
              end
              rest = beg
              numb = fin-beg+1
           end
           rest = trim(rest)
           if numb eq '' then gosub parse.atts
           if rest eq '' then rest = here
           if not(rest matches '1N0N') or numb eq '' then
              crt 'Formats are: "COPY" (from <> block) or "COPYn" or "COPYn/s" or "COPY/s/f".'
              gosub bad.comd ; return
           end
           if numb lt 1 then
              crt 'Nothing done - no lines selected.'
              comi = ''; return
           end
           if numb gt last then
              crt 'Nothing done - record does not have that many lines.'
              comi = '' ; return
           end
           kept = field(this,am,rest,numb)
           numb = dcount(kept,am)
           if numb then crt numb:' lines copied to KEPT buffer starting at line ':rest
        case comd eq 'CM'                ; * changematch command
           if viewflag then gosub viewonly ; return
           if rest eq '' then
              if cmat eq '' then
                 crt 'No previous ChangeMatch command to repeat.'
                 comi = ''
                 return
              end else
                 dlim = cmat<1,1>
                 rest = cmat<1,2>
                 numb = cmat<1,3>
              end
           end
           gosub changematch.command
        case comd eq 'COL'               ; * column display
           temp = ''
           for xx = 1 to 9
              temp = temp:space(9):xx
           next xx
           if lfmt
              then crt begn:space(llen+2):temp[1,span-llen-2]
              else crt begn:temp[1,span]
           temp = str('1234567890',10)
           if lfmt
              then crt begn:space(llen+2):temp[1,span-llen-2]
              else crt begn:temp[1,span]
           temp = ''
        case comd eq 'COUNT'             ; * show the count of a string
           line = rest ; gosub parse.line ; rest = line
           if rest eq '' then
              crt 'No string given to count'
              gosub bad.comd ; return
           end
           gosub set.bounds
           if not(caseflag) then rest = upcase(rest)
           temp = 0
           for here = dawn to dusk
              gosub get.line
              if caseflag
                 then temp = temp + count(line,rest)
                 else temp = temp + count(upcase(line),rest)
           next here
           here = dusk
           crt temp:' occurances of string.'
        case comd eq 'CRT'           ; * insert crt line for programmer
           if viewflag then gosub viewonly ; return
           if rest eq '' then
              crt 'You have not said what to put on CRT line!'
              comi = ''
              return
           end
           gosub savethat
           here += 1 ; last += 1 ; lnum += 1
           if dlim ne '"' and dlim ne '\' then dlim = "'"
           line = 'CRT ':dlim:rest:' = ':dlim:':':rest
           gosub insert.line
           gosub reset.record
           gosub display.line
        case comd eq 'CUT'               ;* Move lines to kept buffer
           if viewflag then gosub viewonly ; return
           if comd eq upcase(comi) then
              if not(beg) and not(fin) then
                 crt 'Command requests a block operation, but no block is defined.'
                 gosub bad.comd; return
              end
              rest = beg
              numb = fin-beg+1
           end
           rest = trim(rest)
           if numb eq '' then gosub parse.atts
           if rest eq '' then rest = here
           if not(rest matches '1N0N') or numb eq '' then
              crt 'Formats are: "CUT" (from <> block) or "CUTn" or "CUTn/s" or "CUT/s/f".'
              gosub bad.comd; return
           end
           if numb gt last then
              crt 'Nothing done - record does not have that many lines.'
              comi = '' ; return
           end
           kept = field(this,am,rest,numb)
           numb = dcount(kept,am)
           dawn = rest
           dusk = rest+numb-1
           gosub delete.lines
           if numb then crt numb:' lines moved to KEPT buffer starting at line ':rest
        case 1 ; gosub bad.command
     end case
     return

d:   begin case
        case comd eq 'D'                 ; * display current line
           if here gt last then here = last
           gosub display.line
        case comd eq 'DE'                ; * delete lines
           if viewflag then gosub viewonly ; return
           chng = 0 ; save = here ; savl = last
           if rest ne '' then
              patt = rest
              cto = ''
              cfrom = 'DE'
              gosub cm.del.entry
              return
           end
           gosub set.bounds
           gosub delete.lines
           here = dawn
           if here gt last then
              here = last
              crt 'Bottom. Line ':here:' was above the last delete.'
           end else
              crt 'At line ':here:'. Deleted ':chng:' lines.'
              gosub display.line
           end
$ifdef qm
        case comd eq 'DISPLAY'     ; * insert display line for programmer
           if viewflag then gosub viewonly ; return
           if rest eq '' then
              crt 'You have not said what to put on DISPLAY line!'
              comi = ''
              return
           end
           gosub savethat
           here += 1 ; last += 1 ; lnum += 1
           if dlim ne '"' and dlim ne '\' then dlim = "'"
           line = 'DISPLAY ':dlim:rest:' = ':dlim:':':rest
           gosub insert.line
           gosub reset.record
           gosub display.line
$endif
        case comd eq 'DROP'              ; * remove the block
           if viewflag then gosub viewonly ; return
           if not(beg) and not(fin) then
              crt 'Command requests a block operation, but no block is defined.'
              gosub bad.comd ; return
           end
           if beg le 1 then
              temp = 0
           end else
              temp = index(this,am,beg-1)
              if not(temp) then
                 crt 'Error - Block start line not defined' ; *Cannot find beginning of block
                 gosub bad.comd ; return
              end
           end
           if fin eq last then
              temp -= 1
              temp<2> = len(this)
           end else
              temp<2> = index(this,am,fin)
           end
           if not(temp<2>) then
              crt 'Error - Block end line not defined' ; *Cannot find end of block
              gosub bad.comd ; return
           end
           numb = fin - beg + 1
           if blockflag then
              if beg eq fin
                 then stub = 'Delete line ': beg:' '
                 else stub = 'Delete block from line ': beg:' to line ': fin:'? '
              gosub get.answ
              if answ ne yes[1,1] then
                 crt 'Block command cancelled.'
                 return
              end
           end
           dawn = beg; dusk = fin
           gosub delete.lines
           crt 'Dropped (deleted) ':numb:' lines.'
           gosub display.line
        case comd eq 'DTX'               ; * decimal to hex
           if not(rest matches '1N0N') then
              crt 'Numeric value required'
              gosub bad.comd ; return
           end
           if len(rest) gt 9 then
              crt 'Must be less than one billion (1,000,000,000)'
              gosub bad.comd ; return
           end
$ifdef universe
           crt dtx(rest)
$else
           crt oconv(rest,'MX')
$endif
        case comd eq 'DUP'               ; * duplicate previous line
           if viewflag then gosub viewonly ; return
           if here lt 1 then
              crt 'No current line'
              gosub bad.comd ; return
           end
           if numb eq '' and rest matches '1N0N' then numb = rest
           if numb lt 1 then numb = 1
           gosub savethat
           gosub get.line
           for xx = 1 to numb
              gosub insert.line
              last += 1
           next xx
           gosub reset.record
           crt 'Inserted ':numb:' copies of line ':here:' after line ':here:'. Still at ':here:'.'
        case 1 ; gosub bad.command
     end case
     return

e:   begin case
        case comd eq 'EC'        ; * edit called program (in this file)
           if here lt 1 then here = 1
           gosub get.line
           line = trim(line)
           temp = upcase(line)
           good = index(temp,'CALL ',1)
           if good then line = trim(line[good+5,huge])
           line = trim(field(line,'(',1))
           if index(line,' ',1) then good = false
           if line[1,1] eq '@' then
              crt 'Leading "@" is logical pointer'
              good = false
           end
           if not(good) then
              crt 'The EC command requires lines in format "CALL ID" or "CALL ID(..."'
              gosub bad.comd ; return
           end

*           readv temp from file, line, 1 else
*              crt '"':line:'" is not in this file'
*              gosub bad.comd ; return
*           end
*           execute verb:' ':fnam:' ':line

           readv temp from file, line, 1 then
              execute verb:' ':fnam:' ':line:options
           end else
              test = false
              readv vlin from voc, line, 2 then
                 vcnt = dcount(vlin,'/')
                 vlin = field(vlin,'/',vcnt-1)
                 vlin = vlin[1,len(vlin)-2]
                 test = trans(vlin,line,-1,'X')
              end
              if test then
                 execute verb:' ':vlin:' ':line:options
              end else
                 crt '"':line:'" is not in this file'
                 gosub bad.comd ; return
              end
           end
***
           test = @(0,0)
           crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
        case comd = 'ECS'        ; * edit command stack
           ttid = whom:'_':levl:'_commands'
           temp = raise(stak)
           write temp on acom, ttid on error crt 'WRITE failure - file not updated' ; return
           crt view:'ing command stack'
           execute verb:' AE_COMS ':ttid:options
           test = @(0,0)
           crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
           read temp from acom, ttid else temp = ''
           temp = field(temp,am,1,staknumb-1)
           stak = lower(temp)
           delete acom, ttid
        case comd eq 'EDITPAGE'
           editpage = not(editpage)
*>
           if editpage then
              begn = @(0) ; goup = @(-10)
              prmt = '*':str('-',llen-1)
           end else
              begn = char(13) ; goup = ''
              prmt = str('-',llen)
           end
           crt 'editpage = ':editpage
*>
        case comd eq 'EF'        ; * edit fields
           numb = numb + 0
           if numb lt 0 or numb gt 255 then
              crt numb:' is outside range 0-255'
              comi = ''
              return
           end
           vmrk = char(numb)
           vals = 'char':numb
           gosub edit.fields
           vmrk = char(numb); gosub reset.fields
        case comd eq 'EI'        ; * edit included code
           if here lt 1 then here = 1
           gosub get.line
           line = field(line,';',1)
           line = trim(line)
           good = true
           temp = field(line,' ',1)
           temp = upcase(temp)
           if temp ne 'INCLUDE' and temp ne '$INCLUDE' then good = false
           line = trim(line[len(temp)+1,len(line)])
           begin case
              case dcount(line,' ') gt 3 ; good = false
              case dcount(line,' ') eq 3
                 if field(line,' ',1) ne 'DICT' then good = false
              case dcount(line,' ') eq 1
                 readv test from file, line, 1 then
                    line = fnam:' ':line
                 end else
                    test = trans('SYSCOM',line,1,'X')
                    if test ne ''
                       then line = 'SYSCOM ':line
                       else line = fnam:' ':line
                 end
           end case
           if not(good) then
              crt 'The EI command requires lines in format "$IN... {DICT} {FN} ID"'
              gosub bad.comd ; return
           end
           execute verb:' ':line:options
           test = @(0,0)
           crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
        case comd eq 'EIT'       ; * edit i-types (@)
           if dprt and here eq 2 and upcase(this[1,1]) else
              crt 'EIT is only for line 2 of a dictionary I-type'
              return
           end
           gosub get.line ; temp = line
           gosub split.itype
           ttid = whom:'_':levl:'_IType.in.line#':here
           write bite on acom, ttid on error gosub writerr ; return
           crt view:'ing IType as fields...':
           execute verb:' AE_COMS ':ttid:options
           test = @(0,0)
           crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
           read line from acom, ttid else line = ''
           delete acom, ttid
           vmrk = ';'; gosub reset.fields
*       case comd eq 'EM'         ; * edit MESSAGES
*          if numb eq '' and rest matches '1N0N' then numb = rest
*         if numb then
*            execute verb:' MESSAGES ':numb:options
*          end else
*             if here lt 1 then here = 1
*             gosub get.line
*             line = trim(line)
*             temp = upcase(line)
*             good = index(temp,'SYSMSG',1)
*             if good then line = trim(line[good+6,huge])
*             line = trim(field(line,'(',2))
*             line = trim(field(field(line,')',1),',',1))
*             if not(line matches '1N0N') then good = false
*             if not(good) then
*                crt 'The EM command requires lines in format "...sysmsg(1N0N..."'
*                crt 'Or a command like EMnnnn (nnnn is a message number)'
*                gosub bad.comd ; return
*             end
*             execute verb:' MESSAGES ':line:options
*          end
*          test = @(0,0)
*          crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
        case comd = 'EK'         ; * edit kept buffer
           ttid = whom:'_':levl:'_keptbuffer'
           write kept on acom, ttid on error crt 'WRITE failure - file not updated' ; return
           crt view:'ing kept buffer':
           execute verb:' AE_COMS ':ttid:options
           test = @(0,0)
           crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
           read kept from acom, ttid else kept = ''
           delete acom, ttid
        case comd = 'EPR'        ; * edit prestores
           numb = numb + 0
           if numb lt 0 or numb gt presnumb then
              crt 'PRestore must be in range 1-':presnumb:'.'
              gosub bad.comd ; return
           end
           ttid = whom:'_':levl:'_prestores'
           temp = raise(pres)
           if numb then
              bite = raise(temp<numb>)
              write bite on acom, ttid on error crt 'WRITE failure - file not updated' ; return
              crt view:'ing prestore ':view:
           end else
              write temp on acom, ttid on error crt 'WRITE failure - file not updated' ; return
              crt view:'ing prestores':
           end
           execute verb:' AE_COMS ':ttid:options
           test = @(0,0)
           crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
           if numb then
              read bite from acom, ttid else bite = ''
              temp<numb> = lower(bite)
           end else
              read temp from acom, ttid else temp = ''
           end
           pres = lower(temp)
           delete acom, ttid
        case comd = 'ESS'        ; * edit search stack
           ttid = whom:'_':levl:'_searches'
           temp = raise(look)
           write temp on acom, ttid on error crt 'WRITE failure - file not updated' ; return
           crt view:'ing search stack':
           execute verb:' AE_COMS ':ttid:options
           test = @(0,0)
           crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
           read temp from acom, ttid else look = ''
           look = lower(temp)
           delete acom, ttid
        case comd eq 'ESV'       ; * edit subvalues
           vmrk = sm ; vals = 'subvalues'
           gosub edit.fields
           vmrk = sm; gosub reset.fields
        case comd eq 'ET'        ; * edit tabs
           ttid = whom:'_':levl:'_tabs'
           xxno = dcount(krj<1>,@vm)
           temp = ''
           for xx = 1 to xxno
              temp<xx> = krj<2,xx>:' ':krj<1,xx>
           next xx
           write temp on acom, ttid on error crt 'WRITE failure - file not updated' ; return
           crt view:'ing line tabs':
           execute verb:' AE_COMS ':ttid:options
           test = @(0,0)
           crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
           read temp from acom, ttid else temp = ''
           xxno = dcount(temp,@am)
           krj = @am:@am:krj<3>
           yy = ''
           for xx = 1 to xxno
              bite = trim(temp<xx,1,1>)
              left = field(bite,' ',1)
              rest = field(bite,' ',2,99)
              if left matches '1N0N' then left += 0 else left = 0
              if left gt last then left = 0
              if left then
                 yy += 1
                 if rest eq '' then rest = 'T':left
                 krj<1,yy> = rest
                 krj<2,yy> = left
              end
           next xxno
           if krj<3> gt yy then krj<3> = yy
           if krj<1> ne '' and krj<3> lt 1 then krj<3> = 1
           delete acom, ttid
        case comd eq 'EV'        ; * edit values
           vmrk = vm ; vals = 'values'
           gosub edit.fields
           vmrk = vm; gosub reset.fields
        case comd eq 'EW'        ; * edit words (as defined by wordmark)
           vmrk = wordmark ; vals = 'words'
           gosub edit.fields
           vmrk = wordmark; gosub reset.fields
* Various forms for quitting
        case comd eq 'EX' or comd = 'EXIT' ; comd = 'Q' ; redo = true
        case comd eq 'EXK' or comd = 'EXITK' ; comd = 'QK' ; redo = true
        case 1 ; gosub bad.command
     end case
     return

f:   begin case
        case comd eq 'FD'                ; * delete item
           if viewflag then gosub viewonly ; return
           if not(sec.delete.flg) then
              crt 'Delete disabled'
              comi = ''
              return
           end
           gosub write.record
        case comd eq 'FILE' ; comd = 'SV' ; redo = true
        case comd[1,2] eq 'FI'           ; * file item
           if viewflag then gosub viewonly ; return
           if not(sec.write.flg) then
              crt 'File disabled'
              comi = ''
              return
           end
           temp = comd[3,len(comd)]
           convert 'BCRDL' to '' in temp
           if temp eq '' then gosub write.record else gosub bad.command
        case comd eq 'FL' or comd eq 'FLA'  ; * find labels
           if not(caseflag) then rest = upcase(rest)
           if index(comd,'A',1) then
              bump = -1
              dawn = here - 1
              if dawn lt 1 then return
              if numb then dusk = here - numb else dusk = 1
              if dusk lt 1 then dusk = 1
           end else
              bump = 1
              dawn = here + 1
              if dawn gt last then dawn = 1
              if numb then dusk = dawn + numb else dusk = last
              if dusk gt last then dusk = last
           end
           for here = dawn to dusk step bump
              gosub get.line
              gosub find.label
              if not(caseflag) then temp = upcase(temp)
              if temp ne '' then
                 if rest eq '' or temp matches rest then
                    gosub display.line
                    if not(numb) then return
                 end
              end
           next here
           crt
           gosub display.line
        case comd eq 'FM' or comd eq 'FMA'       ; * find match command
           gosub get.line
* Get rid of any label
           gosub find.label
           thisline = trimf(line)
           if temp ne '' then
               thisline = thisline[len(temp)+1,huge]
               if thisline[1,1] eq ':' then thisline = thisline[2,huge]
              thisline = trimf(thisline)
           end
* Get the first word on the line
           word = field(trim(upcase(thisline)),' ',1)
           begin case
              case rest ne ''
                 seek = upcase(rest)
              case word[1,1] eq '*' or word[1,1] eq '!'
                 seek = word[1,1]
              case 1
                 locate(word,fm.words;posn) then
                    if index(comd,'A' ,1) then
                       seek = fm.finda<posn>
                    end else
                       seek = fm.findf<posn>
                    end
                 end else
                    locate(word,endwords;posn) then
                       seek = 'END'
                    end else
                       crt 'Starting word "':word:'" unknown'
                       gosub bad.comd ; return
                    end
                 end
           end case
           if seek eq '' then
              crt word:' has no matching word for ':comd
              gosub bad.comd ; return
           end
           posn = index(upcase(line),word,1)
           xxno = dcount(seek,vm)
           for xx = 1 to xxno
              seek<1,xx> = space(posn-1):seek<1,xx>
           next xx
           if index(comd,'A',1) then
              bump = -1
              dawn = here - 1
              if dawn lt 1 then return
              dusk = 1
           end else
              bump = 1
              dawn = here + 1
              if dawn gt last then return
              dusk = last
           end
           save = here
           for here = dawn to dusk step bump
              gosub get.line
              line = upcase(line)
              if line[1,1] ne '' then
                 temp = field(line,' ',1)
                 if num(temp) or temp[len(temp),1] eq ':' then
                    temp = len(temp)
                    line = space(temp):line[temp+1,len(line)]
                 end
              end
              for xx = 1 to xxno
                 slen = len(seek<1,xx>)
                 if line[1,slen] eq seek<1,xx> then
                    if trim(line[slen+1,1]) eq '' then
                       gosub display.line
                       return
                    end
                 end
              next xx
           next here
           here = save
           gosub get.line
        case comd eq 'FOLD'              ; * fold the line
           if viewflag then gosub viewonly ; return
           chng = 0 ; save = here ; savl = last
           if dlim ne '' then fold = ''
           if rest eq '' then rest = fold
           if rest eq '' then rest = span-llen-2
           if not(rest matches '1N0N') then
              crt 'Non-numeric length - try HELP FOLD.'
              comi = ''
              return
           end
           fold = rest
           gosub get.line
           crt 'FOLD line to length ':fold
           bite = line
           gosub parse.bite
           gosub check.line
           if chng then gosub reset.record
        case comd eq 'FOR' or comd eq 'FORMAT'      ; * format this item
           rest = upcase(rest)
           temp = index(rest,'-M',1)
           if temp then fr(1) = field(rest[temp+2,huge],' ',1) ; fr(2) = ''
           if not(fr(1) matches '1N0N') then fr(1) = ''
           if fr(1) eq '' then
              temp = this<1>
              fr(1) = len(temp) - len(trimf(temp))
           end
           temp = index(rest,'-I',1)
           if temp then fr(2) = field(rest[temp+2,huge],' ',1)
           if not(fr(2) matches '1N0N') then fr(2) = ''
           if fr(2) eq '' then
              fr(2) = int((fr(1)+1)/2)
              if fr(2) lt 2 then fr(2) = 2
           end
           if index(rest,'-A',1) then fr(9) = true else fr(9) = ''
           if index(rest,'-N',1) then fr(10) = true else fr(10) = ''
           if index(rest,'-C',1) then
              fr(1) = 0
              fr(2) = 1
              fr(9) = true
              fr(10) = true
           end
           if last lt 1 then return
           gosub savethat
           crt 'Margin=':fr(1):', Indentation=':fr(2)
           gosub indenter
           gosub set.record
        case 1 ; gosub bad.command
     end case
     return

g:   begin case
        case comd eq 'G'                 ; * Go to line
           if numb eq '' then
              if dlim eq '<' and beg ne '' then here = beg
              if dlim eq '>' and fin ne '' then here = fin
           end else here = numb
           if here gt last then here = last
           gosub display.line
        case 1 ; gosub bad.command
     end case
     return

h:   begin case
        case comd eq 'H' or comd eq 'HELP'
           gosub show.help
        case comd eq 'HEX'            ; * show this line in hexadecimal
           if not(here) then return
           gosub get.line
           temp = ''
           xxno = len(line)
           for xx = 1 to xxno
              bit = line[xx,1]
$ifdef universe
              bit = dtx(seq(bit))
$else
              bit = oconv(seq(bit),'MX')
$endif
$ifdef unidata
              bit = fmt(bit,'2/0R')
$else
              bit = fmt(bit,'R%2')
$endif
              temp<1> = temp<1>:bit[1,1]
              temp<2> = temp<2>:bit[2,1]
           next xx
           if lfmt then crt fmt(here,lfmt):': ':
           crt temp<1>
           if lfmt then crt space(llen+2):
           crt temp<2>
           temp = ''
        case 1 ; gosub bad.command
     end case
     return

i:   begin case
        case comd eq 'I'                 ; * insert lines
           if viewflag then gosub viewonly ; return
           chng = 0 ; save = here ; savl = last
           if rest ne '' then
              if numb lt 1 then numb = 1
              inum = numb
              gosub get.line
              if not(chng) then gosub savethis
              if here gt 0 then
                 memr(cell)<lnum> := str(am:rest,inum)
              end else memr(1)<1> = str(rest:am,inum):memr(1)<1>
              if here le beg then beg += inum
              if here le fin then fin += inum
              yyno = dcount(krj<1>,vm)
              for yy = 1 to yyno
                 if krj<2,yy> gt here then krj<2,yy> += inum
              next yy
              here = here + inum
              gosub reset.record
              gosub get.line
              gosub display.line
              crt 'At line ':here:'. ':inum:' lines inserted, bottom now at line ':last:'.'
           end else
              if nill ne '' then
                 crt 'Terminate input with "':nill:'"'
              end
!&&&
!   if nick then gosub get.line
!&&&
              loop
!&&&
!   if nick
!      then pill = space(len(line)-len(trimf(line)))
!      else pill = ''
!   pick = pill
!   pill := nill
!&&&
                 new1 = here + 1
                 stub = new1:'='
                 if lfmt then stub = fmt(new1,lfmt):'='
                 gosub get.rope; line = rope
!&&&
              until line eq nill do
!              until line eq nill or line eq pill do
!&&&
                 gosub parse.line
                 last += 1
                 here += 1
                 lnum += 1
                 if not(chng) then gosub savethis
                 chng += 1
                 gosub insert.line
                 temp = len(last)
                 if lfmt then
                    if temp gt 3 and temp ne llen then gosub get.lfmt
                 end
                 if line eq nill then
                    crt begn:
                    if lfmt then crt fmt(new1,lfmt):'= ':
                 end
                 crt
                 numb -= 1
                 if numb eq 0 then exit
              repeat
              crt begn:ceol:
           end
           if chng then gosub reset.record
        case comd eq 'IC'                ; * iconv
           if viewflag then gosub viewonly ; return
           if rest eq '' then
              crt 'No conversion given'
              gosub bad.comd ; return
           end
           ccom = '*':rest ; gosub conv.command
        case comd eq 'IN'                ; * insert from execute
           if viewflag then gosub viewonly ; return
           if trim(rest) eq '' then
              crt 'No external command given'
              comi = '' ; return
           end
           execute rest capturing bite
           test = @(0,0)
           numb = dcount(bite,am)
           if numb then
              gosub savethat
              this = insert(this,here+1,0,0,bite)
              gosub set.record
              crt 'Inserted ':numb:' lines; still at line ':here:'.'
           end else
              crt 'Nothing done - no output from command.'
              comi = '' ; return
           end
        case 1 ; gosub bad.command
     end case
     return

j:   begin case
        case comd eq 'J'                 ; * join lines
           if viewflag then gosub viewonly ; return
           if dlim ne '' then
              line = rest ; gosub parse.line ; join = line
           end
           if here and here lt last then
              chng = 0 ; save = here ; savl = last
              gosub get.line
              test = line
              here += 1
              gosub set.bounds
              for here = dawn to dusk
                 gosub get.line
                 test = test:join:line
              next here
              gosub delete.lines
              if chng eq 0 then return
              here = save
              oopl = here
              gosub get.line
              memr(cell)<lnum> = test
              gosub reset.record
           end
           gosub display.line
        case 1 ; gosub bad.command
     end case
     return

k:   begin case
        case comd eq 'KEEP' or comd eq 'KEEPA'
           gosub get.load
           if temp eq '' then return
           if comd[len(comd),1] ne 'A' then
              gosub get.lines
              if not(temp) then return
           end
           kept = temp
           temp = dcount(temp,am)
           crt 'At line ':here:', ':temp:' lines loaded into kept buffer.'
           temp = ''
        case comd eq 'KEPT' or comd eq 'K' ; * display kept
           xxno = dcount(kept,am)
           if xxno lt 1 then
              crt 'Nothing in KEPT buffer'
              return
           end
           bit = len(xxno)
           disp = '***** Contents of KEPT buffer (':xxno:' lines) *****'
           stub = 'Press return to continue showing KEPT buffer, Q to quit'
           for xx = 1 to xxno
              temp = oconv(kept<xx>,'MCP')[1,wide-bit-1]
              disp<-1> = fmt(xx,'R#':bit):':':temp
           next xx
           gosub show.disp
        case 1 ; gosub bad.command
     end case
     return

l:   begin case
        case index('\L\LN\LA\LNA\LAN\','\':comd:'\',1)   ; * list or locate
           if upcase(comi) eq 'L' then
              if look<1,1> eq '' then
                 crt 'No previous locate command to repeat.'
                 comi = ''
                 return
              end
              comi = look<1,1>
              gosub parse.command
              if comd eq '' then comd = 'L' ; numb = huge
              redo = true
              return
           end
           finder = ''
           seeker = dlim
           if seeker eq '!' or seeker eq '&' then
              finder = rest
              convert dlim to am in finder
              if finder<2> eq '' then finder = '' else rest = finder<1>
           end
           looper = dcount(finder,am)
           if rest ne '' then
              gosub parse.cols
              if not(good) then return
           end else
              if dlim ne '' then
                 crt 'The second field is empty.'
                 gosub bad.comd ; return
              end
              cols = ''
           end
           if index(comd,'A',1) then
              bump = -1
              dawn = here - 1
              if dawn lt 1 then dawn = 1
              if numb then dusk = here - numb + 1 else dusk = 1
              if dusk lt 1 then dusk = 1
           end else
              bump = 1
              dawn = here + 1
              if dawn gt last then dawn = 1
              if numb then dusk = dawn + numb - 1 else dusk = last
              if dusk gt last then dusk = last
           end
           if looper then rest = finder else looper = 1
           line = rest ; gosub parse.line ; rest = line
           lastfind = rest<1>
           if not(caseflag) then rest = upcase(rest)
           if spaceflag else convert ' ':char(9) to '' in rest
           for here = dawn to dusk step bump
              gosub get.line
              if cols then line = line[cols,colf]
              if caseflag then temp = line else temp = upcase(line)
              if spaceflag else convert ' ':char(9) to '' in temp
              badder = false ; gooder = false
              for xx = 1 to looper
                 if index(temp,rest<xx>,1)
                    then gooder = true
                    else badder = true
              next xx
              if seeker eq '&' then gooder = not(badder)
              if gooder then
                 if not(index(comd,'N',1)) then
                    gosub display.line
                    if not(numb) then exit
                 end
              end else
                 if index(comd,'N',1) then
                    gosub display.line
                    if not(numb) then exit
                 end
              end
           next here
           if numb then here = dusk
           crt 'Now at line ':here:
           if here eq last then crt ' (bottom)':
           crt '.'
           if rest ne '' and comi ne '' and comi ne look<1,1> then
              look = insert(look,1,1,0,comi)
              look = field(look,vm,1,looknumb)
           end
        case comd eq 'LC'                ; * lower case (make line in)
           if viewflag then gosub viewonly ; return
           if rest eq '' then ccom = 'MCL' else ccom = 'QMCL'
           gosub conv.command
* Various forms for loading stuff
        case comd eq 'LD' or comd eq 'LOAD' or comd eq 'LDA' or comd eq 'LOADA'
           if viewflag then gosub viewonly ; return
           if not(sec.load.flg) then
              crt 'LOAD disabled'
              comi = ''
              return
           end
           gosub get.load
           if temp eq '' then return
           if prepflag then
              sec.call2.type = 1
              sec.fn2 = ofpt
              sec.id2 = oipt
              sec.dict2.flg = (odpt = 'DICT')
              call @prepprog(mat security)
              if sec.stop.flg then stop
              if not(sec.ok2.flg) then
                 gosub bad.comd ; return
              end
           end
           if comd[len(comd),1] ne 'A' then
              gosub get.lines
              if not(temp) then return
           end
           gosub savethat
           this = insert(this,here+1,0,0,temp)
           temp = dcount(temp,am)
           here = here + temp
           crt 'At line ':here:', ':temp:' lines loaded.'
           temp = ''
           gosub set.record
        case comd eq 'LL'                ; * long lines
           if not(rest matches '1N0N') then
              rest = span-llen-2
              crt 'LL':numb:'/':rest
           end
           dawn = here + 1
           if dawn gt last then dawn = 1
           if numb then dusk = here + numb else dusk = last
           if dusk gt last then dusk = last
           for here = dawn to dusk
              gosub get.line
              temp = trim(line[rest,huge])
              if temp ne '' then
                 gosub display.line
                 if not(numb) then return
              end
           next here
           crt
           gosub display.line
        case 1 ; gosub bad.command
     end case
     return

m:   begin case
        case comd eq 'M'         ; * pattern matching
           rest = field(rest,dlim,1)
           if rest eq '' and mmat ne '' then
              dlim = mmat<1,1>
              rest = mmat<1,2>
           end
           if rest eq '' then
              crt 'No pattern given to match'
              return
           end
           gosub changematch.command
        case comd eq 'MACRO'
           if macn then
              temp = dcount(macc<1,1>,sm)
              macc = delete(macc,1,1,temp)
              macc = delete(macc,1,1,temp)
              if macc ne '' then
                 pres<1,macn> = macc<1,1>
                 crt 'Macro saved to PRestore ':macn
              end else
                 crt 'Macro empty - not saved'
              end
              macc = ''
              macn = 0
           end else
              if numb eq '' then numb = 1
              if numb gt presnumb or numb lt 1 then
                 crt 'PRestore must be in range 1-':presnumb:'.'
                 comi = ''
                 return
              end
              crt 'Macro being recorded for PRestore ':numb
              macn = numb
           end
        case comd eq 'MERGE' or comd eq 'ME'      ; * merge stuff
           if viewflag then gosub viewonly ; return
           if rest eq '' and numb eq '' then
              if not(beg) and not(fin) then
                 crt 'Command requests a block operation, but no block is defined.'
                 gosub bad.comd
                 return
              end
              numb = fin - beg + 1
              if blockflag then
                 if beg eq fin
                    then stub = 'Copy line ':beg:' to under line ':here:'? '
                    else stub = 'Copy lines ':beg:'-':fin:' to under line ':here:'? '
                 gosub get.answ
                 if answ ne yes[1,1] then
                    crt 'Block command cancelled.'
                    return
                 end
              end
              dlim = ' '
              rest = beg:' ':fin
              numb = ''
           end
           rest = trim(rest)
           if numb eq '' then gosub parse.atts
           if numb ne '' and rest eq '' then rest = here
           if not(rest matches '1N0N') or numb eq '' then
              crt 'Format of MErge command is: "MEn/s"; eg: "ME10/15" or "ME/s/f"; eg: "ME/15/24"'
              gosub bad.comd ; return
           end
*           if numb gt last then
*              crt 'Nothing done - record does not have that many lines.'
*              comi = '' ; return
*           end
           bite = field(this,am,rest,numb)
           if numb ne 1 or bite ne '' then numb = dcount(bite,am)
           if numb then
              gosub savethat
              this = insert(this,here+1,0,0,bite)
              gosub set.record
              if beg gt here then beg = beg + numb
              if fin gt here then fin = fin + numb
              xxno = dcount(krj<1>,vm)
              for xx = 1 to xxno
                 if krj<2,xx> gt here then krj<2,xx> += numb
              next xx
              crt 'Merged ':numb:' lines starting at line ':rest:'; still at line ':here:'.'
           end else
              crt 'Nothing done - this line is within the range.'
              comi = '' ; return
           end
        case comd eq 'MOVE' or comd eq 'MV'       ; * move stuff
           if viewflag then gosub viewonly ; return
           if rest eq '' then
              if not(beg) and not(fin) then
                 crt 'Command requests a block operation, but no block is defined.'
                 gosub bad.comd
                 return
              end
              if here le fin and here ge beg then
                 crt 'A block may not be moved into itself. MERGE will work.'
                 comi = ''
                 return
              end
              numb = fin - beg + 1
              if blockflag then
                 if beg eq fin then
                    stub = 'Move line ':beg:' to after line ':here:' OK? ':ny
                 end else
                    stub = 'Move lines ':beg:'-':fin:' to after line ':here:' OK? ':ny
                 end
                 gosub get.answ
                 if answ ne yes[1,1] then
                    crt 'Block command cancelled.'
                    return
                 end
              end
              dlim = ' '
              rest = beg:' ':fin
              numb = ''
           end
           rest = trim(rest)
           if numb eq '' then gosub parse.atts
           if not(rest matches '1N0N') or numb eq '' then
              crt 'Format of MoVe command is: "MVn/s"; eg: "MV10/15" or "MV/s/f"; eg: "MV/15/24"'
              gosub bad.comd ; return
           end
           dusk = rest + numb - 1
           if dusk gt last then dusk = last
           if here ge rest and here le dusk then
              crt 'Nothing done - this line is within the range.'
              comi = '' ; return
           end
           bite = field(this,am,rest,numb)
           numb = dcount(bite,am)
           if numb then
              gosub savethat
              if here gt dusk then
                 this = insert(this,here+1,0,0,bite)
                 if rest gt 1
                    then this = this[1,col1()-1]:this[col2(),len(this)]
                    else this = this[col2()+1,len(this)]
              end else
                 this = this[1,col1()-1]:this[col2(),len(this)]
                 this = insert(this,here+1,0,0,bite)
              end
              gosub set.record
              if here gt dusk then
                 here = here - numb
                 crt 'Moved ':numb:' lines starting at line ':rest:'; now at line ':here:'.'
              end else
                 crt 'Moved ':numb:' lines starting at line ':rest:'; still at line ':here:'.'
              end
!##############
              posn = beg; gosub recalc.posn; beg = posn
              posn = fin; gosub recalc.posn; fin = posn
              xxno = dcount(krj<1>,vm)
              for xx = 1 to xxno
                 posn = krj<2,xx>; gosub recalc.posn; krj<2,xx> = posn
              next xx
           end else
              crt 'Nothing done - no lines selected.'
              comi = '' ; return
           end
        case 1 ; gosub bad.command
     end case
     return

n:   begin case
        case comd eq 'N'                 ; * same as "+"
           if numb eq '' then numb = 1
           here = here + numb
           if here gt last then here = last
           gosub display.line
        case comd eq 'NULL'              ; * null line input definition
           dlim = trim(dlim):trim(rest)
           dlim = dlim[1,1]
           nill = dlim
           if nill eq '"' then
              bit = "'":nill:"'"
           end else bit = '"':nill:'"'
           crt 'NULL character to terminate INSERT is ':bit:'.'
           comi = ''
        case comd eq 'NUM'               ; * toggle the line numbering
           if lfmt eq '' then
              crt 'Line Numbering is ON'
              gosub get.lfmt
           end else
              crt 'Line Numbering is OFF'
              lfmt = ''
           end
        case 1 ; gosub bad.command
     end case
     return

o:   begin case
        case comd eq 'OC'                ; * oconv
           if viewflag then gosub viewonly ; return
           if rest eq '' then
              crt 'No conversion given'
              gosub bad.comd ; return
           end
           ccom = rest ; gosub conv.command
        case comd[1,2] eq 'OO'           ; * undo last change
           if oopc ne '' then
              this = oops
              here = oopl
              last = oopf
              beg = oopb<1>
              fin = oopb<2>
              krj = oopk
              gosub set.record
              crt '"':oopc:'" undone - now at line ':here:'.'
              oops = '' ; oopc = '' ; oopl = '' ; oopf = ''
              oopb = '' ; oopk = ''
              gosub display.line
           end else
              crt 'last change already "undone" or nothing to undo'
           end
           comi = ''
        case comd eq 'OUT'
           gosub outline
        case 1 ; gosub bad.command
     end case
     return

p:   begin case
        case comd eq 'P'                 ; * page on
           if numb else numb = plen
           if here ge last then here = 0
           here += 1
           gosub set.bounds
           for here = dawn to dusk
              gosub display.line
           next here
           here = dusk
        case comd eq 'PA'                ; * print window up to here
           if numb else numb = pwin
           save = here
           here = here - numb
           gosub set.bounds
           for here = dawn to dusk
              gosub display.line
           next here
           here = save
           crt 'Still at line ':here:'.'
        case comd = 'PASTE' and rest eq ''  ; * paste from kept
           if viewflag then gosub viewonly ; return
           if kept eq '' then
              crt 'Nothing in KEPT buffer'
              comi = '' ; return
           end
           gosub savethat
           numb = dcount(kept,am)
           this = insert(this,here+1,0,0,kept)
           gosub set.record
           crt 'Pasted ':numb:' lines from KEPT buffer; still at line ':here:'.'
           if beg gt here then beg += numb
           if fin gt here then fin += numb
           xxno = dcount(krj<1>,vm)
           for xx = 1 to xxno
              if krj<2,xx> gt here then krj<2,xx> += numb
           next xx
        case comd eq 'PASTE'                          ; * save the kept buffer
           if viewflag then gosub viewonly ; return
           if kept eq '' then
              crt 'Nothing in KEPT buffer'
              comi = '' ; return
           end
           gosub save.stuff
        case comd eq 'PE'                ; * page editor mode
           if not(editpage) then
              crt 'Page editing not possible at this terminal'
              comi = ''
              return
           end
           that = this ; savl = here:am:last
           if this eq '' then this = am
           if here lt 1 then here = 1
           ptop = here
           mode = 'PAGE':am:'View'
           if sec.write.flg then mode<2> = 'Ins'
           pchr = 1
           chng = '' ; show = ''
           gosub display.page
*>
           gosub get.line
*>
           temp = line
        case comd eq 'PL'                ; * print window from here
           if numb else numb = pwin
           save = here
           gosub set.bounds
           for here = dawn to dusk
              gosub display.line
           next here
           here = save
           crt 'Still at line ':here:'.'
        case comd eq 'PP'                ; * print window bracketing here
           if numb else numb = pwin
           save = here
           here = here - int(numb/2)
           gosub set.bounds
           for here = dawn to dusk
              gosub display.line
           next here
           here = save
           crt 'Still at line ':here:'.'
        case comd eq 'PR'                ; * prestore processing
           if numb eq '' then
              crt 'Defined prestores (':presnumb:' Maximum)'
              for xx = 1 to presnumb
                 temp = pres<1,xx>
                 convert sm to comdmark in temp
$ifdef unidata
                 crt fmt(xx,'2/0R'):' ':temp
$else
                 crt fmt(xx,'R%2'):' ':temp
$endif
              next xx
              return
           end
           if numb gt presnumb or numb lt 1 then
              crt 'PRestore must be in range 1-':presnumb:'.'
              comi = ''
              return
           end
           if dlim ne '' then
              if not(rest eq rest<1,1,1>) then
                 crt 'Invalid - delimiter in prestore'
                 comi = ''
                 return
              end
              pres<1,numb> = change(rest,dlim,sm)
           end else
              salt = pres<1,numb>
           end
        case 1 ; gosub bad.command
     end case
     return

q:   begin case
* Various forms for quitting
        case comd eq 'Q' or comd = 'QK' or comd = 'QUIT' or comd = 'QUITK'
           if not(viewflag) and (orig ne this) then
              stub = '***** Record changed --- OK to Quit? (N/Y)>'
              gosub get.answ
              if answ eq yes[1,1] then stopsign = true
           end else stopsign = true
           if stopsign then
              if orig eq '' then
                 crt 'Quit "':item:'" in file "':fnam:'" not created.'
              end else crt 'Quit "':item:'" in file "':fnam:'" unchanged.'
              if index(comd,'K',1) then
                 killsign = true
                 if idcnt gt 1 then crt 'Select list cancelled.'
              end
           end
        case 1 ; gosub bad.command
     end case
     return

r:   begin case
        case comd eq 'RA'                ; * view or repeat change
           if viewflag then gosub viewonly ; return
           gosub change.command
        case comd eq 'R' and dlim ne '' and index(rest,dlim,1) ; * change
           if viewflag then gosub viewonly ; return
           crt ; comd = 'C'
           gosub change.command
        case comd eq 'R'                 ; * replace lines
           if viewflag then crt ; gosub viewonly ; return
           if not(last) then
              crt 'Empty record, use Insert (I) command.'
              comi = ''
              return
           end
           if here lt 1 then here = 1 ; gosub display.line
           chng = 0 ; save = here ; savl = last
           if numb lt 1 then numb = 1
           if dlim ne '' and rest eq '' then rest = ' '
           loop
              crt begn:
              if lfmt then crt fmt(here,lfmt):'=':
              crt ceop:
              if rest eq '' then
                 stub = here:'='
                 if lfmt then stub = fmt(here,lfmt):'='
                 gosub get.rope; line = rope
              end else line = rest
              gosub parse.line
           until line eq '' do
              crt goup:begn:ceol:
              if lfmt then crt fmt(here,lfmt):': ':
              crt line
              if line eq comdmark then
                 line = ''
                 crt begn:
                 if lfmt then crt fmt(here,lfmt):': ':
              end
              if numb gt 1 then crt
              if line eq ' ' then line = ''
              if not(chng) then gosub savethis
              chng += 1
              memr(cell)<lnum> = line
              here += 1 ; numb -= 1
              gosub get.line
              if numb eq 0 then exit
           repeat
           if here ne save then here -= 1
           if chng then gosub reset.record; gosub get.line
           crt begn:ceol:
        case comd eq 'RELEASE'           ; * release the item lock
           release file,item
           lock = false
        case 1 ; gosub bad.command
     end case
     return

s:   begin case
        case comd eq 'S'                 ; * search processing
           if numb eq '' then
              crt 'Last ':looknumb:' searches (latest first)'
              for xx = 1 to looknumb
$ifdef unidata
                 crt fmt(xx,'2/0R'):' ':look<1,xx>
$else
                 crt fmt(xx,'R%2'):' ':look<1,xx>
$endif
              next xx
              return
           end
           if numb gt looknumb or numb lt 1 then
              crt 'Search must be in range 1-':looknumb:'.'
              comi = ''
              return
           end
           comi = look<1,numb>
           if comi eq '' then
              crt 'There is no search number ':numb:'.'
              return
           end
           look = delete(look,1,numb,0)
           look = insert(look,1,1,0,comi)
           gosub parse.command
           if comd eq '' then comd = 'L' ; numb = huge
           comi = ''
           redo = true
        case comd eq 'SAVE' or comd eq 'SV'         ; * save the item
           if viewflag then gosub viewonly ; return
           comd = 'SV'
           if rest eq '' then
              if not(sec.write.flg) then
                 crt 'File disabled'
                 comi = ''
                 return
              end
              gosub write.record
           end else gosub save.stuff
        case comd eq 'SEQ'               ; * build a sequence
           if viewflag then gosub viewonly ; return
           if dlim eq '' then
              crt 'Too few fields in this command.'
              gosub bad.comd ; return
           end
           good = true
           cfrom = field(rest,dlim,1)
           cto = field(rest,dlim,2)
           if cto eq '' then cto = 1
           if not(num(cto)) then
              crt 'Base for sequence command must be a number.'
              good = false
           end
           bit = field(rest,dlim,3)
           if bit eq '' then bit = 1
           if not(num(bit)) then
              crt 'Increment for sequence command must be a number.'
              good = false
           end else
              if not(bit) then
                 crt 'Increment for sequence command must not be zero.'
                 good = false
              end
           end
           if not(good) then gosub bad.comd ; return
           rest = dlim:field(rest,dlim,4,2)
           if rest ne dlim then
              gosub parse.cols
              if not(good) then return
           end else cols = ''
           chng = 0 ; save = here ; savl = last
           gosub set.bounds
           for here = dawn to dusk
              gosub get.line ; temp = line
              if cols then
                 bite = index(line[cols,colf],cfrom,1)
                 if bite then bite = bite + cols - 1
              end else
                 bite = index(line,cfrom,1)
              end
              if bite then
                 temp = line[1,bite-1]:cto
                 temp = temp:line[bite+len(cfrom),len(line)]
              end
              if '*':temp ne '*':line then
                 cto = cto + bit
                 if not(chng) then gosub savethis
                 chng += 1
                 memr(cell)<lnum> = temp
                 gosub display.line
              end
           next here
           here = dusk
           if chng then gosub reset.record
        case comd eq 'SHOW'              ; * show changes flag
           rest = upcase(rest)
           begin case
              case rest eq 'ON' ; shew = true
              case rest eq 'OFF' ; shew = false
              case 1 ; shew = not(shew)
           end case
           if shew
              then crt 'Show changes flag is ON'
              else crt 'Show changes flag is OFF'
        case comd eq 'SORT' or comd eq 'SORTU'    ; * sort the block
           if viewflag then gosub viewonly ; return
           test = index(comd,'U',1)
           if not(beg) and not(fin) then
              crt 'Command requests a block operation, but no block is defined.'
              gosub bad.comd
              return
           end
           if beg le 1 then
              temp = 0
           end else
              temp = index(this,am,beg-1)
              if not(temp) then
                 crt 'Cannot find beginning of block'
                 gosub bad.comd ; return
              end
           end
           rest = upcase(rest)
           if rest eq '' then rest = 'AL'
           if not(index('*AR*AL*DR*DL*','*':rest:'*',1)) then
              crt 'Invalid sort sequence - use "AL" "AR" "DL" or "DR"'
              gosub bad.comd ; return
           end
           temp<2> = index(this,am,fin)
           if fin eq last then temp<2> = len(this)+1
           if not(temp<2>) then
              crt 'Cannot find end of block'
              gosub bad.comd ; return
           end
           if blockflag then
              stub = 'Sort block beginning at ': beg:' and ending at ': fin:'?'
              gosub get.answ
              if answ ne yes[1,1] then
                 crt 'Block command cancelled.'
                 return
              end
           end
           gosub savethat
           bits = ''
           for here = beg to fin
              gosub get.line
              locate(line,bits;posn;rest) then
                 if test then good = false else good = true
              end else good = true
              if good then bits = insert(bits,posn;line)
           next here
           here = oopl
           if fin ne last
              then this = this[1,temp<1>]:bits:am:this[temp<2>+1,len(this)]
              else this = this[1,temp<1>]:bits
           bits = ''
           gosub set.record
* If any tags are in the sorted block then clear the tags,
* as it really makes no sense to try and sort them.
           good = true
           xxno = dcount(krj<1>,vm)
           for xx = 1 to xxno
              posn = krj<2,xx>
              if posn ge beg and posn le fin then good = false
           next xx
           if not(good) then
              krj = ''
              crt 'Tags cleared'
           end
           gosub display.line
        case comd eq 'SPACE'               ; * change spacing flag for 'L'
           rest = upcase(rest)
           begin case
              case rest eq 'ON' ; spaceflag = true
              case rest eq 'OFF' ; spaceflag = false
              case 1 ; spaceflag = not(spaceflag)
           end case
           if spaceflag then
              crt 'SPACE flag is ON'
           end else crt 'SPACE flag is OFF'
        case comd eq 'SPOOL'             ; * print
           save = here
           if numb eq '' and rest matches '1N0N' then numb = rest
           if numb eq '' then here = 1 ; numb = last
           gosub set.bounds
           head = 'Record - ':item:' File - ':fnam:' Account - ':acct:' '
           head = head:timedate():"'LL'"
           temp = span
           printer on
           temp = temp - llen - 2
           heading head
           for here = dawn to dusk
              gosub get.line
              convert badc to gudc in line
              print fmt(here,lfmt):': ':line[1,temp]
              loop
                 line = line[temp+1,len(line)]
              until line eq '' do
                 print space(llen+2):line[1,temp]
              repeat
           next here
           printer close
           if dawn ne 1 or dusk ne last then
              crt 'Lines ':dawn:' to ':dusk:' of ':
           end
           crt '"':item:'" spooled to the printer.'
           here = save
        case comd eq 'SPOOLHELP'         ; * print the help
           rest = am
           gosub show.help
        case comd eq 'STAMP'             ; * stamp it
           if viewflag then gosub viewonly ; return
           gosub savethat
           last += 1 ; here += 1 ; lnum += 1
           line = '* Last updated by ':name:' in account ':acct:' at ':timedate()
           gosub insert.line
           gosub reset.record
           gosub display.line
        case 1 ; gosub bad.command
     end case
     return

t:   begin case
        case comd eq 'T'                 ; * top
           here = 0
           gosub display.line
        case comd eq 'TC'                ; * text case (make line in)
           if viewflag then gosub viewonly ; return
           if rest eq '' then ccom = 'MCT' else ccom = 'QMCT'
           gosub conv.command
* Various ways to TRIM the line
        case comd eq 'TRIM' or comd = 'TRIMF' or comd = 'TRIMB'
           if viewflag then gosub viewonly ; return
           chng = 0 ; save = here ; savl = last
           if rest and comd eq 'TRIM' then
              seek = field(rest,dlim,1)
              if seek matches '3n' then seek = char(seek)
              mark = field(rest,dlim,2)
              mark = upcase(trim(mark))[1,1]
              if index('ABCDEFLRT',mark,1) else
                 crt 'Invalid TRIM argument - must be one of "ABCDEFLRT"'
                 gosub bad.comd
                 return
              end
           end else seek = ''
           show = shew ; dnum = 1
           if numb eq '' and rest matches '1N0N' then numb = rest
           gosub set.bounds
           for here = dawn to dusk
              gosub get.line
              begin case
                 case comd eq 'TRIM'
                    if seek eq ''
                       then temp = trim(line)
                       else temp = trim(line,seek,mark)
                 case comd eq 'TRIMF' ; temp = trimf(line)
                 case comd eq 'TRIMB' ; temp = trimb(line)
              end case
              gosub check.line
           next here
           here = dusk
           if chng then
              gosub reset.record
              crt chng:' lines changed - now at ':here
           end
        case comd eq 'TWIN' or comd eq 'TRIPLE' ; * sideways cloning of line
           if viewflag then gosub viewonly ; return
           if dlim ne '' then
              line = rest ; gosub parse.line ; join = line
           end
           if here and here le last else return
           chng = 0 ; save = here
           gosub set.bounds
           for here = dawn to dusk
              gosub get.line
              if comd eq 'TWIN'
                 then test = line:join:line
                 else test = line:join:line:join:line
              if test ne line then
                 chng += 1
                 memr(cell)<lnum> = test
              end
           next here
           if chng eq 0 then return
           temp = 'Split ':chng:' lines'
           if join ne '' then temp := ' and joined the parts with "':join:'"'
           crt temp
           here = save
           gosub savethat
           gosub reset.record
           gosub display.line
        case 1 ; gosub bad.command
     end case
     return

u:   begin case
        case comd eq 'U'                 ; * same as "-"
           if numb eq '' then numb = 1
           here = here - numb
           if here lt 0 then here = 0
           if here gt last then here = last
           gosub display.line
        case comd eq 'UC'                ; * upper case (make line in)
           if viewflag then gosub viewonly ; return
           if rest eq '' then ccom = 'MCU' else ccom = 'QMCU'
           gosub conv.command
        case comd eq 'UNLOAD' ; comd = 'SV' ; redo = true
           if viewflag then gosub viewonly ; return
        case 1 ; gosub bad.command
     end case
     return

v:   begin case
        case comd eq 'V'                 ; * version information
           crt (upcase(verb):' = ') 'R#20':help.def
$ifdef qm
           temp = trans('NEWVOC','$RELEASE',2,'X')
           if temp eq '' then
              temp = trans('VOC','$RELEASE',2,'X')
           end
           if temp eq '' then temp = '?'
           crt ('QM = ') 'R#20':temp
*>
           crt ('Licence = ') 'R#20':system(31)
*>
$endif
$ifdef unidata
           crt '    UniData version ':oconv('version','TVOC;X;;1')
$endif
$ifdef universe
           temp =  oconv('RELLEVEL','TNEWACC;X;;2')
           if temp eq '' then
              temp = oconv('RELLEVEL','TVOC;X;;2')
           end
           if temp eq '' then temp = 'not known'
           crt '   UniVerse version ':temp
        case comd eq 'VLIST'
           execute comi capturing disp
           stub = "Press return to continue showing VLIST 'T'op '-'back 'Q'uit"
           gosub show.disp
$endif
        case 1 ; gosub bad.command
     end case
     return

w:   begin case
        case comd eq 'W' or comd eq 'WHERE'      ; * what we are editing
           crt
           if viewflag
              then crt 'Viewing "':item:'" in file "':fnam:'"'
              else crt 'Editing "':item:'" in file "':fnam:'"'
           if idcnt gt 1 then crt ' [':id:'/':idcnt:']':
           crt
           if here gt last then here = last
           gosub display.line
        case comd eq 'WM'             ; * word marker display (change)
           if dlim ne '' then wordmark = dlim
           if wordmark eq '"'
              then crt 'WordMark is ':"'":wordmark:"'"
              else crt 'WordMark is ':'"':wordmark:'"'
        case 1 ; gosub bad.command
     end case
     return

x:   begin case
* Another way of quitting
        case comd eq 'X' ; comd = 'QK' ; redo = true
        case comd eq 'XEQ'               ; * execute a command
           if viewflag then gosub viewonly ; return
           if not(sec.xeq.flg) then
              crt 'XEQ disabled'
              comi = ''
              return
           end
           loop
              if rest ne '' then execute rest
              test = @(0,0)
              stub = '<RETURN> or command :'
              gosub get.rope; rest = rope
              if rest eq '' then
                 crt; crt 'Returned - ':
                 crt 'Editing "':item:'" in file "':fnam:'"'
              end
           until rest eq '' do
*>
              crt
*>
           repeat
           gosub display.line
        case comd eq 'XTD'               ; * hex to decimal
$ifdef universe
           crt xtd(rest)
$else
           crt iconv(rest,'MX')
$endif
        case 1 ; gosub bad.command
     end case
     return

y:   begin case
        case 1 ; gosub bad.command
     end case
     return

z:   begin case
        case 1 ; gosub bad.command
     end case
     return


set.bounds:
     if numb eq '' then numb = 1
     dawn = here
     if dawn lt 1 then dawn = 1
     dusk = dawn + numb - 1
     if dusk gt last then dusk = last
     numb = 0
     return

null.command:
     if dlim eq ':' then comd = 'XEQ' ; return
     if dlim eq '/' then
        comd = 'L'
        if numb eq '' then numb = huge
        return
     end
     if dlim eq '-' or dlim eq '+' then
        if rest eq '' then rest = 1
     end
     if numb ne '' then comd = numb ; return
     if dlim eq '' and rest eq '' then
        here += 1
        if here gt last then here = 1
        gosub display.line
        return
     end
     crt
     begin case
        case dlim eq '+' and rest matches '1N0N'
           here = here + rest
           if here gt last then here = last
           gosub display.line
        case dlim eq '-' and rest matches '1N0N'
           here = here - rest
           if here lt 0 then here = 0
           if here gt last then here = last
           gosub display.line
        case dlim eq '^'
           wild = not(wild)
           if wild
              then crt 'Expansion of non-printing characters enabled'
              else crt 'Expansion of non-printing characters disabled'
        case dlim eq '='
           crt 'UNIDATA prestore is not implemented - Use "PR"'
        case dlim eq '.'
           gosub dot.command
        case dlim eq '$'
           if not(sec.xcom.flg) then
              crt '$ external commands disabled'
              comi = ''
              return
           end
           save = comi ; comi = rest
           gosub parse.command
           comi = save
           comd = '$':comd
           xcom = oconv(comd,'TAE_XCOMS;X;2;2')
           begin case
              case xcom eq ''
                 crt 'Record "':comd:'" does not exist in "AE_XCOMS".'
              case xcom[len(xcom)-2,3] ne '_AE'
                 disp = ''
                 disp<-1> = "Line 2 of record '":rest:"' in file 'AE_XCOMS'"
                 disp<-1> = "contains '":xcom:"'."
                 disp<-1> = ''
                 disp<-1> = 'This line should contain the name of a Basic subroutine that'
                 disp<-1> = "has been written to implement the external command '":rest:"'."
                 disp<-1> = "The program name must end in '_AE'."
                 stub = 'Press RETURN to continue'
                 gosub show.disp
              case 1
                 that = this ; savl = here:am:last:beg:am:fin:am:krj
                 save = comi:am:comd:am:item:am:fnam
                 comd = comd:' ':rest
                 call @xcom(mat junk)
                 item = save<3>
                 fnam = save<4>
                 if here lt 0 then here = 0
                 gosub set.record
                 if here gt last then here = last
                 comd = ''
                 if that ne this then
                    crt save<2>:' - CHANGES HAVE BEEN MADE'
                    oops = that ; oopc = save<1>
                    oopl = savl<1> ; oopf = savl<2>
                    oopb = savl<3>:am:savl<4> ; oopk = field(savl,am,5,3)
                 end
                 that = ''
           end case
        case comi eq '?'
           disp = '         Login name = ':name:' (':term:', userno ':whom:')'
           disp<-1> = '            Account = ':acct
           if path ne '' then disp<-1> = '           VOC path = ':path
           disp<-1> = '              Level = ':levl
           disp<-1> = '          File name = ':fnam
           disp<-1> = '          Record id = ':item
           disp<-1> = '       Current line = ':here
           disp<-1> = '              Lines = ':last
           disp<-1> = '         Characters = ':len(this)
           if chan ne '' then
              disp<-1> = 'Last Change command = ':chan<1,1>
           end
           if cmat ne '' then
              temp = 'CM':cmat<1,3>:cmat<1,1>:cmat<1,2>
              disp<-1> = 'Last CMatch command = ':temp
           end
           if olda then
              temp = 'A':olda<1,2>:olda<1,1>
              disp<-1> = 'Last Append command = ':temp
           end
           if beg or fin then
              disp<-1> = '              Block = ':beg:'-':fin
           end
           if comdmark eq '"' then
              temp = "'":comdmark:"'"
           end else temp = '"':comdmark:'"'
           disp<-1> = 'Command Delimiter is ':temp:', '
           if nill eq '"' then
              temp = "'":nill:"'"
           end else temp = '"':nill:'"'
           disp := 'character to end inserting is ':temp:', '
           if wordmark eq '"' then
              temp = "'":wordmark:"'"
           end else temp = '"':wordmark:'"'
           disp := 'WordMark is ':temp
           disp<-1> = 'Page: window for PA/PL/PP is ':pwin:', length for P is ':plen
           if wild
              then disp<-1> = 'Expansion of non-printing characters enabled'
              else disp<-1> = 'Expansion of non-printing characters disabled'
           if caseflag then
              disp<-1> = 'CASE':' flag ON':', '
           end else disp<-1> = 'CASE':' flag OFF':', '
           if spaceflag then
              disp := 'SPACE':' flag ON':', '
           end else disp := 'SPACE':' flag OFF':', '
           if shew then
              disp := 'SHOW':' flag ON':', '
           end else disp := 'SHOW':' flag OFF':', '
           if blockflag then
              disp := 'BLOCK':' flag ON'
           end else disp := 'BLOCK':' flag OFF'
           if oopc ne '' then
              disp<-1> = 'OOPS will restore record prior to command: ':oopc
           end else
              disp<-1> = 'OOPS already executed, or no changes in effect.'
           end
           gosub show.disp
        case comi[1,2] eq '<>' ; gosub botharr
        case comi[1,1] eq '<' ; gosub leftarr
        case comi[1,1] eq '>' ; gosub rightarr
        case dlim eq '\' and rest[1,1] eq '\'    ;* clear the tag pointers
           krj = ''
           crt 'Tags cleared'
        case dlim eq '\'      ;* set a tag pointer
           locate(here,krj,2;posn) then
              crt 'There is already a Tag on line ':here
              return
           end
           if rest eq '' then rest = 'T':here
           rest = upcase(rest)
           locate(rest,krj,1;posn) then
              crt 'There is already a Tag labelled ':rest
              return
           end
           posn = krj<3>
           krj<1> = field(krj<1>,vm,1,posn)
           posn += 1
           krj<1,posn> = rest
           krj<2,posn> = here
           krj<3> = posn
           crt 'Setting Tag labelled ':rest:' at line ':here
        case (dlim eq '[' or dlim eq ']') and (rest[1,1] eq '[' or rest[1,1] eq ']')
           if krj<3> eq ''
              then disp = 'No Tag found'
              else disp = 'Tags at line-Labelled'
           posn = krj<3>
           xxno = dcount(krj<1>,vm)
           for xx = 1 to xxno
              disp<-1> = krj<2,xx> 'r#12'
              if xx eq posn then disp := '>' else disp := ' '
              disp := krj<1,xx>
           next xx
           convert badc to gudc in disp
           gosub show.disp
        case dlim eq '[' and rest eq ''
           posn = krj<3>-1
           if posn gt 0 then
              comd = krj<2,posn>
              krj<3> = posn
              crt 'Moved to line ':comd:' labelled ':krj<1
           end else comd = ''
           if comd eq '' then crt 'No Tag found'
        case dlim eq ']' and rest eq ''
           posn = krj<3>+1
           comd = krj<2,posn>
           if comd eq '' then
              crt 'No Tag found'
           end else
              krj<3> = posn
              crt 'Moved to line ':comd:' labelled ':krj<1
           end
        case dlim eq '[' or dlim eq ']'
           locate(upcase(rest),krj,1;posn) then comd = krj<2,posn> else comd = ''
           if comd ne '' then
              krj<3> = posn
              crt 'Moved to line ':comd:' labelled ':krj<1
              return
           end else crt 'No Tag found'
        case 1
           gosub bad.command
     end case
     return

parse.cols:
     good = true
     cols = field(rest,dlim,2)
     convert ',.' to '--' in cols
     rest = field(rest,dlim,1)
     colf = field(cols,'-',2)
     cols = field(cols,'-',1)
     if colf eq '' then colf = cols
     if cols ne '' then
        if not(cols matches '1N0N') or not(colf matches '1N0N') then
           crt 'Column specifications must be positive whole numbers.'
           gosub bad.comd
           good = false
           return
        end
     end
     if colf lt cols then
        crt 'Ending column # must exceed or equal starting column #.'
        gosub bad.comd
        good = false
        return
     end
     colf = colf - cols + 1
     return

parse.atts:
     convert '-' to dlim in rest
     if dlim eq '"' then temp = "'" else temp = '"'
     temp = '1N0N':temp:dlim:temp:'1N0N'
     if rest matches temp then
        numb = field(rest,dlim,2) - field(rest,dlim,1) + 1
        rest = field(rest,dlim,1)
     end
     return

change.command:
     if comd eq 'RA' then
        if numb eq '' then
           crt 'Last ':channumb:' changes (latest first)'
           for xx = 1 to channumb
$ifdef unidata
              crt fmt(xx,'2/0R'):' ':chan<1,xx>
$else
              crt fmt(xx,'R%2'):' ':chan<1,xx>
$endif
           next xx
           return
        end
        if numb gt channumb or numb lt 1 then
           crt 'Change must be in range 1-':channumb:'.'
           comi = ''
           return
        end
        comi = chan<1,numb>
        if comi eq '' then
           crt 'There is no change number ':numb:'.'
           return
        end
        chan = delete(chan,1,numb,0)
        chan = insert(chan,1,1,0,comi)
        gosub parse.command
        comi = 'RA'
     end
save = upcase(field(rest,dlim,3,2))
if save ne '' then rest = rest[1,col1()]
     gosub get.fromto
temp = save
     if comi eq '' then return
     chng = 0 ; save = here ; savl = last
     glob = index(temp,'G',1)
     show = shew or index(temp,'S',1)
convert dlim:'GS' to '-' in temp
rest = dlim:temp
gosub parse.cols
if not(good) then return
     if numb lt plen then show = true
     dnum = 1
     gosub set.bounds
     for here = dawn to dusk
        gosub get.line
        gosub change.line
        gosub check.line
     next here
     here = dusk
     if comi ne '' and upcase(comi) ne 'RA' then
        chan = insert(chan,1,1,0,comi)
        chan = delete(chan,1,channumb,0)
     end
     if chng then
        gosub reset.record
        if not(show) and dnum gt plen then
           crt chng:' lines changed - now at ':here
        end
     end
     return

get.fromto:
     if count(rest,dlim) gt 2 then
        crt 'Too many delimiters (3 max.).'
        comi = ''
        return
     end
     line = field(rest,dlim,1)
     gosub parse.line
     cfrom = line
     line = field(rest,dlim,2)
     gosub parse.line
     cto = line
     if cto eq '' and count(rest,dlim) lt 2 then
        crt 'Missing required TO field (for "CHANGE/FROM/TO").'
        comi = ''
        return
     end
     return

change.line:
     if cfrom eq '' then
        temp = cto:line
     end else
        if glob then
           temp = change(line,cfrom,cto)
        end else
           temp = index(line,cfrom,1)
           if temp then
              temp = line[1,temp-1]:cto:line[temp+len(cfrom),len(line)]
           end else temp = line
        end
     end
     return

conv.command:
     chng = 0 ; save = here ; savl = last
     show = shew or index(rest,'S',1) or index(rest,'s',1)
     dnum = 1
     if numb lt plen then show = true
     if numb eq '' and rest matches '1N0N' then numb = rest
     gosub set.bounds
     ctyp = ccom[1,1]
     begin case
* ICONV
        case ctyp eq '*' ; ccom = ccom[2,huge]
* Text conversion LC, TC, or UC command
        case ctyp eq 'Q' ; ccom = ccom[2,huge]
     end case
     for here = dawn to dusk
        gosub get.line
        begin case
           case ctyp eq '*'
              temp = iconv(line,ccom)
           case ctyp eq 'Q'
              temp = field(trim(line),' ',1)
              flag = false
              if temp ne 'REMOVE' then
                 if temp[1,3] eq 'REM' then flag = true
                 if temp[1,1] eq '*' then flag = true
                 if temp[1,1] eq '!' then flag = true
              end
              if flag then
                 temp = line
              end else
                 xxno = len(line)
                 temp = ''
                 flag = ''
                 for xx = 1 to xxno
                    bit = line[xx,1]
                    begin case
                       case bit eq flag ; flag = ''
                       case flag ne ''
                       case index(qt,bit,1) ; flag = bit
*>
                       case bit eq ';'
                          test = trim(line[xx+1,huge])[1,1]
                          if test eq '*' or test eq '!' then flag = am
*>
                       case 1 ; bit = oconv(bit,ccom)
                    end case
                    temp = temp:bit
                 next xx
              end
           case 1
              temp = oconv(line,ccom)
        end case
        if temp eq '' then temp = line
        gosub check.line
     next here
     here = dusk
     if chng then
        gosub reset.record
        if not(show) and dnum gt plen then
           crt chng:' lines changed - now at ':here
        end
     end
     return

dot.command:
     if trim(comi) eq '.' then comi = '.L1'
     save = comi
     comi = field(comi,dlim,2,huge)
     gosub parse.command
     begin case
        case comd eq 'A'                 ; * append to line
           if numb eq '' then numb = 1
           if numb gt dcount(stak,vm) then
              crt 'History command ':numb:' does not exist.'
           end else
              stak<1,numb> := rest
$ifdef unidata
              crt fmt(numb,'3/0R'):'. ':stak<1,numb>
$else
              crt fmt(numb,'R%3'):'. ':stak<1,numb>
$endif
           end
        case comd eq 'C'                 ; * change lines
           if numb eq '' then numb = 1
           if numb gt dcount(stak,vm) then
              crt 'History command ':numb:' does not exist.'
           end else
              gosub get.fromto
              if comi eq '' then comd = '' ; return
              glob = index(field(rest,dlim,3),'G',1)
              glob = glob + index(field(rest,dlim,3),'g',1)
              line = stak<1,numb>
              gosub change.line
              stak<1,numb> = temp
$ifdef unidata
              crt fmt(numb,'3/0R'):'. ':temp
$else
              crt fmt(numb,'R%3'):'. ':temp
$endif
           end
        case comd eq 'D'                 ; * delete lines
           if numb eq '' then numb = 1
           if numb gt dcount(stak,vm) then
              crt 'History command ':numb:' does not exist.'
           end else
              stak = delete(stak,1,numb,0)
              crt 'History #':numb:' DELETEd.'
           end
        case comd eq 'I'                 ; * insert a new line
           if numb eq '' then numb = 1
           if numb gt dcount(stak,vm) then
              crt 'History command ':numb:' does not exist.'
           end else
              if rest ne '' then
                 stak = insert(stak,1,numb,0,rest)
                 stak = delete(stak,1,staknumb,0)
$ifdef unidata
                 crt fmt(numb,'3/0R'):'. ':stak<1,numb>
$else
                 crt fmt(numb,'R%3'):'. ':stak<1,numb>
$endif
              end
           end
        case comd eq 'L'                 ; * list lines
           if numb eq '' then numb = plen
           if numb gt dcount(stak,vm) then numb = dcount(stak,vm)
           temp = rem(numb+1,plen)
           for xx = numb to 1 step -1
$ifdef unidata
              crt fmt(xx,'3/0R'):'. ':stak<1,xx>
$else
              crt fmt(xx,'R%3'):'. ':stak<1,xx>
$endif
              if xx gt 1 and rem(xx,plen) eq temp then
                 stub = 'Press return to continue, Q to quit'
                 rlen = 1
                 gosub get.rope; crt begn:ceol:
                 wait = trim(upcase(rope))[1,1]
                 if wait eq 'Q' then exit
              end
           next xx
        case comd eq 'R'                 ; * restore a line to latest
           if numb eq '' then numb = 1
           if numb le dcount(stak,vm) then
              temp = stak<1,numb>
              stak = insert(stak,1,1,0,temp)
              stak = delete(stak,1,staknumb,0)
           end
        case comd eq 'S'
           if numb eq '' then numb = 1
           if numb gt presnumb then
              crt numb:' is greater than pre-store limit of ':presnumb
              return
           end
           rest = trim(rest)
           dawn = field(rest,dlim,1) ; if dawn eq '' then dawn = 1
           dusk = field(rest,dlim,2) ; if dusk eq '' then dusk = 1
           if not(dawn matches '1N0N' and dusk matches '1N0N') then
              crt 'One of the values was not a number'
              return
           end
           if dawn gt dusk then temp = dawn ; dawn = dusk ; dusk = temp
           temp = ''
           for xx = dusk to dawn step -1
              temp<1,1,-1> = stak<1,xx>
           next xx
           pres<1,numb> = temp
        case comd eq 'U'                 ; * upcase line
           if numb eq '' then numb = 1
           if numb gt dcount(stak,vm)
              then crt 'History command ':numb:' does not exist.'
              else stak<1,numb> = upcase(stak<1,numb>)
        case comd eq 'UL'                ; * downcase line
           if numb eq '' then numb = 1
           if numb gt dcount(stak,vm)
              then crt 'History command ':numb:' does not exist.'
              else stak<1,numb> = downcase(stak<1,numb>)
        case comd eq 'UT'                ; * mixed case line
           if numb eq '' then numb = 1
           if numb gt dcount(stak,vm)
              then crt 'History command ':numb:' does not exist.'
              else stak<1,numb> = oconv(stak<1,numb>,'mct')
        case comd eq 'X'              ; * re-execute an editor command
           if numb eq '' then numb = 1
           if numb gt dcount(stak,vm) then
              crt 'History command ':numb:' does not exist.'
           end else
              salt = stak<1,numb>
              stak = delete(stak,1,numb,0)
           end
        case 1
           comi = save
           gosub bad.command
     end case
     comi = '' ; comd = ''
     return

viewonly:
     crt 'That command is not allowed in VIEW mode':bell
     comi = ''
     return

bad.command:
     crt 'Command not understood - try "H" for help.'
bad.comd:
     xxno = len(comi)
     temp = ''
     for xx = 1 to xxno
        bite = comi[xx,1]
        bite = seq(bite)
        if bite ge 127 or bite lt 32 then
$ifdef unidata
           bite = '^':fmt(bite,'3/0R')
$else
           bite = '^':fmt(bite,'R%3')
$endif
        end else bite = char(bite)
        temp = temp:bite
     next xx
     crt 'Command was: "':temp:'"'
     temp = ''
     comi = ''
     return

save.stuff:
     if not(sec.unload.flg) then
        crt 'Unload disabled'
        comi = ''
        return
     end
     keepquot = false
     gosub parse.rest
     odpt = '' ; ofpt = bite<1> ; oipt = bite<2>
     onam = ofpt
     if ofpt eq 'DICT' then
        odpt = ofpt ; ofpt = oipt ; oipt = bite<3>
        onam = onam:' ':ofpt
     end
     if oipt eq '' then
        if odpt ne '' then
           crt 'Cannot save to null item.'
           gosub bad.comd ; return
        end
        oipt = ofpt ; odpt = dprt ; ofpt = fprt ; onam = fnam
     end
     if dprt eq odpt and fprt eq ofpt then
        ofil = file
     end else
        open odpt, ofpt to ofil else
           crt 'Cannot open ':'"':fnam:'"'
           gosub bad.comd ; return
        end
     end
     if prepflag then
        sec.call2.type = 2
        sec.fn2 = ofpt
        sec.id2 = oipt
        sec.dict2.flg = (odpt = 'DICT')
        call @prepprog(mat security)
        if sec.stop.flg then stop
        if not(sec.ok2.flg) then
           gosub bad.comd ; return
        end
     end
     if source.control then
        dict.flag = odpt
        file.name = ofpt
        record.name = oipt
        record.data = this
        caller = '3'
        write.allowed = '1'
        updated = '0'
        call source.control(dict.flag,file.name,
        record.name,record.data,caller,write.allowed,updated)
        if write.allowed ne '1' then
           crt 'WRITE NOT ALLOWED'
           return
        end
     end
     readv test from ofil, oipt, 1 then
        stub = 'Record already exists. Overwrite (y/n)? '
        gosub get.answ
        if answ ne yes[1,1] then return
     end
     if comd eq 'PASTE' then
        write kept on ofil, oipt on error gosub writerr ; return
     end else
        write this on ofil, oipt on error gosub writerr ; return
     end
     crt 'Record "':oipt:'" saved in "':onam:'".'
     return

write.record:
     if rest ne '' then
        if comd eq 'FD' then
           crt '"FD" operates only on the current record & file.'
        end else
           crt '"FI" only for current record & file. Use SAVE.'
        end
        gosub bad.comd ; return
     end
     if source.control then
        dict.flag = dprt
        file.name = fprt
        record.name = item
        if comd eq 'FD' then record.data = '' else record.data = this
        caller = '3'
        write.allowed = '1'
        updated = '0'
        call source.control(dict.flag,file.name,
        record.name,record.data,caller,write.allowed,updated)
        if write.allowed ne '1' then
           crt 'WRITE NOT ALLOWED'
           return
        end
     end
     if not(lock) then
        crt 'Record lock has been released!   Write not allowed.'
        comi = ''
        return
     end
     if comd eq 'FD' then
        stub = '***** You are about to DELETE the record! OK? ':ny
        gosub get.answ
        if answ ne yes[1,1] then return

        delete file, item on error gosub writerr ; return

        crt 'Deleted "':item:'" from file "':fnam:'".'
     end else
        if comd eq 'SV' then

           writeu this on file, item on error gosub writerr ; return

           orig = this ; oops = '' ; oopc = '' ; oopl = '' ; oopf = ''
           oopb = '' ; oopk = ''
           crt 'Saved "':item:'" in "':fnam:'" - now at line ':here:'.'
           return
        end else

           write this on file, item on error gosub writerr ; return

           if orig eq this then
              crt 'Filed "':item:'" in file "':fnam:'" UNCHANGED.'
           end else crt 'Filed "':item:'" in file "':fnam:'".'
           oops = '' ; oopc = '' ; oopl = '' ; oopf = ''    ; * ewd
        end
     end
     stopsign = true
     if index(comd,'B',1) then
        temp = 'BASIC'
$ifdef qm
        if index(comd,'D',1) then temp<2> = ' DEBUGGING'
$endif
        gosub exec.that
     end
     if index(comd,'C',1) then
        temp = 'CATALOG'
        begin case
           case index(comd,'L',1) ; temp<2> = ' LOCAL'
*          case index(comd,'G',1) ; temp<2> = ' GLOBAL'
        end case
        gosub exec.that
     end
     if index(comd,'R',1) then temp = 'RUN' ; gosub exec.that
     return

edit.fields:
     if here lt 1 then here = 1
     gosub get.line ; temp = line
     convert vmrk to am in line
     ttid = whom:'_':levl:'_':vals:'.in.line#':here

     write line on acom, ttid on error gosub writerr ; return

     crt view:'ing ':vals:' as fields...':
     execute verb:' AE_COMS ':ttid:options
     test = @(0,0)
     crt 'Back ':view:'ing the record "':item:'" in file "':fnam:'"'
     read line from acom, ttid else line = ''
     delete acom, ttid
     return

reset.fields:
     convert am to vmrk in line
     if temp ne line then
        gosub savethat
        memr(cell)<lnum> = line
        gosub reset.record
     end
     return

get.load:
     temp = ''
     if trim(rest) eq '' then
        stub = 'Record name, or file name and record name >'
        gosub get.rope; rest = rope; crt
        if trim(rest) eq '' then temp = ''; return
     end
     keepquot = false
     gosub parse.rest
     onam = bite<1>
     onid = bite<2>
     if onam eq 'DICT' then
        onam = onam:' ':onid
        onid = bite<3>
        if onid eq '' then onid = item
     end
     if onid eq '' then onid = onam ; onam = ''
     if onid eq '' then return
     if onam eq '' then
        onam = fnam
        odpt = dprt
        ofpt = fprt
        ofil = file
     end else
        odpt = field(onam,' ',1)
        ofpt = field(onam,' ',2)
        if ofpt eq '' then ofpt = odpt ; odpt = ''
        open odpt, ofpt to ofil else
           crt 'Cannot open ':onam
           gosub bad.comd ; return
        end
     end
     read temp from ofil, onid else
        if dcount(bite,am) eq 1 then
           open onid to ofil then
              read temp from ofil, item then return
           end
        end
        crt 'Record "':onid:'" was not found on file "':onam:'".'
        gosub bad.comd ; return
     end
     return

changematch.command:
     patt = field(rest,dlim,1)
     gosub parse.pattern
     if not(good) then
        crt 'Pattern: character "':bit:'" is not allowed unless quoted.'
        comi = ''
        return
     end
     if comd eq 'CM' then cmat = dlim:vm:rest:vm:numb
     cto = field(rest,dlim,3,huge)
     line = cto ; gosub parse.line ; cto = line
     cfrom = upcase(field(rest,dlim,2))
     if cfrom eq '' then cfrom = 'L'
     if cfrom eq 'L' then mmat = dlim:vm:rest
     if numb eq '' and cto eq '' and (cfrom eq 'L' or cfrom eq 'N') then
        numb = last
        flag = true
     end else flag = false
     if len(cfrom) eq 1 and index('ADLNPR',cfrom,1) then
     end else
        gosub parse.cols
        if not(good) then return
        cfrom = ''
        colf = cols + colf - 1
     end
cm.del.entry:
     gosub set.bounds
     show = shew ; dnum = 1
     chng = 0 ; save = here ; savl = last ; dnum = 2
     test = ''
     for here = dawn to dusk
        gosub get.line
        if cfrom eq 'DE'
           then good = index(line,patt,1)
           else good = (line matches patt)
        if not(good) then
           if cfrom eq 'N' then
              numb += 1
              if show or numb lt plen then gosub display.line
              if flag then dusk = here
           end
           continue
        end
        numb += 1
        temp = line
        begin case
           case cfrom eq 'A'
              temp = line:cto
           case cfrom[1,1] eq 'D'
              if show or numb lt plen then crt fmt((here + chng),lfmt):'+ ':line
              test<-1> = here
           case cfrom eq 'L'
              gosub display.line

              if flag then dusk = here
           case cfrom eq 'P'
              temp = cto:line
           case cfrom eq 'R'
              temp = cto
           case cfrom eq 'N'
              numb -= 1
           case 1
              gosub parse.temp
        end case
        if not(index('DL',cfrom,1)) or cfrom eq '' then
           gosub check.line
        end
     next here
     if cfrom[1,1] eq 'D' and numb then
        gosub savethis
        for here = numb to 1 step -1
           temp = test<here>
           cell = int((temp-1)/cellsize) + 1
           coff = rem(temp,cellsize)
           if coff eq 0 then coff = cellsize
           del memr(cell)<coff>

           if beg eq temp then beg = 0
           if beg gt temp then beg -= 1
           if fin eq temp then fin = 0
           if fin gt temp then fin -= 1
           for xx = dcount(krj<1>,vm) to 1 step -1
              begin case
                 case krj<2,xx> gt temp ; krj<2,xx> -= 1
                 case krj<2,xx> eq temp
                    del krj<1,xx> ; del krj<2,xx> ; krj<3> -= 1
              end case
           next xx
        next here
        test = ''
        gosub reset.record
        here = dusk - numb
     end else
        here = dusk
     end
     if dawn ne dusk then
        if here lt last
           then crt 'At line ':here:'.'
           else crt 'Bottom at ':here:'.'
     end
     if not(numb) then
        if cfrom eq 'N' then
           crt 'No lines (in ':dawn:'-':dusk:') NOT matching pattern "':patt:'"'
        end else crt 'No lines (in ':dawn:'-':dusk:') matching pattern "':patt:'"'
     end else
        begin case
           case cfrom[1,1] eq 'D'
              crt 'Deleted ':numb:' lines matching "':patt:'"'
           case cfrom eq 'L'
              crt 'Found ':numb:' lines matching "':patt:'"'
           case cfrom eq 'N'
              crt 'Found ':numb:' lines NOT matching "':patt:'"'
        end case
     end

     if chng then
        gosub reset.record
        begin case
           case dawn eq dusk
              return
           case cfrom eq 'A'
              crt '"':cto:'" appended to ':
           case cfrom[1,1] eq 'D'
              crt 'Deleted ':
           case cfrom eq 'P'
              crt '"':cto:'" prefixed to ':
           case cfrom eq 'R'
              crt 'Replaced with "%", ':
           case cfrom eq 'L' or cfrom eq 'N'
           case cols eq colf
              crt 'Element ':cols:' changed to "':cto:'" in ':
           case cols
              crt 'Element ':cols:'-':colf:' changed to "':cto:'" in ':
        end case
        if chng eq 1
           then crt '1 line matching "':patt:'"'
           else crt chng:' lines matching "':patt:'"'
     end
     return

parse.pattern:
* bits<1> are the pattern pieces
*     <2> quote or 'p'attern flag
*     <3> partial patterns
     cntr = 1
     bits = ''
     flag = ''
     good = true
     first = true
     xxno = len(patt)
     gosub quote.pattern
     for xx = 1 to xxno
        bit = patt[xx,1]
        begin case
           case bit = flag
              flag = ''
              first = true
              cntr = cntr + 1
           case flag ne ''
              bits<1,cntr> = bits<1,cntr>:bit
           case index(qt,bit,1)
              bits<2,cntr> = bit
              flag = bit
           case first
              if not(bit matches '1n') then
                 good = false
                 return
              end
              first = false
              bits<2,cntr> = 'p'
              bits<1,cntr> = bits<1,cntr>:bit
              if bit eq '0' then bits<3,cntr> = patt[xx+2,xxno]
           case 1
              if not(index('AaNnXx',bit,1)) then
                 good = false
                 return
              end
              bits<1,cntr> = bits<1,cntr>:oconv(bit,'mcu')
              first = true
              cntr = cntr + 1
        end case
     next xx
     cntr = cntr - 1
     return


quote.pattern:
* Adds quotes to the pattern if required
* If they use any quotes at all, we don't do a thing
     if index(patt,'"',1) then return
     if index(patt,'\',1) then return
     if index(patt,"'",1) then return
     xx = 1
     temp = ''
     test = ''
     loop
        left = patt[xx,2]:'*'
        if index('0123456789',left[1,1],1) and index('AaNnXx',left[2,1],1) then
           if test ne '' then temp := "'":test:"'"
           temp := patt[xx,2]
           test = ''
           xx += 1
        end else test := patt[xx,1]
     until xx gt xxno do
        xx += 1
     repeat
     patt = temp
     if test ne '' then patt := "'":test:"'"
     return

parse.temp:
     temp = ''
     posn = 1
     xxno = len(line)
     for xx = 1 to cntr
        what = bits<1,xx>
        type = bits<2,xx>
        nmbr = what[1,1]
        begin case
           case xx gt colf
              temp<xx> = line[posn,xxno]
              xx = cntr
           case type ne 'p'
              temp<xx> = line[posn,len(what)]
              posn = posn + len(what)
           case xx = cntr
              temp<xx> = line[posn,xxno]
           case nmbr = '0'
* look to match the rest of the line with the partial pattern
              test = bits<3,xx>
              yy = posn
              bit = ''
              loop
              until yy gt xxno do
                 chit = line[yy,xxno]
              until chit matches test do
                 bit := chit[1,1]
                 yy += 1
              repeat
              posn += len(bit)
              temp<xx> = bit
           case 1
              bit = line[posn,nmbr]
              posn += len(bit)
              temp<xx> = bit
        end case
     next xx
     temp<cols> = cto
     for xx = cols+1 to colf
        temp = delete(temp,cols+1)
     next xx
     convert am to '' in temp
     return

get.lines:
     stub = '"Q"uit, or starting line > '
     pick = 1
     gosub get.rope; dawn = rope
     dawn = upcase(trim(dawn))
     if dawn eq '' then dawn = 'Q'
     if dawn[1,1] eq 'Q' then temp = false ; crt ; return
     if not(dawn matches '1N0N') then
        crt
        crt 'Nothing done - starting and ending lines must be numeric.'
        gosub bad.comd ; return
     end
     if dawn gt dcount(temp,am) then
        crt
        crt 'Nothing done - record does not have that many lines.'
        gosub bad.comd ; return
     end
     stub = stub:dawn:' ':', ending line > '
     pick = dcount(temp,am)
     gosub get.rope; dusk = rope
     dusk = upcase(trim(dusk))
     if dusk eq '' then dusk = 'Q'
     if dusk[1,1] eq 'Q' then temp = false ; crt ; return
     if not(dusk matches '1N0N') then
        crt
        crt 'Nothing done - starting and ending lines must be numeric.'
        gosub bad.comd ; return
     end
     if dusk gt dcount(temp,am) then
        dusk = dcount(temp,am)
        crt begn:'File is ':onam:': "Q"uit, or starting line > ':dawn:', ':dusk:
     end
     temp = field(temp,am,dawn,dusk-dawn+1)
     crt
     return

parse.bite:
     temp = ''
     loop
     while bite ne '' do
        bite = trimf(bite)
        xx = fold
        if count(bite[1,xx],' ') and trim(bite[xx+1,1]) ne '' then
           loop
           until trim(bite[xx,1]) eq '' do
              xx -=1
           repeat
           temp<-1> = bite[1,xx-1]
        end else
           temp<-1> = bite[1,xx]
        end
        bite = bite[xx+1,len(bite)]
     repeat
     return

show.help:
     crt
     if help eq '' then
        help = ''
        help<-1> = ' ':verb:' version ':help.def
        help<-1> = ' This program can be called with the following formats:'
        help<-1> = " ":verb:"               file and record id's are prompted for"
        help<-1> = " ":verb:" file          record id's are prompted for"
        help<-1> = " ":verb:" file id       ":view:" the record 'id' in 'file'"
        help<-1> = " ":verb:" file id id... ":view:" multiple records in 'file'"
        help<-1> = " ":verb:" file *        ":view:" all records in 'file'"
        help<-1> = " SELECT            may precede '":verb:" file' command"
        help<-1> = ' Special ASCII characters may be entered as:'
        help<-1> = '    ^nnn  where nnn is the decimal character code (like ^027)'
        help<-1> = '    ^     will enter a single UP ARROW character.'
        help<-1> = ' The following commands may be used in the Editor:'
        help<-1> = 'A#           - Do the last Append command again for # lines.'
        help<-1> = "A# any       - Append 'any' to # lines (default 1)."
        help<-1> = 'B            + Set the current line pointer to the BOTTOM line.'
        help<-1> = "B# any       - BREAK # lines (default 1) after string 'any' into two lines."
        help<-1> = 'BC# posn     = Break Column - Break # lines (default 1) after posn into two.'
        help<-1> = 'BCD# posn    = Break Column and Discard the second part.'
        help<-1> = 'BCK# posn    = Break Column and Keep only the second part.'
        help<-1> = 'BCR# posn    = Break Column and Reverse the order of the two parts.'
        help<-1> = 'BCS# posn    = Break Column and Swap the parts about the character at posn.'
        help<-1> = "BD# any      - BREAK after string 'any' and Discard the second part."
        help<-1> = "BK# any      - BREAK after string 'any' and Keep only the second part."
        help<-1> = "BR# any      - BREAK after string 'any' and Reverse the order of the two parts."
        help<-1> = "BS# any      - BREAK after string 'any' and Swap the parts about 'any'."
        help<-1> = 'BLEACH ON/OFF# Switch colourisation flag.'
        help<-1> = 'BLOCK ON/OFF + Switch block operation confirmation flag.'
        help<-1> = '               If neither ON nor OFF is used, then toggle BLOCK flag.'
        help<-1> = "C            - Do the last 'CHANGE' command again."
        help<-1> = 'C///         - CHANGE one or more lines. Full formats is:'
        help<-1> = '               C[#]/from/to/[G][S]'
        help<-1> = '               where    / - is any delimiter character.'
        help<-1> = '                        # - number of lines to CHANGE (default 1).'
        help<-1> = '                     from - is the character string to be replaced.'
        help<-1> = '                       to - is the character string to substitute.'
        help<-1> = "                        G - 'G'lobal flag - CHANGE all instances in line."
        help<-1> = "                        S - 'S'how flag - display all changes made."
        help<-1> = 'CASE ON/OFF  + Switch CASE flag for FL, FLA, L, LA, LN, LNA commands.'
        help<-1> = '               If neither ON nor OFF is used, then toggle CASE flag.'
        help<-1> = '               OFF means that the commands are not case sensitive.'
        help<-1> = "CAT          - Synonym for 'J'oin."
        help<-1> = 'CD           + Show or change the command delimiter.'
        help<-1> = '               (this is the input for a blank line).'
        help<-1> = 'CLEAR        # Clear the kept buffer.'
        help<-1> = 'CM///        - ChangeMatch one or more lines. Full formats is:'
        help<-1> = '               CM[#]/pattern[/range/to]'
        help<-1> = '               where      / - is any delimiter character.'
        help<-1> = '                          # - number of lines to CHANGE (default 1).'
        help<-1> = '                    pattern - is the pattern match for the line.'
        help<-1> = '                         to - is the character string to substitute/add.'
        help<-1> = '                      range - Can be numeric, which field(s) to change,'
        help<-1> = "                           or 'A'ppend or 'P'refix to the line,"
        help<-1> = "                           or 'D'elete, 'R'eplace, 'L'ocate (default) the line."
        help<-1> = "               EG 'CM/6X' will scan to the line matching '6X'."
        help<-1> = "               Also; 'N'ot - locate the next non-matching line."
        help<-1> = 'COL          + Display relative COLUMN POSITIONS on the Terminal.'
        help<-1> = 'COPY         # Copy the predefined block to the kept buffer.'
        help<-1> = 'COPY#        # Copy the next # lines to the kept buffer.'
        help<-1> = 'COPYx/y      # Copy x lines starting at line y to the kept buffer.'
        help<-1> = 'COPY/x/y     # Copy lines from x to y inclusive to the kept buffer.'
        help<-1> = "COUNT#/any   + Count of 'any' in next # lines (default 1)."
        help<-1> = "CRT xxxx     - Inserts a line CRT 'xxxx = ':xxxx"
        help<-1> = '               Use double quote or backslash as delimiter to change quotes.'
        help<-1> = 'CUT          = Move the predefined block to the kept buffer.'
        help<-1> = 'CUT#         = Move the next # lines to the kept buffer.'
        help<-1> = 'CUTx/y       = Move x lines starting at line y to kept buffer.'
        help<-1> = 'CUT/x/y      = Move lines from x to y inclusive to kept buffer.'
        help<-1> = 'D            + Display the current line.'
        help<-1> = 'DE           - DELETE the current line.'
        help<-1> = "DE#          - DELETE '#' lines (default 1)."
        help<-1> = "DE#/any      - DELETE as above, but only if the line contains 'any'."
        help<-1> = "DISPLAY xxxx - Inserts a line DISPLAY 'xxxx = ':xxxx"
        help<-1> = '               Just like CRT, handy to distinguish debug code.'
        help<-1> = 'DROP         - Remove the predefined block.'
        help<-1> = "DTX any      + Convert decimal string 'any' to hexadecimal and display it."
        help<-1> = 'DUP          - DUPLICATE the current line.'
        help<-1> = "DUP#         - DUPLICATE the current line '#' times."
        help<-1> = 'EC           + Edit a called subroutine in this file.'
        help<-1> = 'ECS          # Edit the command stack.'
        help<-1> = 'EF#          + Edit fields delimited by CHAR(#) as lines.'
        help<-1> = 'EI           + Edit the included code.'
        help<-1> = 'EIT          + Edit I-type (not just a split on semi-colon).'
        help<-1> = 'EK           # Edit the kept buffer.'
        help<-1> = 'EPR          + Edit the prestored commands.'
        help<-1> = 'EPR#         # Edit prestored commqnd #.'
        help<-1> = 'ESS          # Edit Search Stack.'
        help<-1> = 'ESV          + Edit subvalues as 1ines.'
        help<-1> = 'ET           # Edit the line tabs.'
        help<-1> = 'EV           + Edit multivalues as lines.'
        help<-1> = 'EW           + Edit words as lines.'
        help<-1> = 'EXIT (EX)    + QUIT - EXIT the program.'
        help<-1> = 'EXITK (EXK)  + QUITKill - EXIT the program, abandon any active SELECT list.'
        help<-1> = 'FD           - DELETE the entire record from the file.'
        help<-1> = 'FI           - FILE the record. You can also process it.'
        help<-1> = '               FIB = BASIC, FIC = CATALOG, FIR = RUN'
        help<-1> = '               You can have up to three processes (EG. FIBCR).'
        help<-1> = '               You can modify BASIC with D for DEBUGGING (EG. FIBD).'
        help<-1> = '               You can modify CATALOG with L for LOCAL (EG. FICL).'
        help<-1> = 'FILE         - Synonym for SAVE.'
        help<-1> = 'FL           + Find the next Label.'
        help<-1> = "FL any       + Find the label 'any' or matching pattern 'any'."
        help<-1> = 'FL#          + Find (display) the labels in next # lines.'
        help<-1> = 'FLA          + Find label above this line.'
        help<-1> = 'FM           + Find Matching logic by position.'
        help<-1> = 'FMA          + Find Matching logic by position above this line.'
        help<-1> = 'FOLD/length  - Split current line (on blanks if possible) to fit width.'
        help<-1> = 'FORMAT (FOR) + FORMAT a BASIC program to show logical structure by'
        help<-1> = '               indenting. This has the following keywords;'
        help<-1> = "               '-Mx' = Set margin to x."
        help<-1> = "               '-Iy' = Set Indentation to y."
        help<-1> = "               '-A' = Align comments with code."
        help<-1> = "               '-N' = No CASE indentation."
        help<-1> = "               '-C' = Compress - same as '-M0 -I1 -A -N'."
        help<-1> = "G#           + GO TO line '#' ('G' is optional)."
        help<-1> = 'HELP (H)     + Prompt user to display HELP information on the Terminal.'
        help<-1> = "HELP any     + Display HELP information on Terminal for 'any'."
        help<-1> = 'HELP NEW     + Display HELP information on new features.'
        help<-1> = 'HEX          + Displays the current line in hexadecimal.'
        help<-1> = 'I            - INSERT new lines AFTER the current line. Prompt for'
        help<-1> = '               successive lines. INPUT until NULL input. An INPUT line'
        help<-1> = '               of a single space will store an empty line.'
        help<-1> = "I any        - INSERT (INPUT) the line 'any' AFTER the current line."
        help<-1> = "I#/any       - INSERT # lines of 'any' AFTER the current line."
        help<-1> = "IC any       - IConv the line using the conversion 'any'."
        help<-1> = 'IN command   - Insert the results of the command AFTER the current line.'
        help<-1> = '               It is not a good idea to use a command requiring input.'
        help<-1> = "J#/any       - Join next '#' lines (default 1), separated by 'any'."
        help<-1> = "KEEP name    # Copy the record 'name' into the kept buffer."
        help<-1> = "               line #'s will be prompted."
        help<-1> = "KEEP f name  # Copy the record 'name' from file 'f' into the kept buffer,"
        help<-1> = "               line #'s will be prompted."
        help<-1> = 'KEEPA        # KEEPAll - KEEP without line # prompting.'
        help<-1> = 'KEPT (K)     # Display the kept buffer.'
        help<-1> = "L            + Repeat the last 'LOCATE' command (L, LA, LN, or LNA)."
        help<-1> = "L any        + LOCATE the next line that contains the string 'any'."
        help<-1> = "L#/any/10-20 + LOCATE in next # lines those with 'any' in columns 10 to 20."
        help<-1> = "               So 'L#' effectively lists # lines."
        help<-1> = "L#!any!THING # LOCATE in next # lines those with 'any' OR 'THING'."
        help<-1> = "L#&any&THING # LOCATE in next # lines those with 'any' AND 'THING'."
        help<-1> = '               ! and & work this way for LA, LN, and LNA commands too.'
        help<-1> = 'LA#/any/1-20 + Locate lines above this one (reverse order).'
        help<-1> = "LC#          - Change '#' lines to lower case (default 1)."
        help<-1> = 'LC# any        Comments and quoted strings are unchanged.'
        help<-1> = "LL#/length   + Show lines 'length' or longer (null '#' is a search)."
        help<-1> = "LN#/any/1-20 + LOCATE NOT - line without 'any' in columns 10 to 20."
        help<-1> = "LNA#/an/1-20 + LOCATE line above this without 'an' in columns 1 to 20."
        help<-1> = "LOAD name    - LOAD the record 'name' from the current FILE,"
        help<-1> = "               line #'s will be prompted."
        help<-1> = "LOAD f name  - LOAD the record 'name' from file 'f',"
        help<-1> = "               line #'s will be prompted."
        help<-1> = 'LOADA        - LOADAll - LOAD without line # prompting.'
        help<-1> = 'LD           - Synonym for LOAD.'
        help<-1> = 'LDA          - Synonym for LOADA.'
        help<-1> = 'M pattern    + Search for a line matching the pattern.'
        help<-1> = 'MACRO#       + Toggle macro recording into #th PRESTORE command.'
        help<-1> = 'MERGE (ME)   = Merge a copy of the predefined block after the current line.'
        help<-1> = 'MERGEx/y     = Merge x lines starting at line y.'
        help<-1> = 'MERGE/x/y    = Merge lines starting at x to line y inclusive.'
        help<-1> = 'MOVE (MV)    - Move the predefined block to after the current line.'
        help<-1> = 'MOVEx/y      = Move the x lines starting at line y.'
        help<-1> = 'MOVE/x/y     = Move the lines starting at x to line y inclusive.'
        help<-1> = 'NUM          + Toggle the line numbering.'
        help<-1> = "NULL/symbol  + Change the null line input for 'I' to 'symbol'."
        help<-1> = "OC# any      - OConv '#' lines using the conversion 'any'."
        help<-1> = 'OOPS         - RESTORE the record to the condition prior to last change.'
        help<-1> = "OUT#         # Outline (labels, gotos, gosubs) for '#' lines (default all)."
        help<-1> = 'OUT# CEPS      Show Calls, Executes, Performs, and caSe also (* for all).'
        help<-1> = 'P            + PRINT on Terminal one page worth of lines.'
        help<-1> = "P#           + PRINT on Terminal '#' lines starting with the current line."
        help<-1> = "PA#          + PRINT the current line and the prior '#' lines,"
        help<-1> = '               do not change the current line pointer.'
        help<-1> = "PASTE        = Paste the kept buffer after the current line'."
        help<-1> = "PASTE name   = Copy the kept buffer under the specified 'name'."
        help<-1> = "PASTE f name = Copy the kept buffer as record 'name' in file 'f'."
        help<-1> = 'PE           + Page Edit mode.'
        help<-1> = "PL#          + PRINT the current line and the next '#' lines,"
        help<-1> = '               do not change the current line pointer.'
        help<-1> = "PP#          + PAGE.PRINT a window of '#' lines around the current line,"
        help<-1> = '               do not change the current line pointer.'
        help<-1> = 'PR           + Show the PRESTORE commands.'
        help<-1> = 'PR#          + Run the #th PRESTORE command.'
        help<-1> = 'PR#/any      + Change the #th PRESTORE command.'
        help<-1> = '               where / - is any delimiter character which will also be'
        help<-1> = '                         used as the command separator.'
        help<-1> = 'QUIT (Q)     + QUIT - EXIT the program.'
        help<-1> = 'QUITK (QK)   + QuitKill - EXIT the program, abandon any active SELECT list.'
        help<-1> = 'R            - Replace the line with prompted for text.'
        help<-1> = "R any        - REPLACE this line with 'any'."
        help<-1> = "R#/any       - REPLACE # lines with 'any'."
        help<-1> = 'R///         - CHANGE one or more lines (same as C/// command).'
        help<-1> = "RA           = Show last 20 'CHANGE' commands."
        help<-1> = "RA#          = Repeat #th 'CHANGE' command."
        help<-1> = 'RELEASE      + RELEASE the update record LOCK for this file.'
        help<-1> = "S            - Show last 20 'LOCATE' commands."
        help<-1> = "S#           - Repeat #th 'LOCATE' command."
        help<-1> = 'SAVE         - SAVE a copy of this record under the original name.'
        help<-1> = "SAVE name    - SAVE a copy of this record under the specified 'name'."
        help<-1> = "SAVE f name  - SAVE a copy of this record as record 'name' in file 'f'."
        help<-1> = 'SEQ#////     - Build a sequence. Format is:'
        help<-1> = '               SEQ#/from/base/inc/cols'
        help<-1> = '               where    / - is any delimiter character.'
        help<-1> = '                        # - number of lines to CHANGE (default 1).'
        help<-1> = '                     from - is the character string to be replaced.'
        help<-1> = '                     base - is the start number (defaults to 1).'
        help<-1> = '                      inc - is the increment (defaults to 1).'
        help<-1> = '                     cols - restricts the change to a column range.'
        help<-1> = "SHOW ON/OFF  + toggle overriding 'S'how flag for 'C' command."
        help<-1> = "               OFF won't show more than a page of changes."
        help<-1> = '               If neither ON nor OFF is used, then toggle SHOW flag.'
        help<-1> = "SORT seq     - Sort the predefined block (seq defaults to 'AL')."
        help<-1> = "SORTU seq    # Sort unique predefined block ('AL' default seq)."
        help<-1> = 'SPACE ON/OFF + Switch SPACE flag for L, LA, LN, LNA commands.'
        help<-1> = '               If neither ON nor OFF is used, then toggle SPACE flag.'
        help<-1> = '               OFF means that the commands will ignore spaces and tabs.'
        help<-1> = 'SPOOL        + SPOOL entire record to PRINTER.'
        help<-1> = "SPOOL#       + SPOOL '#' lines to the PRINTER."
        help<-1> = 'SPOOLHELP    + SPOOL the HELP listing to the default PRINTER.'
        help<-1> = "SPOUT#       # SPOO outline (labels, gotos, gosubs) for '#' lines (default all)."
        help<-1> = 'SPOUT# CEPS    Show Calls, Executes, Performs, and caSe also (* for all).'
        help<-1> = "STAMP        - INSERT a 'last modified' stamp into the record, which"
        help<-1> = "               begins with a '*' (for BASIC 'comment'), and contains the"
        help<-1> = '               account name, LOGIN name (if different from account name),'
        help<-1> = '               date and time. Used to mark when record was last changed.'
        help<-1> = 'SV           - Synonym for SAVE.'
        help<-1> = 'T            + Set current line to the TOP (before first line).'
        help<-1> = "TC#          - Change '#' lines to text or mixed case (default 1)."
        help<-1> = 'TC# any        Comments and quoted strings are unchanged.'
        help<-1> = "TRIM#        - TRIM '#' lines (default 1)."
        help<-1> = "TRIM# a b    = TRIM '#' lines of character 'a' with argument 'b'."
        help<-1> = "TRIMB#       - TRIMB '#' lines (default 1)."
        help<-1> = "TRIMF#       - TRIMF '#' lines (default 1)."
        help<-1> = "TRIPLE#/any  = Copy '#' lines (default 1) into three clones, joined by 'any'."
        help<-1> = "TWIN#/any    = Copy '#' lines (default 1) into two clones, joined by 'any'."
        help<-1> = "UC#          - Change '#' lines to upper case (default 1)."
        help<-1> = 'UC# any        Comments and quoted strings are unchanged.'
        help<-1> = 'UNLOAD       - Synonym for SAVE.'
        help<-1> = 'V            + Version information.'
        help<-1> = 'WHERE (W)    + Show the item and file being ':view:'ed.'
        help<-1> = 'WM           + Show or change the word marker.'
        help<-1> = 'X            + QuitKill - EXIT the program, abandon any active SELECT list.'
        help<-1> = 'XEQ          - The XEQ command allows a user to execute any legal PERFORM'
        help<-1> = '                command from within the program. Upon completion of the'
        help<-1> = '                command, control will be returned back to the program.'
        help<-1> = "XTD any      + Convert hexadecimal string 'any' to decimal and display it."
        help<-1> = '/any         + Same as L99999999/any - NOTE you are left at the bottom.'
        help<-1> = ".A# any      + APPEND 'any' to command '#' (default 1)."
        help<-1> = ".C#///       + CHANGE stack command '#' (default 1). Syntax is like 'C'."
        help<-1> = ".D#          + DELETE stack command '#' (default 1)."
        help<-1> = ".I# any      + INSERT 'any' at stack position '#' (default 1)."
        help<-1> = ".L#          + LIST on the Terminal the last '#' stack commands."
        help<-1> = ".R#          + RECALL (copy) command '#' to stack position 1."
        help<-1> = ".S# n m      + SAVE stack n to m as prestore '#' (all default to 1)."
        help<-1> = ".U#          # UPCASE stack command '#' (default 1)."
        help<-1> = ".UL#         # lower case stack command '#' (default 1)."
        help<-1> = ".UT#         # text case stack command '#' (default 1)."
        help<-1> = ".X#          + EXECUTE stack command '#' (default 1)."
        help<-1> = '               The command will be put in stack position 1.'
        help<-1> = "+#           + Advance current line pointer by '#' lines (default 1)."
        help<-1> = "-#           + Back up current line pointer by '#' lines (default 1)."
        help<-1> = "\            # Set a line tag with default label like 'T#'."
        help<-1> = "\any         # Set a line tag labelled 'any'."
        help<-1> = '\\           # Clear the line tags.'
        help<-1> = "]any         # Go to the line tag 'any'."
        help<-1> = "[any         # Go to the line tag 'any'."
        help<-1> = ']            # Go to the next line tag.'
        help<-1> = '[            # Go to the previous line tag.'
        help<-1> = ']]           # Display the line tags.'
        help<-1> = '[[           # Display the line tags.'
        help<-1> = "#            + Set the current line pointer to the '#' line."
        help<-1> = '<#           + Sets the starting block pointer to # (current line default).'
        help<-1> = '>#           + Sets the ending block pointer to # (current line default).'
        help<-1> = '<># #        + Set both block pointers at the same time.'
        help<-1> = '^            + Switch UP ARROW on/off to show non-printing characters as'
        help<-1> = '               ^nnn where nnn is the decimal equivalent of ASCII code.'
        help<-1> = '?            + Show various parameters - easier to use than explain.'
     end
     rest = trim(upcase(rest))
     if rest eq am then
        hard = true
        rest = ''
     end else hard = false
     disp = ''
     stub = ''
     if rest eq '' then flag = true else flag = false
     if rest eq 'NEW' then disp = 'New Features':am
     good = false
     xxno = dcount(help,am)
     for xx = 1 to xxno
        temp = help<xx>
        bite = temp[1,len(rest)]
        bit = temp[14,1]
        if index('-+=#',bit,1)
           then temp = temp[1,13]:'-':temp[15,huge]
           else bit = ''

        if bit ne '' then
           flag = false
           if bit eq '#' and rest eq 'NEW'               then flag = true
           if (bit eq '#' or bit eq '+') and rest eq ''  then flag = true
           if not(viewflag) then
              if bit eq 'eq' and rest eq 'NEW'            then flag = true
              if bit eq '=' or bit eq '-' and rest eq '' then flag = true
           end
        end
        if not(flag) and rest ne '' and bite eq rest then
           if bit eq '#' or bit eq '+' then flag = true
           if not(viewflag) then
              if bit eq '=' or bit eq '-' then flag = true
           end
        end
        if flag then
           disp<-1> = temp
           good = true
        end
     next xx

     if not(good) then
        disp := am
        disp<-1> = 'No explanation of "':rest:'" is available.'
        disp<-1> = 'For a list of words that have explanations, type "HELP".'
        disp := am
     end
     if hard then gosub print.disp else gosub show.disp
     return

show.disp:
     write disp on voc,'&DISP.':whom
     if stub eq '' then stub = 'Press return to continue showing explanation, Q to quit'
     xxno = dcount(disp,am)
     pg = 0
     for xx = 1 to xxno
        pg += 1
        if pg ge system(3) then
           loop
              rlen = 1
              gosub get.rope; answ = rope
              crt begn:ceol:
              answ = trim(upcase(answ))[1,1]
           until index('QT-',answ,1) do
           repeat
           if answ eq 'Q' then return
           if answ eq 'T' then xx = 1
           if answ eq '-' then
              xx -= 2*(system(3)-1)
              if xx lt 1 then xx = 1
           end
           pg = 1
        end
        crt disp<xx>
     next xx
     disp = ''
     return

print.disp:
     printer on
     heading upcase(verb):" help file    ":timedate():"'LL'"
     xxno = dcount(disp,am)
     for xx = 1 to xxno
        print disp<xx>
     next xx
     printer close
     return

get.page.comd:
     gosub get.keyc
do.page.comd:
     locate(keyc,keys;cpos) then cpos = acts<cpos> else cpos = 0
     begin case
        case cpos eq uarr ;* up key
           if here le 1 then crt bell:; return
           gosub check.page
           here -= 1
           if prow le 1 then
              ptop = ptop - botl
              if ptop lt 1 then ptop = 1
              gosub disp.page
           end
           gosub get.line; temp = line
        case cpos eq darr ;* down key
           if here ge last then crt bell:; return
           gosub check.page
           here += 1
           if prow ge botl then
              ptop = ptop + botl
              if ptop ge last then ptop = last - botl + 1
              if ptop le 1 then ptop = 1
              gosub display.page
           end
           gosub get.line; temp = line
        case cpos eq larr ;* left key
           if pchr le 1 then crt bell:; return
           pchr -= 1
           if pchr lt ppos then
              gosub check.page
              gosub disp.page
           end
        case cpos eq rarr ;* right key
           pchr += 1
           if pchr-ppos ge span then
              gosub check.page
              gosub disp.page
           end
        case cpos eq upag ;* page up key
           gosub check.page
           ptop -= botl
           if ptop lt 1 then ptop = 1
           here -= botl
           if here lt 1 then here = 1
           pchr = 1
           gosub get.line; temp = line
           gosub disp.page
        case cpos eq dpag ;* page down key
           gosub check.page
           ptop = ptop + botl
           if ptop ge last then ptop = last - botl + 1
           here = here + botl
           if here gt last then here = last
           pchr = 1
           gosub get.line; temp = line
           gosub disp.page
        case cpos eq lpag ;* start of line key
           pchr = 1
           if pchr lt ppos then gosub check.page; gosub disp.page
        case cpos eq rpag ;* end of line key
           pchr = len(temp)+1
           if pchr lt ppos then gosub check.page; gosub disp.page
           if pchr-ppos ge span then
              gosub check.page
              gosub disp.page
           end
        case cpos eq tpag ;* top page key
           gosub check.page
           here = 1
           ptop = 1
           pchr = 1
           gosub disp.page
           gosub get.line; temp = line
        case cpos eq bpag ;* bottom page key
           gosub check.page
           here = last
           ptop = last - botl + 1
           gosub get.line
           pchr = len(line)+1
           gosub disp.page
           gosub get.line; temp = line
        case cpos eq escp ;* escape key
           if this ne that then
              crt @(0,botl):ceol:revb:'ABANDONING CHANGES':revf
           end
           this = that
           here = savl<1>
           gosub set.record
           mode = 'LINE'
        case cpos eq phlp ;* help key
           gosub check.page
           gosub page.help
        case cpos eq zoom ;* Go to line key
           crt bott:
           stub = 'Go to line :'
           stay = pchr
           gosub get.rope; numb = trim(rope)
           pchr = stay
           crt bott:revb:'Press <F1> for help.':revf:
           if not(numb matches '1N0N') then numb = here
           if numb gt last then numb = last
           if numb eq here then return
           gosub check.page
           here = numb
           ptop = here
           pchr = 1
           gosub disp.page
           gosub get.line; temp = line
        case cpos eq skey ;* forward search
           crt bott:
           stub = 'Search: ':'> '
           stay = pchr
           pick = lastfind; gosub get.rope; lastfind = rope
           pchr = stay
           crt bott:revb:'Press <F1> for help.':revf:
           if lastfind eq '' then return
* is it in this line or the rest of the item?
           test = index(temp[pchr+1,huge],lastfind,1)
           save = here
           gosub check.page
           if test then
              test += pchr
           end else
              dawn = here+1
              dusk = last
              for here = dawn to dusk until test
                 gosub get.line
                 test = index(line,lastfind,1)
                 if test then save = here
              next here
           end
           if test then
              if save lt ptop or save ge (ptop+botl) then ptop = save
              here = save
              pchr = test
              gosub disp.page
           end else here = save
           gosub get.line; temp = line
        case cpos eq rkey ;* reverse search
           crt bott:
           stub = 'Search: ':'< '
           stay = pchr
           pick = lastfind; gosub get.rope; lastfind = rope
           pchr = stay
           crt bott:revb:'Press <F1> for help.':revf:
           if lastfind eq '' then return
* is it in this line before the cursor position or the rest of the item above?
           test = index(temp[1,pchr-1],lastfind,1)
           save = here
           gosub check.page
           if not(test) then
              dawn = 1
              dusk = here-1
              for here = dusk to dawn step -1 until test
                 gosub get.line
                 what = count(line,lastfind)
                 if what then
                    test = index(line,lastfind,what)
                    save = here
                 end
              next here
           end
           if test then
              if save lt ptop or save ge (ptop+botl) then ptop = save
              here = save
              pchr = test
              gosub disp.page
           end else here = save
           gosub get.line; temp = line

        case not(sec.write.flg)
           crt bell:
        case cpos eq delc ;* delete character key
           if temp eq '' then return
           if pchr eq 1 then
              temp = temp[2,len(temp)]
           end else
              temp = temp[1,pchr-1]:temp[pchr+1,len(temp)]
           end
           crap = temp[pchr,span-pcol]
           convert badc to gudc in crap
           crt @(pcol,prow):ceol:crap:
        case cpos eq dell ;* delete line key
           del this<here>
           gosub set.record
           gosub disp.page
           gosub get.line; temp = line
        case cpos eq delr ;* delete to end of line key
           if pchr gt len(temp) then
              if here ge last then crt bell:; return
              line = fmt(temp,'l#':pchr-1):this<here+1>
              del this<here>
              this<here> = line
              gosub set.record
              gosub disp.page
              gosub get.line; temp = line
           end else
              temp = temp[1,pchr-1]
              this<here> = temp
              memr(cell)<lnum> = temp
              line = temp
              crt @(pcol,prow):ceol:
           end
        case cpos eq back ;* backspace key
           if pchr eq 1 then crt bell:; return
           pchr -= 1
           temp = temp[1,pchr-1]:temp[pchr+1,len(temp)]
           if pchr lt ppos then
              gosub check.page
              gosub disp.page
           end else
              pcol = rem(pchr-1,span)
              crt @(pcol,prow):ceol:
              crap = temp[pchr,span-pcol]
              convert badc to gudc in crap
              crt crap:
           end
        case cpos eq carr ;* carriage return key
           if pchr eq 1 then
              line = ''
           end else
              line = temp[1,pchr-1]
              temp = temp[pchr,len(temp)]
           end
           if lnum eq 0 then lnum = 1
           memr(cell)<lnum> = line
           last += 1
           lnum += 1
           line = temp
           gosub insert.line
           gosub reset.record
           here += 1
           pchr = 1
           if prow ge botl then
              ptop = ptop + botl
              if ptop ge last then ptop = last - botl + 1
              if ptop le 1 then ptop = 1
              gosub display.page
           end else gosub disp.page
           gosub get.line; temp = line
        case cpos eq togg ;* toggle mode key
           if mode<2> eq 'Ins' then
              mode<2> = 'Rep'
           end else mode<2> = 'Ins'
        case cpos eq writ ;* write away data key
           gosub check.page
           mode = 'LINE'
        case seq(keyc) lt 28 or seq(keyc) gt 127 or len(keyc) gt 1
           crt bell:
        case seq(keyc) eq 30 or seq(keyc) eq 31
           crt bell:
        case 1
           if seq(keyc) eq 28 then keyc = char(252)
           if seq(keyc) eq 29 then keyc = char(253)
           if pchr and len(temp) lt (pchr-1) then
              temp = temp:str(' ',pchr)
              temp = temp[1,pchr-1]
           end
           if mode<2> eq 'Ins'
              then offset = pchr
              else offset = pchr+1
           if pchr eq 1
              then temp = keyc:temp[offset,len(temp)]
              else temp = temp[1,pchr-1]:keyc:temp[offset,len(temp)]
           if mode<2> eq 'Ins' then
              crt @(pcol,prow):ceol:
              crap = temp[pchr,span-pcol]
           end else crap = keyc
           convert badc to gudc in crap
           crt @(pcol,prow):crap:
           pchr += 1
           if pchr-ppos ge span then
              gosub check.page
              gosub disp.page
           end
     end case
     return

check.page:
     if '*':temp ne '*':line then
        memr(cell)<lnum> = temp
        gosub reset.record
     end
     return

page.help:
     gosub clear.page
     if pagehelp eq '' then
        if sec.write.flg then
           pagehelp = ''
           pagehelp<-1> = '                              Page editing help'
           pagehelp<-1> = ''
           pagehelp<-1> = ' Cursor movement keys                    Line movement keys'
           pagehelp<-1> = ''
           pagehelp<-1> = '       UP = <UP arrow> or ^Z               LEFT END = <Home> or ^A'
           pagehelp<-1> = '     DOWN = <DOWN arrow> or ^J            RIGHT END = <End> or ^E'
           pagehelp<-1> = '     LEFT = <LEFT arrow> or ^U           GO TO LINE = ^G'
           pagehelp<-1> = '    RIGHT = <RIGHT arrow> or ^F                 (prompts for desired line)'
           pagehelp<-1> = ''
           pagehelp<-1> = ' Page movement keys                      Deleting keys'
           pagehelp<-1> = ''
           pagehelp<-1> = ' PREVIOUS = <Page Up> or ^P                DELETE CHAR = <Delete> or ^D'
           pagehelp<-1> = '     NEXT = <Page Down> or ^N              DELETE LINE = <Ctrl-Home> or ^X'
           pagehelp<-1> = '      TOP = <Ctrl-Page Up> or ^T         DELETE TO EOL = <Ctrl-End> or ^K or ^R'
           pagehelp<-1> = '   BOTTOM = <Ctrl-Page Down> or ^B'
           pagehelp<-1> = '                                         <Ctrl-]> = Value Mark'
           pagehelp<-1> = ' <Backspace> is destructive              <Ctrl-\> = Sub-value Mark'
           pagehelp<-1> = ' <Enter> splits the line'
           pagehelp<-1> = ' <Insert> or <Tab> toggles between the insert and overwrite modes'
           pagehelp<-1> = ''
           pagehelp<-1> = ' <F2> or ^W Returns to line editor mode WITH changes'
           pagehelp<-1> = ' <Esc> or ^Q Returns without changes'
        end else
           pagehelp = ''
           pagehelp<-1> = '                              Page viewing help'
           pagehelp<-1> = ''
           pagehelp<-1> = ' Cursor movement keys                    Line movement keys'
           pagehelp<-1> = ''
           pagehelp<-1> = '       UP = <UP arrow> or ^Z               LEFT END = <Home> or ^A'
           pagehelp<-1> = '     DOWN = <DOWN arrow> or ^J            RIGHT END = <End> or ^E'
           pagehelp<-1> = '     LEFT = <LEFT arrow> or ^U           GO TO LINE = ^G'
           pagehelp<-1> = '    RIGHT = <RIGHT arrow> or ^F                 (prompts for desired line)'
           pagehelp<-1> = ''
           pagehelp<-1> = ' Page movement keys           '
           pagehelp<-1> = ''
           pagehelp<-1> = ' PREVIOUS = <Page Up> or ^P   '
           pagehelp<-1> = '     NEXT = <Page Down> or ^N '
           pagehelp<-1> = '      TOP = <Ctrl-Page Up> or ^T'
           pagehelp<-1> = '   BOTTOM = <Ctrl-Page Down> or ^B'
           pagehelp<-1> = ''
           pagehelp<-1> = ''
           pagehelp<-1> = ' <Esc> or ^Q Returns without changes'
        end
     end
     disp = pagehelp ; stub = ''
     gosub show.disp
     crt bott:
     stub = 'Press RETURN to continue'
     gosub get.rope
     gosub display.page
     return

get.line:
     line = ''
     if here eq 0 then
        cell = 1
        lnum = 0
        return
     end
     if here gt last then return
     cell = int((here-1)/cellsize) + 1
     coff = rem(here,cellsize)
     if ooff and ocel eq cell and ooff eq coff - 1 then
        lnum = ooff ; ooff = coff
     end else
        tlin = memr(cell)
        lnum = 0 ; ocel = cell ; ooff = coff
     end
     loop
        remove bite from tlin setting dlim
        line = line:bite
     while dlim do
        if dlim eq 2 then
           lnum += 1
           if lnum eq coff then exit
           line = ''
        end else
           line = line:char(256-dlim)
        end
     repeat
     if not(dlim) then lnum += 1
     return

delete.lines:
     chng = 0
     if dawn gt dusk then
        crt 'No deletion possible - ':dawn:' > ':dusk:'.'
        return
     end
     gosub savethat
     chng = dusk - dawn + 1
     begin case
        case dawn le 1 and dusk ge last
           krj = ''
           this = ''
           beg = 0
           fin = 0
        case dusk ge last
           temp = index(this,am,dawn-1)
           this = this[1,temp-1]
           if beg gt dawn then beg = 0
           if fin gt dawn then fin = 0
           for xx = dcount(krj<1>,vm) to 1 step -1
              if krj<2,xx> gt dawn then
                 del krj<1,xx> ; del krj<2,xx> ; krj<3> -= 1
              end
           next xx
        case dawn eq 1
           temp = index(this,am,dusk)
           this = this[temp+1,len(this)]
           if beg le dusk then beg = 0 else beg = beg - chng
           if fin le dusk then fin = 0 else fin = fin - chng
           for xx = dcount(krj<1>,vm) to 1 step -1
              if krj<2,xx> le dusk then
                 del krj<1,xx> ; del krj<2,xx> ; krj<3> -= 1
              end
           next xx
        case 1
           temp = index(this,am,dawn-1)
           temp<2> = index(this,am,dusk)
           this = this[1,temp<1>]:this[temp<2>+1,len(this)]
           if beg ge dawn and beg le dusk then beg = 0 else
              if beg gt dusk then beg -= chng
           end
           if fin ge dawn and fin le dusk then fin = 0 else
              if fin gt dusk then fin -= chng
           end
           for xx = dcount(krj<1>,vm) to 1 step -1
              begin case
                 case krj<2,xx> gt dusk ; krj<2,xx> -= chng
                 case krj<2,xx> ge dawn
                    del krj<1,xx> ; del krj<2,xx> ; krj<3> -= 1
              end case
           next xx
     end case
     begin case
        case here gt dusk
           here = here - dusk + dawn - 1
        case here gt dawn
           here = dawn
     end case
     gosub set.record
     return

check.line:
     if '*':temp ne '*':line then
        if not(chng) then gosub savethis
        chng += 1
        memr(cell)<lnum> = temp
        if shew or dnum lt plen then gosub display.line
     end
     return

insert.line:
     if here le beg then beg += 1
     if here le fin then fin += 1
     yyno = dcount(krj<1>,vm)
     for yy = 1 to yyno
        if krj<2,yy> gt here then krj<2,yy> += 1
     next yy
     memr(cell) = insert(memr(cell),lnum,0,0,line)
     if lfmt and len(last) gt 3 and len(last) ne llen then gosub get.lfmt
     return

display.line:
     begin case
        case last eq 0
           here = 0
           gosub get.line
           crt begn:'Top of empty record.'
        case here eq 0
           gosub get.line
           crt 'Top.'
        case here gt last
           crt 'Bottom.'
        case 1
           gosub get.line
           if wild then
              xxno = len(line)
              temp = ''
              for xx = 1 to xxno
                 bite = line[xx,1]
                 bite = seq(bite)
                 if bite ge 127 or bite lt 32 then
$ifdef unidata
                    bite = '^':fmt(bite,'3/0R')
$else
                    bite = '^':fmt(bite,'R%3')
$endif
                 end else bite = char(bite)
                 temp = temp:bite
              next xx
              line = temp
           end else convert badc to gudc in line
           crt begn:ceol:
           if lfmt then
              blk = ': '
              if here eq beg then blk = '< '
              if here eq fin then blk = '> '
              if here eq beg and here eq fin then blk = '<>'
              if lfmt then crt (here lfmt):blk:
           end

           if bleach then
              crt line
           end else
              if here ge beg and here le fin
                 then showline = @(-13):@(-5):line:@(-6):@(-14)
*                 else call SORT.LINE(showline,line,1,len(line),lastfind,caseflag)
                 else setoff = 1 ; width = len(line) ; gosub getshowline
              crt showline
           end

           dnum += 1
           if here eq last then crt 'Bottom at line ':last:'.'
     end case
     return

clear.page:
     for xx = system(3)-1 to 0 step -1
        crt @(00,xx):ceol:
     next xx
     return

display.page:
     crt clpg
disp.page:
     if pchr lt 1 then pchr = 1
     gosub clear.page
     gosub get.lfmt
     crt bott:revb:'Press <F1> for help.':revf:
     crt @(0,0):ceol:revb:
     if viewflag
        then crt 'Viewing "':item:'" in file "':fnam:'"':
        else crt 'Editing "':item:'" in file "':fnam:'"':
     crt revf:
     if idcnt gt 1 then crt ' <':id:'/':idcnt:'> ':
     crt
     ppos = int((pchr-1)/span)
     ppos = span*ppos+1
     save = here:am:lnum:am:cell:am:line
     for xx = 1 to botl
        here = ptop + xx - 1
        gosub get.line
        if bleach then
           disp = line[ppos,span]
           convert badc to gudc in disp
        end else
           convert badc to gudc in line
           disp = line
           if here ge beg and here le fin
              then showline = @(-13):@(-5):disp[ppos,span]:@(-6):@(-14)
*              else call SORT.LINE(showline,disp,ppos,span,lastfind,caseflag)
              else setoff = ppos ; width = span ; gosub getshowline
           disp = showline
        end
        crt @(0,xx):disp:
     next xx
     here = save<1>; lnum = save<2>; cell = save<3>; line = save<4>
     return

savethis:
     oops = this ; oopc = comi ; oopl = save ; oopf = savl
     oopb = beg:am:fin ; oopk = krj
*     if level eq 0 then write oops on voc, '&LED.':whom
     return
savethat:
     oops = this ; oopc = comi ; oopl = here ; oopf = last
     oopb = beg:am:fin ; oopk = krj
*     if level eq 0 then write oops on voc, '&LED.':whom
     return

reset.record:
     matbuild this from memr using am
set.record:
     gosub parse.record
     gosub get.line
     if len(last) gt 3 and len(last) ne llen then gosub get.lfmt
     return

parse.record:
     this = this
     ocel = '' ; ooff = ''
     last = dcount(this,am)
     if last eq 0 then
        dim memr(1)
        mat memr = ''
        cell = 1 ; lnum = 0
        return
     end
     numcells = int((last-1)/cellsize)+1
     dim memr(numcells)
     mat memr = ''
     cell = 1
     lnum = 0
     for cell = 1 to numcells
        memr(cell) = field(this,@am,(cell-1)*cellsize+1,cellsize)
     next cell
!    line = ''
!    loop
!       remove bite from this setting mark
!       line = line:bite
!       begin case
!          case mark eq 0
!             if line ne '' then
!                line = line[1,len(line)]
!             end
!             memr(cell) = line
!          case mark eq 2
!             lnum += 1
!             if lnum ge cellsize then
!                memr(cell) = line
!                line = ''
!                cell += 1
!                lnum = 0
!             end else
!                line = line:char(256-mark)
!             end
!          case 1
!             line = line:char(256-mark)
!       end case
!    while mark do
!    repeat
     cell = 1
     lnum = 0
     return

locked.record:
     stub = 'Record is currently locked by another user. Try again? ':ny:' '
     gosub get.rope; answ = rope
     answ = upcase(trim(answ))
     if answ eq 'PASSWORD' then
        lock = false
        read this from file, item then goto carry.on
     end
     if answ[1,1] eq yes[1,1] then goto edit.item
     return

exec.that:
     temp = temp<1>:' ':fnam:' ':item:temp<2>
     if fileinfo(file,3) ne '4' then
        crt 'Cannot ':temp:' - must be type 1 or 19'
        return
     end
     execute temp
     test = @(0,0)
     return

parse.rest:
     bite = ''
     flag = ''
     posn = 1
     xxno = len(rest)
     for xx = 1 to xxno
        bit = rest[xx,1]
        if flag eq '' then
           if bit eq ' ' then
              if bite<posn> ne '' then posn += 1
           end else
              if index(qt,bit,1) then
                 flag = bit
                 if keepquot then bite<posn> = bite<posn>:bit
              end else
                 if bit eq '(' then
                    flag = ')'
                    if bite<posn> ne '' then posn += 1
                    bite<posn> = '('
                 end else bite<posn> = bite<posn>:bit
              end
           end
        end else
           if bit ne flag then
              bite<posn> = bite<posn>:bit
           end else
              if keepquot or bit eq ')' then bite<posn> = bite<posn>:bit
              posn += 1
              flag = ''
           end
        end
     next xx
     return

split.itype:
     bite = ''
     flag = ''
     posn = 1
     xxno = len(line)
     for xx = 1 to xxno
        bit = line[xx,1]
        if flag eq '' then
           if bit eq ';' then
              posn += 1
           end else
              if index(qt,bit,1) then flag = bit
              if bit eq '(' then flag = ')'
              bite<posn> = bite<posn>:bit
           end
        end else
           if bit eq flag[1,1] then flag = flag[2,huge]
           if bit eq '(' and flag[1,1] eq ')' then flag := ')'
           bite<posn> = bite<posn>:bit
        end
     next xx
     return

get.lfmt:
* set up the line format
     llen = len(last)
     if llen lt 3 then llen = 3
$ifdef unidata
     lfmt = llen:'/0R'
$else
     lfmt = 'R%':llen
     if index(item,'_IType.',1) then lfmt = llen:'@R'
$endif
     prmt = '*':str('-',llen-1)
     return

leftarr: *
     numb = oconv(trim(comi[2,len(comi)]),'MCN')
     if numb eq '' then numb = here
     if numb gt last then numb = ''
     if numb ge 0 then
        crt 'Block starts at line ':numb:
        beg = numb
        if fin and beg gt fin then
           crt '; End moved from ':fin:' to ':beg
           fin = beg
           mov = 1
        end else
           if fin then mov = fin - beg + 1 else mov = last - beg
           crt ' (':mov:' lines)'
        end
        if numb eq here then gosub display.line
     end else crt 'Cannot mark line ':numb
     return

rightarr: *
     numb = oconv(trim(comi[2,len(comi)]),'MCN')
     if numb eq '' then numb = here
     if numb gt last then numb = ''
     if numb ge 0 then
        crt 'Block ends at line ':numb:
        fin = numb
        if beg gt fin then
           crt '; Start moved from ':beg:' to ':fin
           beg = fin
           mov = 1
        end else
           if beg then mov = fin - beg + 1 else mov = fin
           crt ' (':mov:' lines)'
        end
        if numb eq here then gosub display.line
     end else crt 'Cannot mark line ':numb
     return

botharr: *
     numb = trim(comi[3,len(comi)])
     begin case
        case numb matches '1N0N'
           numb = numb:am:numb
        case numb matches '1N0N"-"1N0N'
           numb = field(numb,'-',1):am:field(numb,'-',2)
        case numb matches '1N0N" "1N0N'
           numb = field(numb,' ',1):am:field(numb,' ',2)
        case numb eq ''
           numb = here:am:here
        case 1
           numb = ''
     end case
     if numb<2> gt last then numb<2> = last
     if numb<1> gt last then numb = ''
     if numb<2> lt numb<1> then
        crt 'Block starts at ':numb<1>:' and ends at ':numb<2>:' => ':
        numb = ''
     end
     if numb ne '' then
        beg = numb<1>
        fin = numb<2>
        if beg eq fin then
           crt 'Block starts and ends at line ':beg
        end else
           crt 'Block starts at ':beg:' and ends at ':fin
        end
        if here eq beg or here eq fin then
           gosub display.line
        end
     end else crt 'Cannot mark Block'
     return

recalc.posn:
     begin case
        case posn lt rest and posn le oopl
        case posn lt rest and posn gt oopl
           posn += numb
        case posn ge rest and posn lt (rest+numb)
           posn += (here+1-rest)
        case posn ge (rest+numb) and posn le oopl
           posn -= numb
     end case
     return

find.label:
     temp = field(trimf(line),' ',1)
     temp = trim(temp,char(13),'B')
     chit = temp[1,1]
     begin case
        case chit eq '*' or chit eq '!' ; temp = ''
        case chit matches '1N' or chit eq '.'
           temp = field(temp,'*',1)
           temp = field(temp,'!',1)
           temp = field(temp,':',1)
           test = convert('.0123456789','',temp)
           if test ne '' then temp = ''
        case chit matches '1A' and index(temp,':',1)
           temp = field(temp,':',1)
           test = oconv(oconv(temp,'MC/A'),'MC/N')
           test = convert('._%$','',test)
           if test ne '' then temp = ''
        case 1
           temp = ''   
     end case
     return

get.answ:
     loop
*>
        rlen = 1
*>
        gosub get.rope
        answ = upcase(trim(rope)[1,1])
     until answ eq yes[1,1] or answ eq no[1,1] do
        crt 'Please answer Y or N'
     repeat
     crt
     return

writerr:
$ifdef qm
     if status() eq er$trigger then
        crt 'Data validation error: ': @trigger.return.code
     end else
        crt 'Write error ': status():' (o/s error %2) - Data not saved. Original data will be lost if you leave the editor now.'
     end
$else
     crt 'Write error ': status():' (o/s error %2) - Data not saved. Original data will be lost if you leave the editor now.'
$endif
     return

indenter:
     marg = fr(1) ;* the margin
     dent = fr(2) ;* the indentation
     supp = fr(6) ;* flag - suppress '!' output
     astx = not(fr(9)) ;* flag - keep '*' comments on page edge
     suit = not(fr(10)) ;* flag - indent 'CASE' statements
     dead = 'ACDGHIJKMPQSVXYZ'
     push = 'LOOP\WHILE\UNTIL\FOR\THEN\ELSE\BEGIN\LOCKED\ON~ERROR'
     pull = 'UNTIL\WHILE\REPEAT\NEXT\END'
     convert '\' to am in push
     convert '\' to am in pull
     skip = ';:" (' : "'"
     marx = '\"' : "'"
     bang = false
     xxno = dcount(this,am)
     dim part(100)
     matparse part from this, am
     this = ''
     bite = ''
     first = true
     for xx = 1 to xxno
        there = rem(xx,100)
        if not(there) then
           if first then this = bite else this = this:am:bite
           first = false
           bite = ''
           thisline = part(100)
           temp = part(0)
           matparse part from temp, am
           if not(supp) then bang = true; crt '!':
        end else thisline = part(there)
        if trim(thisline) eq '' then
           if first then bite<there> = '' else bite<there+1> = ''
           continue
        end
        note = false
        wcnt = 0; more = 0; less = 0
        mark = ''; tags = ''; lastword = ''
        zz = 1
        thisline = trimf(thisline)
        if thisline matches '1N0N"*"0X' then
           temp = field(thisline,'*',1)
           thisline = temp:' ':thisline[col2(),len(thisline)]
        end
        thatline = upcase(thisline)
        thatline = change(thatline, 'ON ERROR', 'ON~ERROR')
        left = field(thatline,' ',1)
        if num(left) or left[len(left),1] eq ':' then
           if not(index(left,'=',1)) then tags = thisline[1,len(left)]
        end
        if tags gt '' then
           thisline = trimf(thisline[col2()+1,len(thisline)])
           thatline = trimf(thatline[col2()+1,len(thatline)])
        end
        zzno = len(thisline)
        loop
        while zz lt zzno and not(note) do
           loop
              thisun = thatline[zz,1]
              begin case
                 case mark eq '' and index(marx,thisun,1)
                    mark = thisun
                 case mark ne ''
                    if thisun eq mark then mark = ''
                 case wcnt and thisun eq ';'
                    that = field(trim(thatline[zz+1,zzno]),' ',1)
                    if that[1,3] eq 'REM' then that = ''
                    if that[1,1] eq '*' then that = ''
                    if that[1,1] eq '!' then that = ''
                    if that eq '' then zz = zzno
                 case wcnt
                 case thisun eq '!' or thisun eq '$'
                    note = true; zz = zzno
                 case thisun eq '*'
                    if astx then note = true
                    zz = zzno
                 case field(thatline,' ',1) eq 'REM'
                    note = true; zz = zzno
              end case
           while (index(skip,thisun,1) or mark) and zz lt zzno do
              zz += 1
           repeat
           left = zz
           loop
              thisun = thatline[zz,1]
           until index(skip,thisun,1) or zz gt zzno do
              zz += 1
           repeat
           word = thatline[left,zz-left]
           wcnt += 1
           if wcnt ne 1 then
              if word eq 'WHILE' or word eq 'UNTIL' then word = ' '
              if word eq 'NEXT' or word eq 'REPEAT' then
                 word = ' '
                 more -= dent
              end
              if lastword eq 'LOCKED' then more -= dent
           end else
              if word eq 'LOCKED' or word eq 'THEN' then
                 if word eq trim(thatline) then less += dent
              end
           end
           if word eq 'CASE' then
              if lastword ne 'BEGIN' and lastword ne 'END' then
                 more += dent
                 less += dent
              end
              if suit and lastword eq 'BEGIN' then more += dent
              if suit and lastword eq 'END' then less += dent
           end
           if not(index(dead,word[1,1],1)) then
              locate(word,pull;rubbish) then less += dent
              test = word ne 'THEN' & word ne 'ELSE' & word ne 'ON~ERROR'
              that = trim(thisline[zz,zzno])
              if that[1,1] eq ';' then
                 that = trim(that[2,zzno])[1,3]
                 if that[1,3] eq 'REM' then that = ''
                 if that[1,1] eq '*' then that = ''
                 if that[1,1] eq '!' then that = ''
              end
              if test or that eq '' then
                 locate(word,push;rubbish) then
                    more += dent
                 end
              end
              if word eq 'THEN' or word eq 'LOCKED' then
                 if that eq '' and lastword eq '' then less -= dent
              end
              if that ne '' and lastword eq '' then
                 if word eq 'THEN' or word eq 'ELSE' then
                    more -= dent
                    less -= dent
                 end
                 if word eq 'LOCKED' and trim(that)[1,1] ne '='
                    then more -= dent ; less -= dent
              end
           end
           lastword = word
        repeat
        marg -= less
        if tags eq '' then pict = '' else pict = 'L#':(len(tags)+1)
        if marg gt len(tags) then pict = 'L#':marg
        if thisline eq '!' or thisline eq '$' then note = true
        if thatline eq 'REM' then note = true
        if astx and thisline eq '*' then note = true
        if note then
           if tags eq '' then pict = '' else pict = 'L#':(len(tags)+1)
        end
        thisline = trimb(fmt(tags,pict):thisline)
        if first then
           bite<there> = thisline
        end else bite<there+1> = thisline
        marg += more
     next xx
     if bang then crt
     if bite ne '' then
        if first then this = bite else this = this:am:bite
     end
     that = ''
     return

get.rope:
* If the terminal doesn't support screen addressing, do simple input
     if not(editpage) then
        crt begn:stub:
*>        input rope:
        if rlen then
           input rope,rlen:
           rlen = 0
        end else input rope:
*>
        return
     end
*
* The following variables are used
*
*    BARE - what you are going to reveal (the displayed part)
*    CRAM - insert mode on (vs overwrite mode)
*    PCOL - display position
*    STEM - the prefix part of the display line
*    ICON - a picture of what you last displayed
*    PANS - the PAN increment
*    PPOS - the PAN origin
*    WIDE - the PAN width
*    PULP - SEQ(COMI) - what you get from a key press
*    PURE - untouched, a virgin
*    POSN - the stack position
*    PCHR - text position

     pans = int(span/2)
     posn = 0
     rope = pick; pick = ''

     loop
        if heap then
           stem = prmt:': '
           if posn then stem = '*':fmt(posn, "3'0'R"):stem[5,huge]
        end else stem = '*':stub
        wide = span - len(stem) - 1
        pans = int(wide/2)
        ppos = 1
        pchr = 1
        cram = true
        icon = space(span)
        crt begn : ceol :
        pure = true
!&&&
!   if nick and trim(rope) = '' then pchr = len(rope)+1 ; pure = false
!&&&

        loop

           begin case
*>            case pchr lt ppos ; ppos -= pans
              case pchr lt ppos
                 loop while pchr lt ppos ; ppos -= pans ; repeat
              case pchr ge (ppos+wide)
                 loop while pchr ge(ppos+wide) ; ppos += pans ; repeat
*>            case pchr ge (ppos+wide) ; ppos += pans
           end case

           bare = stem : rope[ppos, wide]
           pcol = 0
           if icon ne bare then
              yyno = 0
              for yy = 1 to span until yyno
                 if bare[yy,1] ne icon[yy,1] then yyno = yy
              next yy
              crt @(yyno-1):bare[yyno,span-yyno]:ceol:@(pcol):
              icon = bare[1,span]
           end

           pcol = len(stem) + pchr - ppos
           crt @(pcol) :

           gosub get.keyc
           locate(keyc,keys;cpos) then cpos = acts<cpos> else cpos = 0

           pulp = seq(keyc)
           if pulp lt 32 or pulp gt 128 then keyc = ''
           if pure then
              if cpos eq 0 and keyc ne '' then
                 rope = ''
                 pchr = 1
              end
              crt @(0):
              if cram then crt '>': else crt '#':
              crt @(pcol):
              pure = false
           end

           begin case

              case heap and (cpos = uarr or cpos = upag)
                 if posn lt dcount(stak, vm) then
                    posn += 1
                    rope = stak<1,posn>
                 end
                 exit

              case heap and (cpos = darr or cpos = dpag)
                 if posn gt 1 then
                    posn -= 1
                    rope = stak<1,posn>
                 end else
                    posn = 0
                    rope = ''
                 end
                 exit

              case heap and cpos = skey
                 if rope eq '' then
                    if look<1> eq '' then continue
                    comi = look<1,1>
                    gosub parse.command
                    rope = 'L':dlim:rest
                 end else rope = 'L/':rope
                 if rope eq look<1> then rope = 'L'
                 return

              case heap and cpos = rkey
                 if rope eq '' then
                    if look<1> eq '' then continue
                    comi = look<1,1>
                    gosub parse.command
                    rope = 'LA':dlim:rest
                 end else rope = 'LA/':rope
                 if rope eq look<1> then rope = 'L'
                 return

              case heap and cpos = writ and pulp ne 23
                 rope = 'PE'
                 return

              case heap and cpos = phlp
                 stub = '' ; heap = false ; rest = ''
                 gosub show.help
                 rope = 'D'
                 return

              case cpos = larr
                 if pchr gt 1 then pchr -= 1

              case cpos = rarr
                 if pchr le len(rope) then pchr += 1

              case cpos = lpag
                 pchr = 1

              case cpos = rpag
                 pchr = len(rope) + 1

              case cpos = escp
                 posn = 0
                 rope = ''
                 exit

              case cpos = delc
                 rope = rope[1, pchr-1] : rope[pchr+1, huge]

              case cpos = delr
                 rope = rope[1, pchr-1]

              case cpos = back
                 if pchr gt 1 then
                    pchr -= 1
                    rope = rope[1, pchr-1] : rope[pchr+1, huge]
                 end

              case cpos = carr
                 if heap then
                    crt begn : ceol : ':' : rope:
                    if posn then
                       if rope eq stak<1,posn> then del stak<1,posn>
                    end
                 end
                 return

              case cpos = togg
                 cram = not(cram)
                 crt @(0):
                 if cram then crt '>': else crt '#':
                 crt @(pcol):

              case pulp eq 23         ;* ctrl-w
                 dope = downcase(rope)
                 mope = upcase(rope)
                 tope = oconv(rope,'MCT')
                 begin case
                    case rope eq tope and dope eq tope ; rope = mope
                    case rope eq tope ; rope = dope
                    case rope eq mope ; rope = tope
                    case 1 ; rope = mope
                 end case

              case pulp ge 32 and pulp lt 128
                 if cram then
                    rope = rope[1, pchr-1] : keyc : rope[pchr, huge]
                 end else
                    if pchr le len(rope)
                       then rope[pchr, 1] = keyc
                       else rope := keyc
                 end
                 pchr += 1

              case 1
                 crt bell:
           end case
           if rlen and len(rope) ge rlen then
              crt keyc:
              rlen = 0
              return
           end
        repeat
     repeat

     return

get.keyc:
$ifdef qm
     if not(index(upcase(system(7)),'EEEPC',1)) then
        keyc = keycode()
        return
     end
$endif
     common /keys$krj/ termtype,eseq,keyd,base,full
     if not(assigned(termtype)) then termtype = ''
     if termtype ne oconv(system(7),'MCU') then gosub setup.keys

     keyc = ''
     loop
$ifdef unidata
        mine = in()
$else
        mine = keyin()
$endif
        locate(mine,base;post) then gosub get.rest
        locate(mine,eseq;cmd)
           then keyc = char(keyd<cmd>)
           else if len(mine) eq 1 then keyc = mine
     while keyc eq '' do repeat
     return
get.rest:
     loop
$ifdef unidata
        a = system(12)
        loop
        until system(12) ge (a+5) do
        repeat
$else
        nap 5
$endif
        input your,-1
     while your do
$ifdef unidata
        mine := in()
$else
        mine := upcase(keyin())
$endif
        locate(mine,full,post;your) then return
     repeat
     return

setup.keys:
* Define the key numbers - these are based on QM keycode()
*======================================================================
* Arrow keys
     equ lark to 203, rark to 204, uark to 205, dark to 206
* Page up and down, home and end
     equ upak to 207, dpak to 208, homk to 209, endk to 210
* Insert, delete, backtab, delete line, backspace
     equ insk to 211, deck to 212, btbk to 213, delk to 127, bspk to 8
* Control - Page up and down, homk and end
     equ cupk to 214, cdpk to 215, chok to 216, cenk to 217
* Function, Control+Function, Alt+Function, Shift+Function
     equ f1   to 128, cf1  to 140, af1  to 152, sf1  to 164
     equ f2   to 129, cf2  to 141, af2  to 153, sf2  to 165
     equ f3   to 130, cf3  to 142, af3  to 154, sf3  to 166
     equ f4   to 131, cf4  to 143, af4  to 155, sf4  to 167
     equ f5   to 132, cf5  to 144, af5  to 156, sf5  to 168
     equ f6   to 133, cf6  to 145, af6  to 157, sf6  to 169
     equ f7   to 134, cf7  to 146, af7  to 158, sf7  to 170
     equ f8   to 135, cf8  to 147, af8  to 159, sf8  to 171
     equ f9   to 136, cf9  to 148, af9  to 160, sf9  to 172
     equ f10  to 137, cf10 to 149, af10 to 161, sf10 to 173
     equ f11  to 138, cf11 to 150, af11 to 162, sf11 to 174
     equ f12  to 139, cf12 to 151, af12 to 163, sf12 to 175
*======================================================================
* Stash the escape sequences and key codes in labelled common
     termtype = oconv(system(7),'MCU')
* Set up keys good for many terminals and as defaults
     eseq = '' ; keyd = ''
     keyd<-1> = lark; eseq<-1> = char(21)
     keyd<-1> = rark; eseq<-1> = char(6)
     keyd<-1> = uark; eseq<-1> = char(26)
     keyd<-1> = dark; eseq<-1> = char(10)
     keyd<-1> = homk; eseq<-1> = char(1)
     keyd<-1> = endk; eseq<-1> = char(5)
     keyd<-1> = deck; eseq<-1> = char(4)
     keyd<-1> = upak; eseq<-1> = char(27):'[5~'
     keyd<-1> = dpak; eseq<-1> = char(27):'[6~'
* Now do settings that don't interfere between terminals
* VT-type terminals - cater for alternative arrow sequences
     keyd<-1> = rark; eseq<-1> = char(27):'[C'
     keyd<-1> = rark; eseq<-1> = char(27):'OC'
     keyd<-1> = uark; eseq<-1> = char(27):'[A'
     keyd<-1> = uark; eseq<-1> = char(27):'OA'
     keyd<-1> = dark; eseq<-1> = char(27):'[B'
     keyd<-1> = dark; eseq<-1> = char(27):'OB'
     keyd<-1> = insk; eseq<-1> = char(27):'[1~'
     keyd<-1> = deck; eseq<-1> = char(27):'[4~'
     keyd<-1> = btbk; eseq<-1> = char(27):'[Z'
     keyd<-1> = f1  ; eseq<-1> = char(27):'OP'
     keyd<-1> = f2  ; eseq<-1> = char(27):'OQ'
     keyd<-1> = f3  ; eseq<-1> = char(27):'OR'
     keyd<-1> = f4  ; eseq<-1> = char(27):'OS'
     keyd<-1> = f5  ; eseq<-1> = char(27):'OT'
     keyd<-1> = f6  ; eseq<-1> = char(27):'[17~'
     keyd<-1> = f7  ; eseq<-1> = char(27):'[18~'
     keyd<-1> = f8  ; eseq<-1> = char(27):'[19~'
     keyd<-1> = f9  ; eseq<-1> = char(27):'[20~'
     keyd<-1> = f10 ; eseq<-1> = char(27):'[21~'
     keyd<-1> = f11 ; eseq<-1> = char(27):'[23~'
     keyd<-1> = f12 ; eseq<-1> = char(27):'[24~'
* Wyse-type terminals
     keyd<-1> = insk; eseq<-1> = char(27):'Q'
     keyd<-1> = deck; eseq<-1> = char(27):'W'
     keyd<-1> = btbk; eseq<-1> = char(27):'I'
     keyd<-1> = f1  ; eseq<-1> = char(1):'@':char(13)
     keyd<-1> = f2  ; eseq<-1> = char(1):'A':char(13)
     keyd<-1> = f3  ; eseq<-1> = char(1):'B':char(13)
     keyd<-1> = f4  ; eseq<-1> = char(1):'C':char(13)
     keyd<-1> = f5  ; eseq<-1> = char(1):'D':char(13)
     keyd<-1> = f6  ; eseq<-1> = char(1):'E':char(13)
     keyd<-1> = f7  ; eseq<-1> = char(1):'F':char(13)
     keyd<-1> = f8  ; eseq<-1> = char(1):'G':char(13)
     keyd<-1> = f9  ; eseq<-1> = char(1):'H':char(13)
     keyd<-1> = f10 ; eseq<-1> = char(1):'I':char(13)
     keyd<-1> = f11 ; eseq<-1> = char(1):'J':char(13)
     keyd<-1> = f12 ; eseq<-1> = char(1):'K':char(13)
* ADDS-type terminals
     keyd<-1> = f1  ; eseq<-1> = char(2):'1':char(13)
     keyd<-1> = f2  ; eseq<-1> = char(2):'2':char(13)
     keyd<-1> = f3  ; eseq<-1> = char(2):'3':char(13)
     keyd<-1> = f4  ; eseq<-1> = char(2):'4':char(13)
     keyd<-1> = f5  ; eseq<-1> = char(2):'5':char(13)
     keyd<-1> = f6  ; eseq<-1> = char(2):'6':char(13)
     keyd<-1> = f7  ; eseq<-1> = char(2):'7':char(13)
     keyd<-1> = f8  ; eseq<-1> = char(2):'8':char(13)
     keyd<-1> = f9  ; eseq<-1> = char(2):'9':char(13)
     keyd<-1> = f10 ; eseq<-1> = char(2):':':char(13)
     keyd<-1> = f11 ; eseq<-1> = char(2):';':char(13)
     keyd<-1> = f12 ; eseq<-1> = char(2):'<':char(13)
* xterm type - like my ASUS eeePC
     keyd<-1> = bspk ; eseq<-1> = char(127)
     keyd<-1> = delk ; eseq<-1> = char(27):'[3;2~'
     keyd<-1> = f5   ; eseq<-1> = char(27):'[15~'
     keyd<-1> = sf1  ; eseq<-1> = char(27):'O2P'
     keyd<-1> = sf2  ; eseq<-1> = char(27):'O2Q'
     keyd<-1> = sf3  ; eseq<-1> = char(27):'O2R'
     keyd<-1> = sf4  ; eseq<-1> = char(27):'O2S'
     keyd<-1> = sf5  ; eseq<-1> = char(27):'[15;2~'
     keyd<-1> = sf6  ; eseq<-1> = char(27):'[17;2~'
     keyd<-1> = sf7  ; eseq<-1> = char(27):'[18;2~'
     keyd<-1> = sf8  ; eseq<-1> = char(27):'[19;2~'
     keyd<-1> = sf9  ; eseq<-1> = char(27):'[20;2~'
     keyd<-1> = sf10 ; eseq<-1> = char(27):'[21;2~'
     keyd<-1> = sf11 ; eseq<-1> = char(27):'[23;2~'
     keyd<-1> = sf12 ; eseq<-1> = char(27):'[24;2~'
* Now do terminal-specific settings
* VT-type terminals
     if termtype[1,2] eq 'VT' or termtype[1,5] eq 'XTERM' then
        keyd<-1> = lark; eseq<-1> = char(27):'[D'
        keyd<-1> = lark; eseq<-1> = char(27):'OD'
     end else
        keyd<-1> = insk; eseq<-1> = char(27):'[D'
        keyd<-1> = deck; eseq<-1> = char(27):'OD'
     end
* Wyse-type terminals
     if termtype[1,2] eq 'WY' then
        keyd<-1> = lark; eseq<-1> = char(8)
        keyd<-1> = rark; eseq<-1> = char(12)
        keyd<-1> = uark; eseq<-1> = char(11)
        keyd<-1> = btbk; eseq<-1> = char(27):'O' ;* !
     end
*  for my lttle ASUS eeePC & Linux - What a cool thing it is!
     if index(termtype,'EEEPC',1) then
        keyd<-1> = chok; eseq<-1> = char(27):'[2H' ;* Shift-Home actually
        keyd<-1> = homk; eseq<-1> = char(27):'[H'
        keyd<-1> = endk; eseq<-1> = char(27):'[F'
        keyd<-1> = insk; eseq<-1> = char(27):'[2~'
        keyd<-1> = deck; eseq<-1> = char(27):'[3~'
     end else
        keyd<-1> = homk; eseq<-1> = char(27):'[2~'
        keyd<-1> = endk; eseq<-1> = char(27):'[3~'
     end
* Populate the escape sequence test variables
     base = ''; full = ''
     amax = dcount(eseq,am)
     for anum = 1 to amax
        temp = eseq<anum>
        if len(temp) le 1 then continue
        locate(temp[1,1],base;post) else
           post = dcount(base,am)+1
        end
        base<post> = temp[1,1]
        full<post,-1> = temp
     next anum
     return

outline:
* to display logic simplisticly
     rest = oconv(rest,'MCU')
     if index(rest,'*',1) then rest = 'CEPS'
     bot = here + 1
     if bot gt last then bot = 1
     if numb then msup = here + numb else msup = last
     if msup gt last then msup = last
     for here = bot to msup
        gosub get.line
        gosub find.label
        line = ' ':upcase(line)
        begin case
           case chit eq '*' or chit eq '!' ; line = ''
           case index(line,' GOTO ',1)
           case index(line,' GO ',1)
           case index(line,' GOSUB ',1)
           case rest eq '' ; line = ''
           case index(rest,'C',1) and index(line,' ':'CALL',1)
           case index(rest,'E',1) and index(line,' ':'EXECUTE',1)
           case index(rest,'P',1) and index(line,' ':'PERFORM',1)
           case index(rest,'S',1) and index(line,' ':'CASE',1)
           case 1 ; line = ''
        end case
        if temp ne '' or line ne '' then gosub display.line
     next here
     return

getshowline:
     if unassigned(puncs) then

        puncs = ', []()<>=+-/*:#!'

        funcs  = 'ABS\ABSS\ACOS\ADDS\ALPHA\ANDS\ASCII\ASIN\ASSIGNED\'
        funcs := 'ATAN\BITAND\BITNOT\BITOR\BITRESET\BITSET\BITTEST\'
        funcs := 'BITXOR\CATS\CHANGE\CHAR\CHARS\CHECKSUM\COL1\COL2\'
        funcs := 'CONTINUE\CONVERT\COS\COSH\COUNT\COUNTS\DATE\DCOUNT\'
        funcs := 'DELETE\DIV\DIVS\DOWNCASE\DQUOTE\DTX\EBCDIC\EQS\'
        funcs := 'EREPLACE\EXCHANGE\EXP\EXTRACT\FADD\FDIV\FFIX\FFLT\'
        funcs := 'FIELD\FIELDS\FIELDSTORE\FILEINFO\FIX\FMT\FMTDP\'
        funcs := 'FMTS\FMTSDP\FMUL\FOLD\FOLDDP\FSUB\GES\GET\'
        funcs := 'GETLOCALE\GETREM\GROUP\GTS\ICHECK\ICONV\ICONVS\'
        funcs := 'IFS\ILPROMPT\INDEX\INDEXS\INDICES\INMAT\INSERT\INT\'
        funcs := 'ISNULL\ISNULLS\ITYPE\KEYIN\LEFT\LEN\LENDP\LENS\'
        funcs := 'LENSDP\LES\LN\LOWER\LTS\MATCHFIELD\MAXIMUM\MINIMUM\'
        funcs := 'MOD\MODS\MULS\NEG\NEGS\NES\NOT\NOTS\NUM\NUMS\OCONV\'
        funcs := 'OCONVS\ORS\PWR\QUOTE\RAISE\REAL\RECORDLOCKED\REM\'
        funcs := 'REMOVE\REPLACE\REUSE\RIGHT\RND\RPC.CALL\RPC.CONNECT\'
        funcs := 'RPC.DISCONNECT\SADD\SCMP\SDIV\SEEK\SELECTINFO\SEND\'
        funcs := 'SENTENCE\SEQ\SEQS\SETLOCALE\SIN\SINH\SLEEP\SMUL\'
        funcs := 'SOUNDEX\SPACE\SPACES\SPLICE\SQRT\SQUOTE\SSUB\STATUS\'
        funcs := 'STR\STRS\SUBR\SUBS\SUBSTRINGS\SUM\SUMMATION\SYSTEM\'
        funcs := 'TAN\TANH\TERMINFO\TIME\TIMEDATE\TPARM\TRANS\TRIM\'
        funcs := 'TRIMB\TRIMBS\TRIMF\TRIMFS\TRIMS\UNASSIGNED\'
        funcs := 'UNICHAR\UPCASE\XLATE\XTD'
        convert '\' to @am in funcs

        keywords  = 'ABORT\AUTHORIZATION\AUXMAP\BEGIN\BREAK\BSCAN\'
        keywords := 'BYTE\BYTELEN\BYTETYPE\BYTEVAL\CALL\CASE\CHAIN\'
        keywords := 'CLEAR\CLEARDATA\CLEARFILE\CLEARPROMPTS\CLEARSELECT\'
        keywords := 'CLOSE\CLOSESEQ\COMMIT\COMMON\COMPARE\CONSTANTS\'
        keywords := 'CONVERT\CREATE\CRT\DATA\DEBUG\DEFFUN\DEL\DELETE\'
        keywords := 'DELETELIST\DELETEU\DIM\DIMENSION\DISPLAY\DO\ECHO\ELSE\'
        keywords := 'END\ENTER\EQU\EQUATE\ERRMSG\EXECUTE\EXIT\FILELOCK\'
        keywords := 'FILEUNLOCK\FIND\FINDSTR\FLUSH\FOOTING\FOR\FORMLIST\'
        keywords := 'FUNCTION\GET\GETLIST\GETX\GO\GOSUB\GOTO\GROUPSTORE\'
        keywords := 'HEADING\HUSH\IF\INCLUDE\INPUT\INPUTCLEAR\INPUTDISP\'
        keywords := 'INPUTDP\INPUTERR\INPUTIF\INPUTNULL\INPUTTRAP\INS\'
        keywords := 'KEYEDIT\KEYEXIT\KEYTRAP\LET\LOCALEINFO\LOCATE\LOCK\'
        keywords := 'LOOP\MAT\MATBUILD\MATCH\MATCHES\MATPARSE\MATREAD\MATREADL\'
        keywords := 'MATREADU\MATWRITE\MATWRITEU\NAP\NEXT\NOBUF\NULL\'
        keywords := 'NUMERIC.DATA\ON\OPEN\OPENCHECK\OPENDEV\OPENPATH\'
        keywords := 'OPENSEQ\PAGE\PERFORM\PRECISION\PRINT\PRINTER\'
        keywords := 'PRINTERR\PROCREAD\PROCWRITE\PROGRAM\PROMPT\'
        keywords := 'RANDOMIZE\READ\READBLK\READL\READLIST\READNEXT\'
        keywords := 'READSEQ\READT\READU\READV\READVL\READVU\RECORDLOCK\'
        keywords := 'RELEASE\REM\REMOVE\REPEAT\RETURN\REVREMOVE\REWIND\'
        keywords := 'ROLLBACK\SEEK\SELECT\SELECTE\SELECTINDEX\SETREM\'
        keywords := 'SSELECT\START\STATUS\STOP\STORAGE\SUBROUTINE\'
        keywords := 'TABSTOP\THEN\TIMEOUT\TO\TPRINT\TRANSACTION\TTYCTL\'
        keywords := 'TTYGET\TTYSET\UNICHARS\UNISEQ\UNISEQS\UNLOCK\UNTIL\'
        keywords := 'UPRINT\WEOF\WEOFSEQ\WRITE\WRITEBLK\WRITELIST\'
        keywords := 'WRITESEQ\WRITESEQF\WRITET\WRITEU\WRITEV\WRITEVU'
        convert '\' to @am in keywords

        si.label     = 1
        si.comment   = 2
        si.string    = 3
        si.key       = 4
        si.operator  = 5
        si.function  = 6
        si.directive = 7
        si.highlight = 8
        si.doc       = 9
        bi.hiword   = 10

* Highlights for HostAccess
        bo = @(-58) ; bf = @(-59)
        wo = @(-5)  ; wf = @(-6)
        ro = @(-13) ; rf = @(-12)
        uo = @(-15) ; uf = @(-12)
        hi.commenton  = uo:bo
        hi.commentoff = uf:bf
        hi.labelon    = bo
        hi.labeloff   = bf
        hi.selecton   = ro:wo
        hi.selectoff  = wf:rf
        hi.stringon   = wo
        hi.stringoff  = wf
        hi.keyon      = uo
        hi.keyoff     = uf
        hi.opon       = ''
        hi.opoff      = ''
        hi.funcon     = bo
        hi.funcoff    = bf
        hi.diron      = wo
        hi.diroff     = wf
        hi.docon      = ro:bo
        hi.docoff     = rf:bf

     end

     l = len(line)
* If the line is too long, don't colourise it
     if l gt 2000 then
        showline = line[setoff,width]
        return
     end
     myline = line
     oldmyline = myline
     myline = trimf(myline)
     mask = space(l - len(myline))

     word = myline[' ',1,1]
     if word[' ',1,1] match '1N0N' or word match '1A0X":"' then
        mask := str(si.label,len(word)):' '
        myline = myline[' ',2,999]
        word = myline[' ',1,1]
     end
     begin case
        case word[1,1] eq '*' or word[1,1] eq '!'
           if count(myline,'@@') then
              mask := str(si.doc, l)
           end else
              mask := str(si.comment, l)
           end
        case word[1,1] eq '$' or word[1,1] eq '#'
           mask := str(si.directive, l)
        case 1
           dc = count(myline,';')
           if not(dc) then
              mask := space(l)
           end else
              foundcomment = false
              for z = 1 to dc until foundcomment
                 word = trimf(myline[';',z+1,1])
                 if word[1,1] eq '*' or word[1,1] eq '!' then
                    foundcomment = z
                 end
              next
              if foundcomment then
                 mask := space(len(myline[';',1, foundcomment])):str(si.comment, l)
              end else
                 mask := space(l)
              end
           end
     end case
     lin = convert(puncs,str(@fm,len(puncs)), upcase(oldmyline))
     dc3 = dcount(lin,@fm)
     for q = 1 to dc3
        word = lin[@fm,q,1]
        st = col1()+ 1
        if st gt 1 then
           if mask[st-1,1] eq ' ' and oldmyline[st-1,1] ne ' ' then
              mask[st-1,1] = si.operator           ; * operators too
           end
        end
        begin case
           case word[1,1] eq '"'
              ix = index(lin[st+1,huge],'"',1)
              if ix then
                 if mask[st,1] eq ' ' then
                    q = dcount(lin[1, ix+st],@fm)
                    mask[st, ix+1] = str(si.string, ix+1)
                 end
              end
           case word[1,1] eq "'"
              ix = index(lin[st+1,huge],"'",1)
              if ix then
                 if mask[st,1] eq ' ' then
                    q = dcount(lin[1, ix+st],@fm)
                    mask[st, ix+1] = str(si.string, ix+1)
                 end
              end
           case 1
              locate(word,keywords;dpos;'AL') then
                 if mask[st,1] eq ' ' then
                    mask[st, len(word)] = str(si.key, len(word))
                 end
              end else
                 locate(word,funcs;dpos;'AL') then
* Functions are followed by a bracket
                    brak = ''
                    fpos = len(lin[@fm,1,q])+1
                    if fpos then brak = trim(oldmyline[fpos,999])[1,1]
                    if brak eq '(' and mask[st,1] eq ' ' then
                       mask[st,len(word)] = str(si.function, len(word))
                    end
                 end
              end
        end case
     next

     word = lastfind
     if word ne '' then
        oc = 1
        loop
           if caseflag
              then ix = index(oldmyline,word,oc)
              else ix = index(upcase(oldmyline),upcase(word),oc)
        while ix do
           oc += 1
           mask[ix, len(word)] = str(si.highlight, len(word))
        repeat
     end

     myline = oldmyline[setoff,width]
     mask = mask[setoff,width]
     showline = ''
     old = ''
     l = len(myline)
     for k = 1 to l
        c = mask[k,1]
        if c ne old then
           begin case
              case old eq si.label
                 showline := hi.labeloff
              case old eq si.comment
                 showline := hi.commentoff
              case old eq si.key
                 showline := hi.keyoff
              case old eq si.string
                 showline := hi.stringoff
              case old eq si.key
                 showline := hi.keyoff
              case old eq si.operator
                 showline := hi.opoff
              case old eq si.function
                 showline := hi.funcoff
              case old eq si.directive
                 showline := hi.diroff
              case old eq si.highlight
                 showline := hi.selectoff
           end case
           begin case
              case c eq si.label
                 showline := hi.labelon
              case c eq si.comment
                 showline := hi.commenton
              case c eq si.key
                 showline := hi.keyon
              case c eq si.string
                 showline := hi.stringon
              case c eq si.operator
                 showline := hi.opon
              case c eq si.function
                 showline := hi.funcon
              case c eq si.directive
                 showline := hi.diron
              case c eq si.highlight
                 showline := hi.selecton
              case c eq si.doc
                 showline := hi.docon
           end case
           old = mask[k,1]
        end
        showline := myline[k,1]
     next
     begin case
        case old eq si.label
           showline := hi.labeloff
        case old eq si.comment
           showline := hi.commentoff
        case old eq si.key
           showline := hi.keyoff
        case old eq si.string
           showline := hi.stringoff
        case old eq si.function
           showline := hi.funcoff
        case old eq si.operator
           showline := hi.opoff
        case old eq si.directive
           showline := hi.diroff
        case old eq si.highlight
           showline := hi.selectoff
        case old eq si.doc
           showline := hi.docoff
     end case
     return
Retrieved from "https://pickwiki.org/index.php?title=LineEDitor&oldid=2680"