!XECCE: Version of ECCE as external procedures
!ECCExx: Implementation of ECCE for 2900/EMAS, VAX/VMS and APM
! Revised specification (1981/82) including video support.
! Hamish Dewar Edinburgh University Computer Science Department
!
! V0 (09/02/81): initial test release
! V1 (04/06/81): VT52/Bantam/hard-copy support
! V2 (16/11/81): Esprit supported / Overwrite + C-
! V3 (03/03/82): Overwrite modded + K-
! V4 (15/12/82): revised macros & block move
! V5.0 (29/01/83): standard VTI / revised overwrite
! V6.0 (12/04/83): integration with syntax checking
! V7.0 (08/04/87): %B,%R,Insert mode, ~, ! added, KR
! bug in OVERWRITE corrected
!
! This single source file covers the three versions.
! Simulated conditional compilation statements are used for parts
! which are special to specific versions. All these versions
! assume the availability of sufficient memory (virtual or real)
! to avoid the necessity for manipulating explicitly created
! temporary files. In the Emas version the source file (and any
! secondary files) are mapped directly into virtual memory and
! a separate area is used for the new file being created; in the
! VMS version (because of the idiosyncratic record format of files),
! and the APM version (because of lack of virtual memory at present),
! the source file is 'read in' to the new file area (and secondary
! file to its own area).
! All versions use the EUCSD standard Video Terminal Interface and
! VM management routines, together with the IMP run-time support
! library.
!
! The ASCII character set is assumed, with NL (pre-defined = LF)
! as the line-break character WITHIN THE TEXT FILE.
! The Editor expects to receive RETURN (= ASCII RT) and LF distinctively
! FROM THE KEYBOARD, and at present expects THESE CHARACTERS TO BE
! INTERCHANGED.
! The present treatment of the DEL character is interim; the Editor
! assumes the ad hoc treatment of the VTI package thus:
! (a) DELs which can validly delete printing characters which have
! just been typed do remove those characters from the input stream
! (b) Initial and trailing DELs which may have erased surrounding
! text are passed through.
!
! One of the objectives in the design of the video facilities was
! to avoid having to pre-suppose single-character interaction on
! sequences of printing characters. There are a few cases where
! there would be a small ergonomic gain from exploiting this mode
! of operation on a system where it is unproblematic, but it
! would be a pity to lose compatibility on that score.
! The Editor does pre-suppose termination of input on any control
! character or control sequence without echoing; it might be possible
! to make a special case of some or all of the cursor controls
! where the performance implications of interaction even on every
! control key is problematic.
!
!
!
!
!
!
!
!
!
!
!
include "VTINC"
include "RECORDS"
include "MACINC"
include "SYSROUTS"
externalroutine EDI(record (edfile)name main,sec,
string (255) message)
! In the Vax version the original file is copied into the
! working space prior to entry; in the EMAS version
! it is accessed (initially) in its original mapped site.
!
constinteger RET=10
constinteger CASEBIT=32; !upper<->lower
record (opt fm) O; !Local copy of editor options
constinteger STOPPER=-10000; !loop stop
constinteger MINGAP=4096; !room for manoeuvre
!Own variables (plus MACROS):-
integer TOGGLE
integer CASEMASK; !\casebit/\0 to ignore/heed case
integer DICT
integer TERM; !last symbol read
integer SYM; !last symbol got
!
integer CODE; !command code
integer PCFLAG; !set while % command in execution. for logfile
integer LAST
integer REF; !text or bracket pointer
integer SCOPE; !search limit
integer NUM; !repetition number
integer CONTROL,PEND; !characters
integer HOLD,HOLDSYM,QSYM; !work variables
integer HOLD1
integer ERROR
integer COMMANDSTREAM; !0[1] for terminal[file]
integer SIN; !-1: destroying
! 0: main file (editing)
! 1: " (showing)
! 2: sec file (from 0)
! 3: " (from 1)
!
integer FP; !current file position
integer FP1; !temporary FP
integer LEND; !line end position
integer OLDLIM1,OLDSTART2
integer GAPLINE
integer NEWLIM; !effective limit of new file
!also = start of deletion store
integer DELMAX,LASTDELMAX; !current end of deletions
integer CONSOLIDATED
integer NEG
integer KEEPLOG; ! -1 for log = journal, +1 for file
owninteger LOGSTREAM=0
integer T; ! Current tab
integer GDIFF
integer FOUNDPOS,FOUNDSIZE; !matched text info
integer MARKPOS,MARKLINE; !marker positions
record (edfile)name CUR
!
! Video control
integer VIDEO
integer SMODE
integer FSCROLL, CSCROLL
integer CHALF
const integer VGAP = 0
integer PAN
constinteger UNKNOWN=-99999; !impossible value for _DIFF
constinteger OFFSCREEN=255; !impossible value for _WIN
integer JOINS; !count of lines added/removed
integer ENDON; !**END** displayed indic
!The following assumes that (relevant) addresses are positive
constinteger FLOOR=0; !** LESS THAN ANY VALID ADDRESS **
constinteger CEILING=16_7FFFFFFF
integer ALTMIN,ALTLIM; !pos of earliest/latest alteration
integer ALTLINE; !for ALTMIN
integer ALTLIMLBEG; !for ALTLIM
integer VP; !file pointer for displaying
integer VPLIM; !pointer to end of alterations for displaying
integer INSERTLEN; !Length of buffer text - insert mode only
integer INSERTDIF; !Change in insertlen from previous call
integer PRINTLINE,PRINTED; !for hard-copy
!
string (15) NEWPROM,CURPROM
!
string (maxname) COMMAND ; ! Passed to Operating system for execution
integer DICTPOS
integer MAC0,MACM4,MACBASE
constinteger MSTBOUND=7
integerarray MSTACK(0:mstbound)
integer MSP; !macro stack pointer
!
!Cell format for storage of commands
recordformat COMMANDCELL(byteinteger code,ref,
shortinteger scope, integer count)
constinteger CBOUND=200
record (commandcell) array R(1:cbound)
integer CI,CMAX,CMAX1; !indexing R
!
switch C(4:15), PC('A':95), S(' ':127)
integer TYPE,CHAIN
record (commandcell) LASTCELL
!
!!!!!!!!!!!!! Key definition map and macros !!!!!!!!!!!!!!!!!
! The Video Terminal Interface converts multi-character
! control sequences to character values in the range 128:255.
! For 2-char sequences, the value is 2nd char + 128.
! For 3-char sequences, the value is 3rd char!!96 + 128
! The array DEF records the significance of each symbol,
! as either a basic symbol (<32768) or macro definition.
! Initial entries are a melange of values relevant to specific
! known terminals.
constinteger POSMASK=16_3FFF, LIMSHIFT=16
constinteger NULL=' ', NULLREF=' ', TREFBASE='"'+1,
MACRO=1<<limshift,
PREDEFLIM=528, PREMACRO=(predeflim+1)<<limshift
!128:159 second 0-31 third 96-127
!160:191 second 32-63 third 64-95
!192:223 second 64-95 third 32-63
!224:255 second 96-127 third 0-31
![entries for ' ' to 'X'-1 by-passed]
external integer array INITDEF(0:255) =
{ Predefinitions for ASCII characters }
{ first the control characters }
{NUL ^@}' ' , {SOH ^A}'%'+'A'<<8, {STX ^B}'K' , {EXT ^C}'%'+'A'<<8,
{EOT ^D}'%'+'A'<<8, {ENQ ^E}' ' , {ACK ^F}' ' , {BEL ^G}' ',
{BS ^H}'g' , {TAB ^I}'N' , {LF ^J}'M' , {VT ^K}'{',
{FF ^L}'>' , {CR ^M}'1' , {SO ^N}'E' , {SI ^O}'I',
{DLE ^P}'>' , {DC1 ^Q}' ' , {DC2 ^R}' ' , {DC3 ^S}' ',
{DC4 ^T}' ' , {NAK ^U}' ' , {SYN ^V}'}' , {ETB ^W}' ',
{CAN ^X}'>' , {EM ^Y}'%'+'A'<<8, {SUB ^Z}' ' , {ESC ^[}' ',
{FS ^\}' ' , {GS ^]}' ' , {RS ^^}'}' , {US ^_}' ',
{ now the printing characters }
' ' , '!' , '"' , '#' ,
'$' , '%' , '&' , '''' ,
'(' , ')' , '*' , '+' ,
',' , '-' , '.' , '/' ,
{ numbers }
'0' , '1' , '2' , '3' ,
'4' , '5' , '6' , '7' ,
'8' , '9' , ':' ,
{ things }
';' , '<' , '=' , '>' ,
'?' , '@' ,
{ upper case letters }
'A' , 'B' , 'C' , 'D' ,
'E' , 'F' , 'G' , 'H' ,
'I' , 'J' , 'K' , 'L' ,
'M' , 'N' , 'O' , 'P' ,
'Q' , 'R' , 'S' , 'T' ,
'U' , 'V' , 'W' , ' ' ,
{Y} 526<<limshift+525 , {Z} 527<<limshift+526 ,
{ more things }
'[' , '\' , ']' , '^' ,
'_' , '`' ,
{ lower case letters - mostly the same as upper case }
'A' , 'B' , 'C' , 'D' ,
'E' , 'F' , 'G' , '%'+'H'<<8 ,
'I' , 'J' , 'K' , 'L' ,
'M' , 'N' , 'O' , 'P' ,
'Q' , 'R' , 'S' , 'T' ,
'U' , 'V' , 'W' , ' ' ,
' ' , ' ' ,
{ even more things }
'{' , '|' , '}' , '~' ,
{DEL} 'e' ,
{ escape followed by a control character }
{ or escape, question mark, lower case letter (on Hazeltine anyway!)}
{?SP} ' ' , {?a} '%'+'A'<<8 , {?b} '%'+'B'<<8 , {?c} '%'+'C'<<8 ,
{?d} '<' , {?e} ' ' , {?f} ' ' , {?g} ' ' ,
{?h} '%'+'H'<<8 , {?i} ' ' , {?j} ' ' , {?k} '}' ,
{?l} '{' , {?m} 'm'+'0'<<8 , {?n} '%'+'D'<<8 , {?o} ' ' ,
{?p} 'F'+'!'<<8 , {?q} 'E'+'0'<<8 , {?r} 'S'+'!'<<8 , {?s} '^' ,
{?t} 'K' , {?u} 'E' , {?v} 520<<limshift+516 ,
{?w} 'G'+'0'<<8 , {?x} 'I' , {?y} 516<<limshift+512 ,
{?z} 'G'+'0'<<8 ,
{?[} ' ' , {?\} ' ' , {?]} ' ' , {?^} ' ' ,
{?_} ' ' ,
{ escape, question mark, Upper-case letter (on the Hazeltine anyway!!) }
{?`} ' ' ,
{?A} '%'+'E'<<8 , {?B} '%'+'B'<<8 , {?C} ' ' , {?D} ' ' ,
{?E} ' ' , {?F} ' ' , {?G} ' ' , {?H} ' ' ,
{?I} ' ' , {?J} ' ' , {?K} '}' , {?L} '{' ,
{?M} '\' , {?N} ' ' , {?O} ' ' , {?P} ' ' ,
{?Q} 'o'+'0'<<8 , {?R} 525<<limshift+520 , {?S} ' ' ,
{?T} ' ' , {?U} ' ' , {?V} ' ' , {?W} ' ' ,
{?X} ' ' , {?Y} ' ' , {?Z} ' ' ,
{?[} ' ' , {?\} ' ' , {?]} ' ' , {?^} ' ' ,
{?_} ' ' ,
{ escape followed by an upper case command character }
{ ( lower case means add a minus to the command string backwards) }
{?@} '}' ,
{?A} '{' , {?B} '}' , {?C} '>' , {?D} '<' ,
{?E} 'G' , {?F} ' ' , {?G} ' ' , {?H} 'H' ,
{?I} ' ' , {?J} '$' , {?K} 'e'+'0'<<8 , {?L} 'g' ,
{?M} 'k' , {?N} ' ' , {?O} ' ' , {?P} ' ' ,
{?Q} 'I' , {?R} 'K' , {?S} ' ' , {?T} 'E'+'0'<<8 ,
{?U} ' ' , {?V} ' ' , {?W} 'E' , {?X} ' ' ,
{?Y} ' ' , {?Z} ' ' ,
{?[} ' ' , {?\} ' ' , {?]} '|' , {?^} ' ' ,
{?_} ' ' , {?`} ' ' ,
{ escape followed by a lower case command character }
{?a} '%'+'A'<<8 , {?b} '%'+'B'<<8 , {?c} '%'+'C'<<8 , {?d} '%'+'D'<<8 ,
{?e} '%'+'E'<<8 , {?f} 'S'+'"'<<8 , {?g} 'G'+'0'<<8 , {?h} '%'+'H'<<8 ,
{?i} 'i'+'0'<<8 , {?j} 'J' , {?k} '}' , {?l} '{' ,
{?m} 'M' , {?n} 'N' , {?o} 'O' , {?p} 'F'+'"'<<8 ,
{?q} 'Q'+'0'<<8 , {?r} ' ' , {?s} ' ' , {?t} 'T'+'!'<<8 ,
{?u} 'U'+'!'<<8 , {?v} ' ' , {?w} ' ' , {?x} ' ' ,
{?y} ' ' , {?z} 'n' , {? l-curly} ' ' , {?|} ' ' ,
{? r-curly} ' ' , {?~} ' ' , {?DEL} ' '
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! The storage of the macros is in 2 'arrays'
! %own %byte %integer %array MAC(0:macbound)
! %own %integer%array DEF(0:255)
! To allow EMAS to map these into the editor file, they are accessed by
! the %map's which must be in the externs file. The map DEF must initially
! have the values in INITDEF.
!Indexing MAC:
! The initial part of the array MAC is reserved for
! a pool of 4 128-byte buffers used to hold
! new input, command text, match text, insert text
integer INPOS,INLIM
integer NEWDEF,CDEF,IDEF,MDEF
integer DELS,INITDELS,REPAIRCH
integer MPOS,MLIM
integer TREFLIM,TREFLIM1
integer EFLAG
string (255) MESS
routine spec CAT(integer row,col)
switch eventno(0:15)
on event 9,10,13,14 start ; !End-of-input, Too big
! traps events signalled in program -
! print out system message of EVENT_EXTRA on event 9
! print out text in EVENT_MESSAGE on event 10
! Jump to %C on event 13 (signalled by READ TEXT for end of input from main in)
! No output on event 14
curprom = ""
-> eventno(event_event)
eventno(9):
cat(1,0); print string(sysmess(event_extra)); new line
-> ignore
eventno(10):
cat(1,0); print string(event_message); new line
-> ignore
eventno(13): ! End of file from batch or file
-> pc('C')
eventno(14):
eventno(*):
-> ignore
finish
-> edistart
!!!!!!!!! Simple (command) stream opening and closing !!!!!!!!!!!
!
const integer maxstream = 15
routine OPEN IN(string (maxname) file)
integer newstream
on event 3,4,9 start
select input(commandstream)
signal 9,event_sub
finish
newstream = commandstream + 1
event_message = "Command files nested too deeply" and signal 10,2 if newstream > maxstream
open input(newstream,file); select input(newstream)
commandstream = newstream
end
routine OPEN OUT(string (maxname) file)
on event 3,4,9 start
select output(0)
signal 9,event_sub
finish
open output(logstream+1,file); select output(logstream+1)
end
routine CLOSE IN
commandstream = commandstream - 1 if commandstream > 0
close input; select input(commandstream)
end
routine CLOSE OUT
close output; select output(0)
end
!
!!!!!!!!!!!!!! General-purpose output routines !!!!!!!!!!!!!!!!!!!
!
string (31)fn ITOS(integer i)
string (31) s
integer sign,j
s = ""; sign = i; i = -i if i < 0
while i # 0 cycle
j = i//10
s = tostring(i-10*j+'0').s
i = j
repeat
s = "0" if s = ""
s = "-".s if sign < 0
result = s
end
routine PRINT CODE(integer k)
! Print command letter (mapping 'minus' values)
print symbol(k-casebit) and k='-' if 'a' <= k <= 'w'
print symbol(k)
end
!
routine AT(integer row,col); !file window
col = 0 if col < 0
if win_top # o_wtop start
swop window
finish
vt at(row,col)
end
routine CAT(integer row,col); !command window
if win_top # o_ctop start
swop window
finish
vt at(row,col)
end
!
routine COMPLAIN(string (255) text)
cat(1,chalf); print string(text); newline
error = 1
signal 14
end
!
routine GASP
complain("* Insertions too big")
end
integerfn DEF1(integer k)
k = def(k)
result = k if k < macro
result = mac(k&posmask)-128
end
!!!!!!!!!!!!!!!!!!!! Macro management !!!!!!!!!!!!!!!!!!!!!!!!!!
!
routine MACPUSH(integer newdef)
if newdef >= macro start
complain("* Too many macro levels") if msp > mstbound
mstack(msp) = inlim<<limshift+inpos
msp = msp+1
inpos = newdef&posmask; inlim = newdef>>limshift
finish
end
!
routine RELEASE(integer k)
integer i
i = def(k)
if i >= premacro start
i = i&posmask+macm4
if integer(i) >= 0 then monitor else integer(i) = -integer(i)
finish
def(k) = ' '
end
!
integerfn MACSPACE(integer needed)
integer p,q
needed = (needed+7)&(\3); !add 4 & align
p = macbase
cycle
q = integer(p)
complain("* Macros too long *") if q = 0
if q < 0 start ; !chunk in use
p = p-q; !skip over
else
q = q+integer(p+q) while integer(p+q) > 0; !consolidate
exit if q >= needed
integer(p) = q
p = p+q
finish
repeat
integer(p) = q-needed
p = p+q-needed
integer(p) = -needed
result = p-macm4
end
! E d i t o r - s p e c i f i c v i d e o r o u t i n e s
!
routine SET WINDOWS
! Make window parameters consistent and set up sub-windows
! -- called at outset only
const integer cordon=0
integer vrows
vrows = vdu_rows-cordon; !effective screen size [temp for Emas]
o_wrows = vrows-2 if o_wrows > vrows-2; !must have 2 lines for commands
o_ctop = vrows-2 if o_ctop > vrows-2
o_wtop = vrows-1 if o_wtop >= vrows
o_wrows = vrows-o_wtop if o_wrows > vrows-o_wtop
o_wtop = 0 if o_wtop = 1 and o_wtop+o_wrows > vrows-2
o_wcols = vdu_cols if o_wcols > vdu_cols
if o_wtop-2 < o_ctop < o_wtop+o_wrows start
o_ctop = o_wtop+o_wrows; !try after file window
o_ctop = o_wtop-2 if o_ctop+2 > vrows; !before file window
finish
o_ccols = 40 if o_ccols < 40
o_ccols = vdu_cols if o_ccols > vdu_cols
chalf = o_ccols>>1
video = vdu_fun
fscroll = 0; cscroll = 0
if vdu_fun&anyscroll # 0 start ; !video can scroll
if o_wcols = vdu_cols start ; !full-length rows
fscroll = 1
video = video-256 and o_wrows = o_wrows+1 if o_ctop = o_wtop+o_wrows
finish
cscroll = 1 if o_ccols = vdu_cols
finish
set frame(o_wtop,o_wrows,o_wleft,o_wcols)
o_wrows = o_wrows-1 if video < 0; !restore
win_mode = noscroll
push window; !save
set frame(o_ctop,2,o_cleft,o_ccols)
win_mode = noscroll
o_mark = 1 if vdu_fun&intense = 0; !cannot highlight
if o_maxwin >= o_wrows then o_maxwin = o_wrows c
else sec_min = o_wrows-o_maxwin-1 and cur_top = sec_min+1
end
!
routine COERCE PARAMETERS
!Make (dynamically alterable) parameters consistent
cur_min = o_wrows if cur_min > o_wrows
cur_min = 1 if cur_min = 0; !** allow as disable? **
o_mark = 0 if video = 0
o_width = 80 unless 5 <= o_width <= 512
o_margin = 0 unless o_margin < o_width
casemask = \0; casemask = \casebit if o_mapcase # 0
o_dmode = 0 if video = 0; ! Disallow INSERT mode in line mode
end
!
routine HEADER(integer r)
if video # 0 start
at(r,0)
print string("<<"); newline
finish
end
!
routine SAVE COMMAND
!scroll down to preserve command
swop window if win_top # o_ctop
scroll(0,1,-1); curprom = ""
end
!
!!!!!!!!!!!!!!!!!!!!!! Misc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
routine SET LEND
lend = fp
return if fp = cur_lim2
if lend # cur_lim2 start
lend = lend+1 while byteinteger(lend) # nl
finish
end
!
routine SET LBEG(integer name lbeg, integer p)
!Establish line start position
lbeg = p
cycle
if lbeg = cur_start2 start
lbeg = cur_lim1
while lbeg # cur_start1 and byteinteger(lbeg-1) # nl cycle
lbeg = lbeg-1
repeat
lbeg = lbeg+(cur_start2-cur_lim1)
return
finish
return if lbeg = cur_start1 or byteinteger(lbeg-1) = nl
lbeg = lbeg-1
repeat
end
integer fn COLTAB(integer col,lbeg)
! Returns number of file characters corresponding to screen column COL
integer p,t,c,lend
result = col if o_exptabs = 0
lbeg = lbeg - cur_start2 + cur_lim1 unless cur_start1 <= lbeg < cur_lim1 or c
cur_start2 <= lbeg <= cur_lim2
p = lbeg; t = 0; c = 0; lend = 0
while c < col cycle
lend = p if lend = 0 and byteinteger(p) = nl
if lend = 0 and byteinteger(p) = tab and t < maxtab start
t = t + 1 while t < maxtab and c >= o_tabs(t)
if c < o_tabs(t) then c = o_tabs(t) else c = c + 1
finish else c = c + 1
p = p + 1
if p = cur_lim1 start
p = cur_start2
lbeg = lbeg-cur_lim1+cur_start2
finish
repeat
result = p - lbeg
end
integer fn TABCOL(integer vp, lbeg, next)
! returns screen column of VP if next=0, next tab after VP if next > 0
integer col, p, t, lend
result = vp - lbeg if o_exptabs = 0
lbeg = lbeg - cur_start2 + cur_lim1 unless cur_start1 <= lbeg < cur_lim1 or c
cur_start2 <= lbeg <= cur_lim2
vp = vp + cur_start2 - cur_lim1 if cur_lim1 <= vp < cur_start2 or c
cur_lim2 < cur_lim1 <= vp
col = 0 ; t = 0; p = lbeg; lend = 0
while p # vp cycle
lend = p if lend = 0 and byteinteger(p) = nl
if lend = 0 and byteinteger(p) = tab and t < maxtab start
t = t + 1 while col >= o_tabs(t) and t < maxtab; ! Find next tab
if col < o_tabs(t) then col = o_tabs(t) else col = col + 1
finish else col = col + 1
monitor and stop if col > 10000
p = p + 1
p = cur_start2 if p = cur_lim1
repeat
result = col if next = 0
t = t + 1 while col >= o_tabs(t) and t < maxtab; ! Find next tab
result = o_tabs(t) if t < maxtab; ! Next tab position
result = col+1; ! No more tabs set
end
!
!!!!!!!!!!!!!! S c r e e n u p d a t i n g !!!!!!!!!!!!!!!!!
!
routine DISPLAY LINE
integer k,p,lbeg, t, t0, col
if cur_lbeg <= vp <= fp then lbeg = cur_lbeg else start
if vp = cur_start1 or byteinteger(vp-1) = nl then lbeg = vp c
else set lbeg(lbeg,vp)
finish ; ! All this to avoid procedure call overhead to SET LBEG. worth it?
t = 0; t0 = 0; col = insertlen; col = col + tabcol(vp,lbeg,0) if vp # lbeg
p = fp; p = lend if fp > lend
cycle
vp = cur_start2 and lbeg = lbeg+(cur_start2-cur_lim1) if vp = cur_lim1
exit if vp = endon
if vp = p start
cur_diff = cur_line-win_row; !NB external ref
finish
if vp = vplim start
vplim = -1
return if joins = 0 and lbeg = altlimlbeg
finish
if vp = cur_lim2 start
endon = vp
print string(" **END**")
exit
finish
k = byteinteger(vp)
if k = tab and o_exptabs # 0 start
t = t + 1 while col >= o_tabs(t) and t < maxtab
vp = vp + 1 if col >= o_tabs(t) - 1
k = ' '
if insertdif # 0 start ; ! Test for ,partial line update in insert mode
t0 = t0 + 1 while col-insertdif >= o_tabs(t0) and t0 < maxtab
if t0 = t and t < maxtab start
spaces(-insertdif) if insertdif < 0
insertdif = 0; ! To prevent return on next cycle
return
finish else insertdif = 0
finish
finish else vp = vp + 1
if k < ' ' or k >= 127 start
exit if k = nl
k = '_'
finish
print symbol(k) if col >= cur_shift; col = col + 1
repeat
newline
end
!
routine REMOVE POINTER
if cur_flag >= ' ' start
at(cur_row,cur_col)
print symbol(cur_flag)
cur_flag = 0
finish
end
routine REPAIR LINE
at(cur_line-cur_diff,tabcol(fp,cur_lbeg,0)+o_mark-cur_shift)
vp = fp; vp = lend if fp > lend
display line
end
routine REPAIR CHARS(integer n)
return if n <= 0
vp = fp; vplim = fp + n
display line
end
routine UPDATE
! If a change has been made to the file, update screen,
! but only if change has affected screen line(s).
! ALTMIN and ALTLIM delimit the area which has been affected
! by alterations
integer r,c,d
return if altlim = floor; !no change =>
if sin < 0 start
fp = lend if fp > lend
return if cur_start2 = fp and altmin = ceiling
if cur_line > gapline start
joins = joins+(cur_line-gapline); cur_line = gapline
finish else if cur_line < gapline start
joins = joins-(cur_line-gapline); gapline = cur_line; altline = cur_line
finish
markpos = 0 if cur_start2 <= markpos < fp
altlimlbeg = 0; cur_start2 = fp; altlim = fp
set lbeg(cur_lbeg,fp)
finish
cur_change = altmin if altmin < cur_change
return if video = 0
cur_diff = unknown if joins+cur_min <= 0; !many breaks
r = altline-cur_diff
if r < cur_win start
cur_diff = cur_diff-joins
cur_diff = unknown if cur_line-cur_diff >= cur_win
finish else if r < cur_bot start ; !within current window
swop window if win_top # o_wtop
remove pointer if cur_flag > 0
altmin = cur_lim1 if altmin > cur_lim1; !?[or only SIN<0]
altlim = cur_start2 if altlim < cur_start2; !?
vp = altmin
altmin = altmin-1 while altmin # cur_start1 and byteinteger(altmin-1) # nl
c = vp-altmin
d = 0; endon = -1
vplim = altlim
cycle
vp = cur_start2 if vp = cur_lim1
if c+vgap = 0 and fscroll # 0 and joins # 0 start
if joins < 0 start ; !net expansion
if cur_win > cur_top start
cur_win = cur_win-1; r = r-1
cur_diff = cur_diff+1
scroll(cur_top,r,1)
else
scroll(r,cur_bot-1,-1)
finish
joins = joins+1
finish else if vplim < 0 c
or (vp = vplim and vp = altlimlbeg) start
d = cur_bot-r-joins
if d > 0 start
cycle
scroll(r,cur_bot-1,1)
joins = joins-1
repeat until joins = 0
cycle ; !Scan forward
cycle
vp = cur_start2 if vp = cur_lim1
endon = vp and exit if vp = cur_lim2
vp = vp+1
repeat until byteinteger(vp-1) = nl
r = r+1; d = d-1
repeat until d = 0
while r < cur_bot cycle
at(r,o_mark); display line; r = r+1
repeat
exit
finish
finish
finish
c = tabcol(c+altmin,altmin,0) if c > 0
at(r,c+o_mark-cur_shift); display line; c = 0; r = r+1
repeat until r >= cur_bot or (vplim < 0 and joins=0)
finish
joins = 0; altmin = ceiling
altlim = floor; altlim = floor+1 if sin < 0
end
!
routine DISPLAY(integer indic)
! Update screen & ensure that current line is on screen
integer r,r1,fullpre,pre,count,standoff
!
routine SCAN(integer pre, integer name count)
! Move vp forward or back PRE lines or to beginning/end of file
! and set COUNT to actual number
count = 0
while pre > 0 cycle
vp = cur_lim1 if vp = cur_start2
return if vp = cur_start1
cycle
vp = vp-1
vp = cur_lim1 if vp = cur_start2
repeat until vp = cur_start1 or byteinteger(vp-1) = nl
count = count + 1; pre = pre-1
repeat
while pre < 0 cycle
return if vp = cur_lim2
cycle
vp = cur_start2 if vp = cur_lim1
return if vp = cur_lim2
vp = vp+1
repeat until byteinteger(vp-1) = nl
pre = pre + 1; count = count - 1
repeat
end
routine DISPLAY LINES(integer n)
cycle
at(r,0)
print symbol(' ') if o_mark # 0
display line
r = r+1; n = n-1
repeat until n = 0 or r >= cur_bot
end
update; vplim = -1
vp = cur_lbeg
vp = vp-cur_start2+cur_lim1 if vp < cur_start2 <= fp
if video = 0 start
printline = cur_line; printed = cur_lim1+fp
cycle
printstring("**END**") and exit if vp = cur_lim2
exit if byteinteger(vp) = nl
print symbol(byteinteger(vp))
vp = vp+1
vp = cur_start2 if vp = cur_lim1
print symbol('^') if vp = fp and num = 1
repeat
newline
return
finish
swop window if win_top # o_wtop
remove pointer if cur_flag > 0
endon = -1
fullpre = cur_min-1
fullpre = fullpre>>1 if lend # cur_lim2
standoff = (cur_bot-cur_top)>>2
r = cur_line-cur_diff; pre = r-cur_win
if pre-indic*standoff < 0 start ; !before start of window
if pre-indic*standoff > -cur_min start ; !not far before
if fscroll # 0 or r >= cur_top start
! ****** Better Scrolling Algorithm KR 1987 ****
scan(pre+1,count)
if pre < 0 or count = pre + 1 start
count = count - 1 - indic*standoff
while count < 0 cycle
if cur_win <= cur_top start
scroll(cur_top,cur_bot-1,-1); ! Scroll down
r = r + 1
cur_diff = cur_diff-1
at(cur_top,o_mark)
else ; ! expand window
cur_win = cur_win-1
at(cur_win,0)
print symbol(' ') if o_mark # 0; ! Clear header in MARK mode
finish
display line
scan(2,hold); ! Back vp 2 lines to prev
exit if hold#2; ! reached beginning of file
count = count + 1
repeat
header(cur_win-1) if cur_win > cur_top
finish
! ****
return
finish
finish
else
pre = r-cur_bot
! %if pre < 0 %start; !within window
! %return %if indic = 0 %or pre # -1 %or lend = cur_lim2
! vp = lend+1
! %finish
return if pre+indic*standoff < 0
if pre+indic*standoff < cur_min start ; !not far ahead
if fscroll # 0 start
scan(pre,count);
if pre >= 0 or count = pre start
count = count + 1 + indic*standoff
while count > 0 cycle
cur_win = cur_win-1 if cur_win > cur_top
scroll(cur_top,cur_bot-1,1)
cur_diff = cur_diff+1
at(cur_bot-1,o_mark)
display line
exit if vp=endon; ! Reached end of file
count = count-1
repeat
finish
return
finish
finish
finish
!Complete refresh (including window init)
scan(fullpre,count)
r = cur_bot-cur_min; !floating window top
if r # cur_win start ; !changed
if r < cur_top start ; !sub-window changed
if sin < 2 start ; !on main sub-window
cur_top = r
if cur_top < sec_bot+1 start
sec_bot = 0; sec_bot = r-1 if r > 0
sec_win = offscreen if sec_bot = 0
finish
else ; !on sec sub-window
cur_bot = cur_min
if cur_bot+1 > main_top start
if cur_bot < main_bot then main_top = cur_bot+1 else main_top = main_bot
if main_bot - main_top < main_min start ; ! Main window < minimum size
main_min = main_bot - main_top; ! new minimum is remaining window
main_min = o_wrows>>1 if main_min < o_wrows>>1; ! Reset to reasonable value
finish
main_win = main_top if main_win < main_top
main_win = offscreen if main_bot - main_top < main_min
finish
r = 0
finish
cur_win = offscreen
finish
if cur_win = offscreen start
if sin < 2 start
header(cur_top-1) if cur_top > 0
else
header(cur_bot) if cur_bot < main_bot
finish
else
cur_win = cur_top if cur_win < cur_top
cur_win = cur_win-1 if cur_win > cur_top
while cur_win < r-1 cycle
at(cur_win,0); clear line; cur_win = cur_win+1
repeat
finish
cur_win = r
r1 = cur_top
while r1 < cur_win cycle ; ! Clear unused screen area
at(r1,0); clear line
r1 = r1 + 1
repeat
header(cur_win-1) if cur_win > cur_top
finish
display lines(0)
end
!
!!!!!!!!!!!!!!!!! Command input routines !!!!!!!!!!!!!!!!!!!!!!!!
!
routine SHOW POINTER
integer col,p
cur_row = cur_line-cur_diff; p = fp
col = tabcol(fp,cur_lbeg,0)-cur_shift
! %return %if col < 0 %or col >= win_cols-1
if col < 0 start
if cur_start1 <= fp < cur_lim1 and fp-col > cur_lim1 then p = p-cur_lim1+cur_start2
p = p - col
col = 0
finish else if col > win_cols-1 start
if fp-col < cur_start2 and cur_start2 <= fp <= cur_lim2 then p = p+cur_lim1-cur_start2
p = p - col + win_cols-1
col = win_cols - 1
finish
cur_flag = ' '
cur_col <- col
at(cur_row,cur_col)
if o_mark = 0 start
cur_flag = byteinteger(fp) if fp < lend
set shade(intense)
if del > cur_flag > ' ' then print symbol(cur_flag) c
else print symbol('|')
set shade(0)
if p < lend then cur_flag = byteinteger (p) else cur_flag = ' '
else
if vttype # bantam then print symbol('~') c
else print symbol(esc) and print symbol(127); !splodge
if col > 0 and p <= lend start
if p # cur_start2 then cur_flag = byteinteger(p-1) c
else cur_flag = byteinteger(cur_lim1-1)
finish
finish
cur_flag = ' ' if cur_flag = tab and o_exptabs#0
cur_flag = '_' unless ' ' <= cur_flag < del
end
routine PREPARE FOR INPUT
if video = 0 start
num = 1 and display(0) if printed # cur_lim1+fp and cur_min # 0
else
display(o_early)
show pointer
finish
end ; !PREPARE FOR INPUT
!
routinespec SPLIT(integer gap)
routinespec CONSOLIDATE(integer amount,mode)
constinteger nomac=-2, standard=-1, replacing=0, inserting=1
routine output logfile(integer p,q,mode)
integer i,sym,data entry,k,flag
string (255) text
on event 9 start
keeplog = 0
event_message = "Error writing log file."
signal 10,4
finish
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Sends output either to slected stream or to journal (EMAS only)
! For other machines a dummy called TOJOURNAL must be provided
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
routine out symbol(integer k)
if keeplog > 0 then print symbol(k) else tojournal(addr(k)+3 ,1); !+3 gives LSB
end
routine out string(string (255) s)
if keeplog > 0 then print string(s) else tojournal(addr(s)+1,length(s))
end
routine out control(integer sym)
out symbol('&'); sym = sym+64
if sym >= 128 start
sym = (sym-64)&127
out symbol('['); !ESC
out symbol('?') and sym = sym!!96 if sym < 64
finish
out symbol(sym)
end
integerfn define free key(string (15) defn)
integer k
k=255
k = k - 1 until def(k) = null or k = 128; ! Find free control seq
out string("%K"); out control(k);out symbol(':'); ! Define to be
out string(defn); out symbol(nl)
result = k
end
return if keeplog = 0
select output(logstream) if keeplog > 0
flag = 0
if q-p >= 2 and mac(p) = '%' start ; ! %K or %Q are special cases
flag = mac(p+1)&95
if flag = 'K' or flag = 'Q' then p = p + 2 else flag = 0
finish
text = "" ; text = text.tostring(mac(i)) for i = p,1,q-1
data entry = 0
data entry = 1 if mode >= 0 and ci = cmax1 {ie command buffer empty}
if mode = inserting and term = del and q = p start
out symbol(nl) if data entry = 0; !Insert nothing before erasing back
out string("& "); out symbol(nl); ! Special sequence translated by GET CODE as DEL
finish else if data entry > 0 start ; ! Data Entry
! Handle DATA ENTRY by simulating O! and I! commands issued by control key
if def1(term) = 'H' start ; ! Interpret text as command
out string(text); out symbol(nl); ! (see DATA ENTRY)
else
if q > p start ; ! Text to be inserted or replace
-> exit if sin&(\1) # 0 or lend = cur_lim2;! No alterations allowed
if mode = inserting then k = define free key("I") c
else k = define free key("O")
out control(k); out symbol(nl)
out string(text); out symbol(nl)
out string("%K"); out control(k); out symbol(':'); ! Remove macro definition
out symbol(nl)
finish
out control(term); out symbol(nl)
finish
finish else if pcflag = 'Q' or pcflag = 'K' c
or flag = 'K' or flag = 'Q' start
out string("%K") if flag = 'K'; out string("%Q") if flag = 'Q'
out string(text)
text = substring(text,2,length(text)) while length(text) > 0 and char no(text,1) = ' '
if text = "" start
if pcflag = 0 and term = ret start
out symbol(nl)
else
out control(term)
out symbol(nl) unless flag = 'K' or (mode=nomac and pcflag='K')
finish
else
out symbol(term)
out symbol(nl) unless term = ret
finish
else
out string(text)
! VECCE handling of controls as terminators is rather ad hoc.
if ci = cmax1 {Command entry} start
! Allow for null line composed of spaces
length(text) = length(text) - 1 while c
length(text) > 0 and char no(text,length(text)) = ' '
out control(term) if text = "" and pcflag = 0
finish else if (mode>=0 and term#ret) {control term of I!,O! or S!} start
out symbol(nl)
out control(term)
finish else if (mode = standard and term # ret and code = 'G') start
out symbol(nl) if text # ""
if num # 0 start ; ! Control terminator of G
out symbol(':'); out symbol(nl); ! Simulate with normal termination
finish
out control(term)
finish
out symbol(nl)
finish
exit:
select output(0) if keeplog > 0
end
routine READ TEXT(integer mode)
!MODE = nomac,standard,replacing,inserting
![most of the business of interfacing to lower-level screen
! input facilities is concentrated here]
integer p,q,q0,pos,lim,dumbinsert,insertpos,col,j,c
on event 9 start
if commandstream # 0 start
close in
o_emode = 1 and eflag = 0 if eflag # 0
else ; !input 0 EOF
!$IF VAX OR AMDAHL
signal 13; ! Exit and Close edit
!$IF APM
{ open input(0,":T"); select input(0)
{ read symbol(q); !!***TEMP ignore spurious NL***
!$FINISH
finish
signal 14
finish
q = 0
cycle ; !find free buffer (there are 4)
p = q; q = q+128
repeat until not (p <= cdef&posmask < q c
or p <= mdef&posmask < q c
or p <= idef&posmask < q)
q = p; initdels = 0; dels = 0; repairch = 0
mode = standard if mode >= 0 and video = 0; ! Not for hardcopy
if mode >= 0 start ; !data entry
length(newprom) = 2
if sin&(\1) = 0 and lend # cur_lim2 start
if mode # 0 then newprom = newprom."INSERTING" c
else newprom = newprom."REPLACING"
finish
if newprom # curprom start
curprom = newprom
cat(0,0); printstring(curprom); clear line
finish
finish
dumbinsert = 0; insertlen = 0
mode = replacing if mode = inserting and sin&(\1) # 0; !Don't allow delete while showing
if mode = inserting start ; ! Choose and set dumb/clever insert mode
if vdu_fun&caninsert#0 start ; ! Terminal has insert capability
insertpos = fp
if o_exptabs # 0 start ; ! Use dumb mode if there is a tab
while insertpos < lend cycle ; ! on the rest of the line
dumbinsert = 1 and exit if byteinteger(insertpos) = tab
insertpos = insertpos + 1
repeat
finish
finish else dumbinsert = 1
! Appropriate mode is INSERTING for clever terminals,
! SINGLE for less clever ones
! NODELECHO tells VTLIB to pass all dels without any echoing
if dumbinsert = 0 then set video mode(smode ! insertmode ! nodelecho) c
else if fp < lend then set video mode(smode ! single) c
else set video mode(smode ! nodelecho)
insertpos = fp; insertpos = lend if fp > lend
finish else if mode = replacing start
! NODELECHO mode so that we can redraw characters overwritten and then deleted.
! This is not essential if it is problemetic over the network, variable
! DELS will handle refresh in that case.
set video mode(smode ! nodelecho)
finish
t = 0
col = tabcol(fp,cur_lbeg,0)+o_mark-cur_shift
again:
at(cur_line-cur_diff,col) if mode >= 0
cycle
read symbol(term)
unless ' ' <= term <= del+1 or (commandstream > 0 and term # ret) start
exit if mode = nomac
pos = def(term)
if pos < macro start ; !test for text macro
exit
! %exit %unless pos&128 = 0
! %cycle
! term = pos&127; print symbol(term)
! mac(q) = term; q = q+1; q = q-1 %if q&127 = 0
! pos = pos>>8
! %repeat %until pos = 0
else
exit unless mac(pos&posmask)&128 = 0; !not text macro
lim = pos>>limshift; pos = pos&posmask
while pos < lim cycle
term = mac(pos)
mac(q) = term; q = q+1; q = q-1 if q&127 = 0
pos = pos+1
if o_exptabs # 0 and term = tab and mode >= 0 start
c = col - o_mark + cur_shift
t = t + 1 while t < maxtab and o_tabs(t) <= c
insertdif = 0
cycle
c = c + 1; col = col + 1
print symbol(' ') if col >= 0
insertdif = insertdif + 1 and insertlen = insertlen + 1 if mode = inserting
repeat until c >= o_tabs(t)
else
if term < ' ' then printsymbol('_') else print symbol(term)
col = col + 1
insertdif = 1 and insertlen = insertlen + 1 if mode = inserting
finish
repeat
if dumbinsert # 0 and insertpos < lend start ; ! Redraw rest of line after itext macro
at(cur_line-cur_diff,col)
vp = insertpos; display line
at(cur_line-cur_diff,col)
finish
finish
finish else if term = del start
if mode = inserting start
if q > p or fp # cur_lbeg start
col = col - 1; q0 = q;
if insertlen > 0 then insertlen = insertlen - 1
insertdif = -1
if q = p start ; ! Delete file text - simulate E-
fp = lend if fp > lend
if fp # cur_lbeg start ; ! Don't delete newline
split(0)
consolidate(1,-1)
cur_change = altmin if altmin < cur_change
altlim = floor; altmin = ceiling
finish
insertpos = fp
output logfile(p,q,mode) if keeplog # 0; ! Put E- into LOG
finish else q = q - 1
if o_exptabs # 0 and c
((q0 > p and mac(q) = tab) or c
(q0 = p and byteinteger(cur_lim1) = tab)) start
c = tabcol(fp,cur_lbeg,0)
t = 0; t = t + 1 while t < maxtab and o_tabs(t) <= c
for j = p,1,q-1 cycle
if mac(j) = tab and tab < maxtab start
c = o_tabs(t); t = t + 1
finish else c = c + 1
repeat
c = c+o_mark-cur_shift
if insertlen > 0 then insertlen = insertlen + c - col
insertdif = c - col - 1
col = c
if fp < lend start
vp = insertpos
set video mode(smode) if dumbinsert = 0
at(cur_line-cur_diff,col); display line
set video mode(smode!insertmode!nodelecho) if dumbinsert = 0
finish
at(cur_line-cur_diff,col)
finish else if dumbinsert # 0 and insertpos < lend start
at(cur_line-cur_diff,col)
vp = insertpos; display line
at(cur_line-cur_diff,col)
finish else if q0 = p and fp = lend start
col = tabcol(fp+1,cur_lbeg,0)+o_mark-cur_shift
at(cur_line-cur_diff,col)
print symbol(del)
finish else print symbol(del)
finish
finish else if mode = replacing start
if q > p start
q = q-1
if fp+(q-p) < lend start
printsymbol(bs)
printsymbol(byteinteger(fp+(q-p))); !restore original
printsymbol(bs)
finish else print symbol(del); !specially treated by VTI
finish
finish
else
mac(q) = term; q = q+1; q = q-1 if q&127 = 0
dels = dels - 1 if dels > 0
col = col + 1
if dumbinsert # 0 start
insertlen = insertlen + 1 if mode = inserting
insertdif = 1
if insertpos < lend start
! at(cur_line-cur_diff,col)
vp = insertpos; display line
at(cur_line-cur_diff,col)
finish
finish
finish
repeat
if mode >= 0 then set video mode(smode)
output logfile(p,q,mode) if keeplog # 0
insertlen = 0; insertdif = 0
newdef = q<<16+p and return if q > p
newdef = null
return if mode < 0; !not data entry
dels = 0 and initdels = 0 if fp >= lend
end
!
routine READ COMMAND LINE
read text(standard)
inpos = newdef&posmask; inlim = newdef>>16
end
!
routine GET SYM
!Extract next command input symbol
!Deal with macro termination
if pend # 0 start
sym = pend; pend = 0
else
while inpos >= inlim cycle
sym = ret and return if msp = 0
msp = msp-1
! inpos = mstack(msp)&posmask; inlim = mstack(msp)>>limshift
inlim = mstack(msp); inpos = inlim&posmask; inlim = inlim>>limshift
repeat
sym = mac(inpos)&127; inpos = inpos+1
finish
end
!
!!!!!!!!!!!!!!!!!!! Symbol types !!!!!!!!!!!!!!!!!!!!!!!!!!
! 0-3:non-commands 4-7:alteration group 7-9:location group
! 0:numeric 1:terminator 2:illegal 3:quote
! 4: 5:ABCEJKLR@$ 6:ISOG 7:DU
! 8:F 9:TV 10:MNP<>{} 11:( ,
! 12:^ 13:: 14:) 15:? \ $ =
!High-order bits used to classify chars in file:
constinteger lowercase=16_10,digit=16_20,uppercase=16_30,
letter=16_10,upperordigit=16_20,alphanum=16_30,
opener=16_40,closer=16_80
constbyteintegerarray SYMTYPE(0:255) = c
16_01 (32),
16_02{ }, 16_03{!}, 16_03{"}, 16_0A{#},
16_0F{$}, 16_02{%}, 16_03{&}, 16_03{'},
16_4B{(}, 16_8E{)}, 16_00{*}, 16_0A{+},
16_0B{,}, 16_02{-}, 16_03{.}, 16_03{/},
16_20{0}, 16_20{1}, 16_20{2}, 16_20{3},
16_20{4}, 16_20{5}, 16_20{6}, 16_20{7},
16_20{8}, 16_20{9}, 16_0D{:}, 16_01{;},
16_0A{<}, 16_0F{=}, 16_0A{>}, 16_0F{?},
16_05{@}, 16_35{A}, 16_35{B}, 16_35{C},
16_37{D}, 16_35{E}, 16_38{F}, 16_36{G},
16_3A{H}, 16_36{I}, 16_35{J}, 16_35{K},
16_3A{L}, 16_3A{M}, 16_3A{N}, 16_36{O},
16_3A{P}, 16_3A{Q}, 16_3A{R}, 16_36{S},
16_39{T}, 16_37{U}, 16_39{V}, 16_32{W},
16_32{X}, 16_32{Y}, 16_32{Z}, 16_42{[},
16_0F{\}, 16_82{]}, 16_0C{^}, 16_02{_},
16_02{`}, 16_12{a}, 16_12{b}, 16_15{c},
16_17{d}, 16_15{e}, 16_18{f}, 16_15{g},
16_12{h}, 16_15{i}, 16_12{j}, 16_15{k},
16_1A{l}, 16_1A{m}, 16_1A{n}, 16_15{o},
16_12{p}, 16_1A{q}, 16_1A{r}, 16_12{s},
16_17{t}, 16_12{u}, 16_12{v}, 16_12{w},
16_12{x}, 16_12{y}, 16_12{z}, 16_4A{{},
16_0F{|}, 16_8A{}, 16_0F{~}, 16_02{127},
16_02 (128)
!
routine NUMBER
!Test for numeric item
if symtype(sym)&15 = 0 start
type = 0; num = 0
if sym = '*' then get sym else start
cycle
num = num*10+sym-'0' if num < 100000
get sym
repeat until not '0' <= sym <= '9'
finish
finish
end
!
routine READ MATCH TEXT
string (7) prom
prom = tostring(code&(\casebit)); prom = prom."-" if code&casebit # 0
prom = prom.">"
vt prompt(prom)
prepare for input
cat(0,0); clear line
curprom = ""
read text(standard)
vt prompt("")
mdef = newdef
remove pointer if o_emode # 0; !in data entry mode
end
!
routine READ NUMBER
integer pos,lim,m
prepare for input
cat(0,0); clear line
vt prompt(tostring(code).">")
curprom = ""
pos = inpos; lim = inlim; m = msp
msp = 0
read command line
vt prompt("")
remove pointer if o_emode # 0; !in data entry mode
pend = 0; num = 0
get sym; number
inpos = pos; inlim = lim; msp = m
end
!
! F i l e m a n i p u l a t i o n r o u t i n e s
!
integerfn distance(integer from,to)
if cur_start2 <= to <= cur_lim2 start
from = from+(cur_start2-cur_lim1) unless cur_start2 <= from <= cur_lim2
else
to = to+(cur_start2-cur_lim1) if cur_start2 <= from <= cur_lim2
finish
result = to-from
end
!
routine MOVE BLOCK(integer length,from,to)
!Move block of file, dealing with overlap & relocation
!The following are relocated: FP, LBEG, LEND, FOUNDPOS, MARKPOS
! NB FP <= LEND
integer reloc,limit
reloc = to-from; limit = from+length
if from <= fp < limit start
fp = fp+reloc; cur_lbeg = cur_lbeg+reloc; !LBEG always relative to FP
finish
lend = lend+reloc if from <= lend < limit
foundpos = foundpos+reloc if from <= foundpos < limit
markpos = markpos+reloc if from <= markpos < limit
while reloc > 0 and length > reloc cycle ; !down and bigger than gap
length = length-reloc
move(reloc,from+length,to+length)
repeat
move(length,from,to)
end
routine COPY ACROSS
move block(cur_lim2-oldstart2,oldstart2,oldstart2+gdiff)
cur_start2 = cur_start2+gdiff; oldstart2 = oldstart2+gdiff
if fp = cur_lim2 start ; !hence not relocated
fp = newlim; cur_lbeg = fp; lend = fp
finish
cur_lim2 = newlim; gdiff = 0
end
routine MAKE ROOM(integer mingap)
!The gap has become too small: shuffle to enlarge it
integer amount,gap
copy across if gdiff # 0
amount = cur_lim-delmax-1; gap = oldstart2-cur_lim1
gasp if amount+gap < mingap
amount = amount>>1 if amount>>1+gap >= mingap
move block(delmax+1-oldstart2,oldstart2,oldstart2+amount)
oldstart2 = oldstart2+amount; cur_start2 = cur_start2+amount
cur_lim2 = cur_lim2+amount; newlim = newlim+amount
delmax = delmax+amount; lastdelmax = lastdelmax+amount
end
!
routine STORE DELETIONS
integer l,k
!Discard part line
if cur_start2-consolidated > oldstart2 start
delmax = delmax-1 while byteinteger(delmax) # nl
lastdelmax = delmax
cycle
l = cur_start2-consolidated-oldstart2
exit if l <= 0
if l+delmax >= cur_lim start
copy across if gdiff # 0
k = oldstart2-cur_lim1; gasp if k <= 0
if k > 1024 start ; !a bit much
if k > l > 1024 then k = l else k = 1024
finish
move block(delmax+1-oldstart2,oldstart2,oldstart2-k)
cur_start2 = cur_start2-k; oldstart2 = oldstart2-k
cur_lim2 = cur_lim2-k; newlim = newlim-k
delmax = delmax-k; lastdelmax = lastdelmax-k
l = k if k < l
finish
move(l,oldstart2,delmax+1)
oldstart2 = oldstart2+l; delmax = delmax+l
repeat
finish
oldstart2 = cur_start2; consolidated = 0
end
routine SPLIT(integer mingap)
!Create gap ahead of FP
integer j
if fp # cur_start2 start
update if altlim # floor
store deletions if oldstart2 < cur_start2
foundpos = 0 if foundpos < fp < foundpos+foundsize
if cur_start1 <= fp < cur_lim1 start ; !fp in upper half
copy across if gdiff # 0
j = cur_lim1-fp; !amount to shift down
cur_lim1 = cur_lim1-j; cur_start2 = cur_start2-j
move block(j,cur_lim1,cur_start2)
else ; !fp in lower half (old or new)
j = fp-cur_start2
move block(j,cur_start2,cur_lim1)
cur_lim1 = cur_lim1+j; cur_start2 = cur_start2+j
finish
oldstart2 = cur_start2; oldlim1 = cur_lim1
finish
if cur_lim1 < altmin start
altmin = cur_lim1
altline = cur_line; gapline = altline
finish
if cur_start2 > altlim start
altlim = cur_start2; altlimlbeg = cur_lbeg
finish
if mingap # 0 start
make room(mingap) if oldstart2+gdiff-cur_lim1 < mingap
finish
end
!
routine BREAK
!Break line in two (SPLIT already called)
byteinteger(cur_lim1) = nl; cur_lim1 = cur_lim1+1
joins = joins-1
markline = markline+1 if markline >= cur_line
cur_line = cur_line+1; gapline = gapline+1
cur_lbeg = fp
make room(mingap) if oldstart2+gdiff-cur_lim1 < mingap
end
!
routine CONSOLIDATE(integer amount,mode)
! Make it possible to move or erase FP back over the gap
! (in the former case, ensure that the gap lies on a
! line boundary by copying up the remainder of a split line
! or inserting a newline at end of file)
return if cur_lim1 = cur_start1 or mode > 0; !sec in (??)
if mode < 0 start ; !erasing
cycle
markpos = 0 if cur_lim1-1 = markpos; ! Erased over marker
cur_lim1 = cur_lim1-1
if cur_lim1 < altmin start
altmin = cur_lim1
if cur_lim1 < oldlim1 start
copy across if gdiff # 0
oldlim1 = cur_lim1; oldstart2 = oldstart2-1
byteinteger(oldstart2) = byteinteger(oldlim1)
finish
finish
cur_lbeg = cur_lbeg+1
amount = amount-1
repeat until amount <= 0
return
finish
if byteinteger(cur_lim1-1) # nl start ; !gap in mid-line
if cur_start2 # cur_lim2 start ; !not at end of file
consolidated = lend+1-cur_start2
move block(consolidated,cur_start2,cur_lim1)
cur_lim1 = cur_lim1+consolidated; cur_start2 = cur_start2+consolidated
gapline = gapline+1
else
split(mingap)
break
amount = 0
finish
finish
fp = fp-amount
end
!
routine JUMP TO(integer newfp)
if cur_start1 <= newfp < cur_lim1 and not cur_start1 <= fp < cur_lim1 start
if sin < 0 start
consolidate(cur_lim1-newfp,sin)
else
fp = cur_start2; cur_lbeg = fp; set lend
consolidate(0,0)
fp = newfp
finish
else
fp = newfp
return if cur_lbeg <= fp <= lend
finish
set lbeg(cur_lbeg,fp); set lend
end
!
integerfn LINE AFTER
!Test Move possible and if so perform it
! update %if altlim # floor
result = 0 if lend = cur_lim2
lend = lend+1
lend = cur_start2 if lend = cur_lim1
fp = lend; cur_lbeg = fp
cur_line = cur_line+1
if lend # cur_lim2 start
lend = lend+1 while byteinteger(lend) # nl
finish
result = 1
end
!
integerfn LINE BEFORE
!Set FP to end of previous line if there is one
update if altlim # floor
fp = lend if fp > lend
if cur_lbeg < cur_start2 <= fp then consolidate(fp-cur_lbeg,sin) c
else fp = cur_lbeg
result = 0 if fp = cur_start1
if fp = cur_start2 start
result = 0 if cur_lim1 = cur_start1
fp = cur_lim1
finish
cur_line = cur_line-1
if sin < 0 start
fp = cur_start2; !restore
consolidate(1,-1)
altline = cur_line; gapline = altline
joins = joins+1
else
fp = fp-1; lend = fp
finish
set lbeg(cur_lbeg,fp)
result = 1
end
!
routine EXTEND LINE
!Append spaces when FP beyond end of line
integer hold
hold = fp-lend; fp = lend
split(mingap)
while hold > 0 cycle
byteinteger(cur_lim1) = ' '; cur_lim1 = cur_lim1+1
cur_lbeg = cur_lbeg-1; hold = hold-1
repeat
end
!
routine INSERT(integer DEF)
!Insert text specified by DEF
integer pos,lim
pos = def&posmask; lim = def>>limshift
return if pos >= lim
if fp > lend start
fp = lend if mac(pos) = nl
extend line
finish else split(mingap)
cycle
if mac(pos) = nl then break else start
byteinteger(cur_lim1) = mac(pos)
cur_lim1 = cur_lim1+1; cur_lbeg = cur_lbeg-1
finish
pos = pos+1
repeat until pos = lim
cur_change = altmin if altmin < cur_change
end
routine OVERWRITE(integer DEF)
!Overwrite existing text with text specified by DEF
integer pos,lim, c, s2
pos = def&posmask; lim = def>>limshift
return if pos >= lim
if fp > lend start
fp = lend if mac(pos) = nl
extend line
finish else split(mingap)
s2 = cur_start2; ! Store it
cycle
if mac(pos) = nl start
make room(mingap) if oldstart2+gdiff-cur_lim1 <= mingap
! %while fp < lend %cycle ; ! This code is wrong
! byteinteger(cur_lim1) = mac(fp) ; ! mac(fp) doesn't make sense
! cur_lim1 = cur_lim1+1; fp = fp+1 ;
! %repeat ;
fp = fp + 1 while fp < lend; ; ! Correction KR Apr 87
if fp # cur_lim2 start
fp = fp+1; cur_lbeg = fp; set lend
cur_line = cur_line+1; gapline = gapline+1
altlimlbeg = cur_lbeg if altlim < fp
finish
else
if fp < lend start
if o_exptabs # 0 start
cur_start2 = fp
if byteinteger(fp) = tab and mac(pos) # tab start
if tabcol(fp+1,cur_lbeg,0) - tabcol(fp,cur_lbeg,0) = 1 c
then fp = fp + 1 else cur_lbeg = cur_lbeg - 1
finish else if mac(pos) = tab and byteinteger(fp) # tab start
c = tabcol(fp,cur_lbeg,1) - tabcol(fp,cur_lbeg,0)
cur_lbeg = cur_lbeg - 1
while c > 0 cycle
c = c - 1
fp = fp + 1
cur_lbeg = cur_lbeg + 1
exit if byteinteger(fp) = nl or byteinteger(fp-1) = tab
repeat
finish else fp = fp + 1
finish else fp = fp + 1
finish else cur_lbeg = cur_lbeg - 1
finish
byteinteger(cur_lim1) = mac(pos)
cur_lim1 = cur_lim1+1; pos = pos+1
repeat until pos = lim
markpos = 0 if s2 <= markpos < fp; ! Overwritten marker
cur_start2 = fp; altlim = cur_start2 if altlim < cur_start2
cur_change = altmin if altmin < cur_change
end
routine JOIN
! Erase from FP to end of line AND the line terminator
! (covers Kill, Join, Uncover)
! SPLIT already called
integer j
markpos = 0 if cur_start2 <= markpos <= lend
j = lend-fp+1
cur_lbeg = cur_lbeg+j; fp = fp+j; cur_start2 = cur_start2+j
joins = joins+1
if altlim < cur_start2 start
altlim = cur_start2; altlimlbeg = altlim
finish
set lend
markline = markline-1 if markline > cur_line
end
!
routine SWITCH
! Switch between main and secondary input
update if altlim # floor
if sin < 0 start ; !what are you doing here?
altlim = floor; sin = 0
return
finish
cur_fp = fp; !store
markpos = 0; !clear marker
sin = sin!!2
if sin >= 2 start ; !main -> sec
cur == sec
if cur_min = 0 start
cur_min = 10; cur_win = offscreen
coerce parameters
finish
if cur_line = 0 start ; !indicator for reset
cur_line = 1
cur_fp = sec_start2; cur_lbeg = cur_fp
cur_win = offscreen; cur_diff = unknown
finish
else ; !sec -> main
cur == main
if cur_flag >= ' ' start
if cur_win <= cur_line-cur_diff < cur_bot start
cur_row = cur_line-cur_diff
at(cur_row,tabcol(cur_fp,cur_lbeg,0)); print symbol(cur_flag)
finish
cur_flag = 0
finish
finish
fp = cur_fp
set lend
end
!
integerfn MATCHED
! Compare text @FP with text @MPOS:MLIM (full pointers)
integer p,pos,k,l
p = fp; pos = mpos
cycle
k = byteinteger(pos)
result = 0 if k = nl
l = k!!byteinteger(p)
if l # 0 start
result = 0 if l&casemask # 0 or symtype(k)&alphanum = 0
finish
p = p+1; pos = pos+1
repeat until pos = mlim
foundpos = fp; foundsize = p-fp
result = 1
end
!
! extract next command
!
execute:
ci = 0
ci = cmax1 if cmax > cmax1
next: s('?'):
ci = ci+1
code = r(ci)_code; ref = r(ci)_ref
num = r(ci)_count
-> s(code) if sin&(\1) = 0 or symtype(code)&15 >= 8
disallowed:
complain("* Moving commands only")
!
! Successful return from execution
oklast:
last = code
ok:
num = num-1
-> next if num = 0
-> s(code)
fail:
num = 1
! Failure return
no: s('\'):
cycle
-> next if num <= 0; !indefinite repetition ->
ci = ci+1; !check following cell:-
-> next if r(ci)_code = '\'; !invert ->
-> next if r(ci)_code = '?'; !query ->
while r(ci)_code # ')' cycle
-> next if r(ci)_code = ','; !comma ->
ci = r(ci)_ref if r(ci)_code = '('
ci = ci+1
repeat
num = r(ci)_count
repeat until ci >= cmax
-> read if num <= 0
!
!E x e c u t i o n e r r o r
!
s(*): ![safety]
!suppress report for simple moves as control key macros
-> read if control >= 0 and def(control) < 127 c
and symtype(def(control))&15 = 10
cat(1,chalf)
printstring(" Failure: ")
print code(code)
if 7 <= symtype(code)&15 <= 9 start ; !text matching group
print symbol('''')
hold = mpos
mlim = 0 if hold = null; !No stored text
cycle
print symbol('''') and exit if hold >= mlim
print symbol('_') and exit if byteinteger(hold) < ' '
print symbol(byteinteger(hold))
hold = hold+1
repeat until hold-mpos >= chalf
finish
newline
error = 1
-> ignore
!
!I n d i v i d u a l c o m m a n d s
!
s('('): !open bracket
r(ref)_count = num; !restore count on ')'
-> next
!
s(')'): !close bracket
num = num-1
if num # 0 and num # stopper start
r(ci)_count = num; !update
ci = ref; !position of '('
else
-> read if ci >= cmax
finish
-> next
!
s(','): !comma
ci = ref-1; !position of ')' - 1
-> next
!
s('P'):
display(0)
-> ok if num = 1
s('M'): !Move
-> no if line after = 0
fp = fp+o_margin if lend # cur_lim2
-> ok
!
s('}'): !Cursor down
hold = tabcol(fp,cur_lbeg,0)
-> no if line after = 0
fp = coltab(hold,cur_lbeg) + cur_lbeg if fp # cur_lim2
-> oklast
s('{'): !Cursor up
fp1 = fp
hold = tabcol(fp,cur_lbeg,0)
fp = fp1 and -> no if line before = 0
hold = coltab(hold,cur_lbeg) + cur_lbeg
if hold < cur_start2 <= fp then consolidate(fp-hold,sin) c
else fp = hold
-> oklast
s('<'): !Cursor Left
-> no if fp = cur_lbeg
last = code
-> left
s('>'): !Cursor right
-> no if tabcol(fp,cur_lbeg,0) >= o_width or lend = cur_lim2
fp = fp+1
->oklast
!
s('#'): !absolute line n
if num = 0 start
read number
-> fail if num = 0
finish
code = 'M'
num = num-cur_line
-> next if num = 0
-> s('M') if num > 0
num = -num; code = 'm'
s('m'): !Move back
-> no if line before = 0
if num = 0 start ; !M-*
if cur_start1 # cur_lim1 then jump to(cur_start1) c
else jump to(cur_start2)
cur_line = 1
finish
hold = cur_lbeg+o_margin; hold = lend if hold > lend
if hold < cur_start2 <= fp then consolidate(fp-hold,sin) c
else fp = hold
-> ok
!
s('C'): !Case-change with right-shift
-> no if fp >= lend
split(mingap)
holdsym = byteinteger(fp)
holdsym = holdsym!!casebit if symtype(holdsym)&letter # 0
byteinteger(cur_lim1) = holdsym
markpos = 0 if fp = markpos; ! Destroyed marker
cur_lim1 = cur_lim1+1; fp = fp+1
cur_start2 = fp; altlim = cur_start2 if altlim < cur_start2
-> ok
!
s('R'): s('l'): !Right-shift
-> no if fp >= lend
fp = fp+1
-> ok
!
s('c'): !Case-change with left-shift
![unsatisfactory]
fp = lend if fp > lend
-> no if fp = cur_lbeg
split(mingap)
copy across if gdiff # 0
markpos = 0 if cur_lim1-1 = markpos; ! Erased over marker
cur_lim1 = cur_lim1-1; oldlim1 = cur_lim1
altmin = cur_lim1 if altmin > cur_lim1
holdsym = byteinteger(cur_lim1)
holdsym = holdsym!!casebit if symtype(holdsym)&letter # 0
fp = fp-1; cur_start2 = cur_start2-1
oldstart2 = cur_start2; consolidated = 0
byteinteger(fp) = holdsym
-> ok
s('L'): s('r'): !Left-shift
fp = lend if fp > lend
-> no if fp = cur_lbeg
left:
if fp = cur_start2 then consolidate(1,sin) else fp = fp-1
-> ok
!
s('H'): !Home (multi-function)
if last = '<' start
num = 0
if fp = cur_lbeg+pan and pan # 0 start
num = o_wcols>>1; pan = pan-num
finish
finish else if last = '>' start
num = lend-fp
-> next if num <= 0
if fp = cur_lbeg+pan+o_wcols start
num = o_wcols>>1; pan = pan+num
finish
finish else if last = '{' start
update
num = cur_line-cur_diff-cur_win
num = num - (cur_bot-cur_top)>>2 if o_early # 0
num = cur_min-2 if num <= 0
num = 1 if num <= 0
else
update
num = cur_bot-1-(cur_line-cur_diff)
num = num - (cur_bot-cur_top)>>2 if o_early # 0
num = cur_min-2 if num <= 0
num = 1 if num <= 0
finish
code = last
-> s(code)
!
s('E'): !Erase
-> no if fp >= lend
split(0)
cur_lbeg = cur_lbeg+1
markpos = 0 if fp = markpos; ! Destroyed marker
fp = fp+1; cur_start2 = fp
altlim = cur_start2 if altlim < cur_start2
-> ok
!
s('e'): !Erase back
fp = lend if fp > lend
-> no if fp = cur_lbeg
split(0)
consolidate(1,-1)
-> ok
!
s('V'): !Verify
mpos = null
-> no if fp >= lend
if ref = 0 then read match text c
else if ref # '"' then mdef = def(ref)
mpos = mdef&posmask+mac0; mlim = mdef>>limshift+mac0
holdsym = byteinteger(mpos); !first symbol of quoted text
-> no if mpos # mlim and matched = 0
-> next
!
s('D'): !Delete
s('T'): !+ Traverse
if ref = 0 then read match text c
else if ref # '"' then mdef = def(ref)
fp1 = fp
-> find
!
s('U'): !Uncover
s('F'): !+Find
if ref = 0 then read match text c
else if ref # '"' then mdef = def(ref)
fp1 = fp
fp = fp+1 if fp = foundpos
find:
scope = r(ci)_scope; !number of lines to search
-> next if mdef < macro; !null
mpos = mdef&posmask+mac0; mlim = mdef>>limshift+mac0
holdsym = byteinteger(mpos); !first symbol of quoted text
cycle
while fp < lend cycle
if (byteinteger(fp)!!holdsym)&casemask = 0 start
-> found if matched # 0
finish
fp = fp+1
repeat
exit if fp = cur_lim2
scope = scope-1
exit if scope = 0
if code # 'U' start
exit if line after = 0
else
fp = fp1; fp = lend if fp > lend
split(0); join
finish
fp1 = fp
repeat
fp = fp1
-> no
found:
-> ok if code = 'F'
fp = fp+foundsize and -> ok if code = 'T'
found1:
if code # 'U' start ; !'D','d'
split(0)
hold = foundsize
else
hold = fp-fp1; fp = fp1
split(0); foundpos = fp+hold
finish
markpos = 0 if cur_start2 <= markpos < cur_start2+hold; ! Destroyed marker
cur_lbeg = cur_lbeg+hold; fp = fp+hold; cur_start2 = cur_start2+hold
altlim = cur_start2 if altlim < cur_start2
-> ok
!
s('t'): s('d'):
s('f'): !Find back
mpos = null
-> no if sin < 0; !**for now [too difficult]
fp = lend if fp > lend
scope = r(ci)_scope
if ref = 0 then read match text c
else if ref # '"' then mdef = def(ref)
-> next if mdef < macro
mpos = mdef&posmask+mac0; mlim = mdef>>limshift+mac0
holdsym = byteinteger(mpos); !first symbol of quoted text
update
cycle
while fp = cur_lbeg cycle
scope = scope-1
-> no if scope = 0 or line before = 0
repeat
if fp = cur_start2 then consolidate(1,sin) c
else fp = fp-1
repeat until (byteinteger(fp)!!holdsym)&casemask = 0 c
and matched # 0
-> ok if code = 'f'
fp = fp+foundsize and -> ok if code = 't'
-> found1
!
s('q'):
complain("Private dictionary not available")
constinteger termbit=1<<16, lastbit=1<<15, dummy='a'-1
s('Q'): !Query spelling
if dict = 0 start
connect dictionary(dict)
complain("Dictionary not available") if dict = 0
finish
if fp = foundpos and foundsize < 0 start ; !already Queried
fp = fp+1 until symtype(byteinteger(fp))&letter = 0
finish
qnext:
cycle
while fp >= lend cycle
-> no if fp = cur_lim or line after = 0
repeat
qsym = byteinteger(fp)
exit if symtype(qsym)&letter # 0
fp = fp+1
repeat
foundpos = fp; foundsize = -1
qagain:
fp1 = fp
hold = termbit>>10
dictpos = integer(dict+qsym<<2)
cycle
fp1 = fp1+1; holdsym = byteinteger(fp1)-dummy
if holdsym <= 0 or holdsym > 26 start ; !end of word
if hold&termbit>>10 # 0 start ; !successful match
-> ok if num > 0; !not Q*
fp = fp1
-> qnext
finish
exit
finish
-> qno if dictpos = 0
dictpos = dictpos+dict
cycle
hold = integer(dictpos)
exit if hold&31 = holdsym
-> qno if hold&lastbit # 0
dictpos = dictpos+4
repeat
hold = hold>>5
if hold&31 # 0 start
fp1 = fp1+1
exit if hold&31+dummy # byteinteger(fp1)
finish
hold = hold>>5
if hold&31 # 0 start
fp1 = fp1+1
exit if hold&31+dummy # byteinteger(fp1)
finish
dictpos = hold>>5&(\3)
repeat
holdsym = byteinteger(fp1)
-> ok if holdsym = '-' or symtype(holdsym)&upperordigit # 0
qno:
! Failed to find a match in dictionary - carry on to end of word so
! that we can build the whole word into word
cycle
exit if symtype(byteinteger(fp1))&letter = 0
fp1 = fp1+1
repeat
! We can call a private dictionary lookup here if we want
integerfn in private dictionary
! uses fp and fp1 as limits of a word to be checked
! return 0 if not found in private dictionary else non-zero
string (30) word
integer i
! %owninteger x = 50 ;! debugging purposes only !!!
! x = x - 1
i = fp1 - fp
i = 30 if i > 30
move(i, fp, addr(word)+1)
length(word) = i
! %if x <= 0 %then complain("looping on word:")
{ look up word in private dictionary }
{ %if found in dictionary %then %start }
{ %result = 1 }
{ %finish %else %start }
cat(1,chalf)
printstring("'".word."' not in dictionary")
newline
result = 0
{ %finish }
end
if in private dictionary # 0 then start
! word found ok in private dictionary so treat it as found
-> ok if num > 0; !not Q*
fp = fp1
-> qnext
finish
-> no if qsym >= 'a'
qsym = qsym+casebit
-> qagain
integerfn found closer
integer k
k = byteinteger(fp)+2; k = ')' if k = '('+2
cycle
fp = fp+1
result = 0 if fp >= lend
result = 1 if byteinteger(fp) = k
if symtype(byteinteger(fp))&opener # 0 start
result = 0 if found closer = 0
finish
repeat
end
s('N'): !Next word/element
-> no if lend = cur_lim2
fp = lend if fp > lend
holdsym = byteinteger(fp)
hold = symtype(holdsym)
if hold&alphanum # 0 or holdsym <= ' ' start
fp = fp+1 while symtype(byteinteger(fp))&alphanum # 0
cycle
while fp >= lend cycle
-> no if line after = 0
repeat
exit if symtype(byteinteger(fp))&alphanum # 0
fp = fp+1
repeat
foundsize = 0
finish else if hold&opener # 0 start
-> no if found closer = 0
foundsize = 1
else
cycle
fp = fp+1
-> no if fp >= lend
repeat until byteinteger(fp) = holdsym
foundsize = 1
finish
foundpos = fp
-> ok
!
routine backup
if fp = cur_start2 start
holdsym = byteinteger(cur_lim1-1)
consolidate(1,sin)
else
fp = fp-1; holdsym = byteinteger(fp)
finish
end
integerfn found opener
integer k
k = holdsym-2; k = '(' if k = ')'-2
cycle
result = 0 if fp = cur_lbeg
backup
result = 1 if holdsym = k
if symtype(holdsym)&closer # 0 start
result = 0 if found opener = 0
finish
repeat
end
s('n'): !Locate previous word/element
if fp >= lend start
fp = lend; holdsym = ' '
finish else holdsym = byteinteger(fp)
hold = symtype(holdsym)
if hold&alphanum # 0 or holdsym = ' ' start
cycle
while fp = cur_lbeg cycle
-> no if line before = 0
repeat
backup
repeat until symtype(holdsym)&alphanum # 0
cycle
exit if fp = cur_lbeg
if fp = cur_start2 start
exit if symtype(byteinteger(cur_lim1-1))&alphanum = 0
consolidate(1,sin)
else
exit if symtype(byteinteger(fp-1))&alphanum = 0
fp = fp-1
finish
repeat
foundsize = 0
finish else if hold&closer # 0 start
-> no if found opener = 0
foundsize = 1
else
hold = holdsym
cycle
-> no if fp = cur_lbeg
backup
repeat until hold = holdsym
foundsize = 1
finish
foundpos = fp
-> ok
!
s('S'): !Substitute
-> no if fp # foundpos
if foundsize <= 0 start ; !following 'N' etc
fp1 = fp
fp1 = fp1+1 until symtype(byteinteger(fp1))&alphanum = 0
foundsize = fp1-fp
finish
split(0)
markpos = 0 if fp <= markpos < fp+foundsize; ! Destroyed marker
cur_lbeg = cur_lbeg+foundsize; fp = fp+foundsize; cur_start2 = fp
altlim = cur_start2 if altlim < cur_start2
!
s('I'): !+Insert
-> no if tabcol(fp,cur_lbeg,0) > o_width and code # 'S'
if ref = 0 start
-> over if fp >= lend
if video # 0 start
display(o_early)
read text(inserting)
else
vt prompt("I>")
read text(standard)
vt prompt("")
finish
idef = newdef
if idef >= macro start
hold = tabcol(fp,cur_lbeg,0)
insert(idef)
altlim = floor and altmin = ceiling if hold >= cur_shift
finish
->controlterm if term # ret
else
idef = def(ref) if ref # '"'
-> next if idef < macro
insert(idef)
finish
-> ok
!
!Recovery commands
s('o'): !Overwrite back
-> no if cur_lim1 <= oldlim1 and cur_start2 <= oldstart2
if fp # cur_start2 start
update
fp = cur_start2
cur_line = gapline; set lbeg(cur_lbeg,fp); set lend
finish
split(0); !(to update?)
if cur_lim1 > oldlim1 start
markpos = 0 if cur_lim1-1 = markpos; ! Erased marker
cur_lim1 = cur_lim1-1
if byteinteger(cur_lim1) = nl start
joins = joins+1
cur_line = cur_line-1; altline = cur_line
finish
set lbeg(cur_lbeg,fp); altmin = cur_lim1
finish
-> ok if cur_start2 <= oldstart2
fp = fp-1; cur_start2 = fp
cur_lbeg = cur_lbeg-1
-> ok if byteinteger(fp) # nl
joins = joins-1; lend = fp
set lbeg(cur_lbeg,fp)
-> ok
!
s('i'): !Insert back
fp = lend if fp > lend
store deletions if oldstart2 < cur_start2
-> no if delmax <= lastdelmax
split(mingap>>1)
copy across if gdiff # 0
fp = fp-1
byteinteger(fp) = byteinteger(delmax)
delmax = delmax-1
cur_start2 = fp; oldstart2 = cur_start2
cur_lbeg = cur_lbeg-1
if byteinteger(fp) = nl start
joins = joins-1; lend = fp; set lbeg(cur_lbeg,fp)
finish
-> ok
!
s('g'): !Get back
fp = lend if fp > lend
store deletions if oldstart2 < cur_start2
split(mingap>>1)
delmax = delmax-1 while byteinteger(delmax) # nl
-> no if delmax = newlim
copy across if gdiff # 0
lend = fp-1
cycle
fp = fp-1; byteinteger(fp) = byteinteger(delmax)
delmax = delmax-1
repeat until byteinteger(delmax) = nl
cur_start2 = fp; oldstart2 = cur_start2
joins = joins-1; set lbeg(cur_lbeg,fp)
-> ok
!
s('O'): !Overwrite
-> no if tabcol(fp,cur_lbeg,0) > o_width
over:
if ref = 0 start
if video # 0 start
display(o_early)
read text(replacing)
else
vt prompt("O>")
read text(standard)
vt prompt("")
finish
idef = newdef
if idef >= macro start
hold = tabcol(fp,cur_lbeg,0)
overwrite(idef)
altlim = floor and altmin = ceiling if hold >= cur_shift
finish
if dels#0 then repair line else repair chars(repairch)
-> controlterm if term # ret
else
idef = def(ref) if ref # '"'
-> next if idef < macro
overwrite(idef)
finish
-> ok
!
!!!!!!!!!!!!!!!!!!!!!! Data entry mode !!!!!!!!!!!!!!!!!!!!!!
data entry:
cycle
display(o_early)
read text(o_dmode)
if newdef >= macro start ; !non-null
if def1(term) = 'H' start ; !treat as command
inlim = newdef>>16; inpos = newdef&posmask
control = -1
repair line
-> again
finish
if sin&(\1) # 0 or lend = cur_lim2 start
repair line
-> read
finish
hold = tabcol(fp,cur_lbeg,0)
if o_dmode = replacing then overwrite(newdef) else insert(newdef)
altlim = floor and altmin = ceiling if hold >= cur_shift; ! up to date unless before screen
finish
repair line if dels # 0
exit if term # ret or def(ret) # 'M'
hold = line after
fp = fp+o_margin if lend # cur_lim2
repeat
controlterm:
update; ! If input to left of screen, redraw now.
control = term; cur_flag = 0
-> again
!
!!!!!!!!!!!!!!!!!!!!!!! end of data entry !!!!!!!!!!!!!!!!!!!!!
routine insert spaces(integer hold)
! Inserts 'hold' spaces before fp. Assumes 'SPLIT' called
while hold > 0 cycle
byteinteger(cur_lim1) = ' '; cur_lim1 = cur_lim1 + 1
cur_lbeg = cur_lbeg - 1; hold = hold - 1
repeat
end
s('G'): !Get (line from terminal)
if cur_lbeg < cur_start2 <= fp start
update; consolidate(fp-cur_lbeg,0); ![update needed?]
finish else fp = cur_lbeg
if ref = 0 start
split(mingap)
if video # 0 start
if video < 0 start
display(o_early)
cur_row = cur_line-cur_diff
scroll(cur_row,cur_bot,-1)
curprom = ""; !lost it
else ; !Simulate Break & Move back
!SPLIT already done
break
update
fp = cur_lim1-1; cur_lbeg = fp
cur_line = cur_line-1
display(0)
cur_row = cur_line-cur_diff
cur_lim1 = cur_lim1-1
fp = cur_start2; cur_lbeg = fp
finish
at(cur_row,tabcol(fp,cur_lbeg,0)+o_mark-cur_shift)
finish else vt prompt(":")
read text(standard); vt prompt("")
newdef = null and term = ':' if newdef # null c
and mac(newdef&posmask) = ':'
if newdef = null and term # ret start
if video # 0 start
if video < 0 start
scroll(cur_row,cur_bot,1)
else
split(0); !to set ALT...
joins = joins+1
finish
finish
term = ret and -> no if term = ':'
-> controlterm
finish
idef = newdef
insert spaces(cur_shift); ! Put'shift' spaces at beginning of line
insert(idef)
break
cur_change = altmin if altmin < cur_change
altlim = floor; altmin = ceiling; !screen up-to-date
joins = 0
if video < 0 start ; !bring back
if cur_row = cur_bot-1 start
cur_win = cur_win-1 if cur_win > cur_top
cur_diff = cur_diff+1
scroll(cur_top,cur_bot,1)
finish else if o_emode # 0 start
cat(0,0); clear line
finish
finish
-> controlterm if term # ret
else
idef = def(ref) if ref # '"'
insert(idef)
break
finish
-> ok
!
s('B'): !Break
fp = lend if fp > lend
num = 66 if num = 0 or num > 66
split(mingap)
break
-> ok
!
s('k'): !Kill back
update if altlim # floor
if cur_lbeg < cur_start2 <= fp start
fp = lend if fp > lend; consolidate(fp-cur_lbeg,0)
finish else fp = cur_lbeg
split(0)
-> no if cur_lim1 = cur_start1
hold = sin; sin = -1; fp1 = line before; sin = hold
consolidate(fp-cur_lbeg,-1) if fp # cur_lbeg
-> ok
s('K'): !Kill
-> no if lend = cur_lim2
fp = lend if fp > lend
split(0)
consolidate(fp-cur_lbeg,-1) and cur_lbeg = fp if fp # cur_lbeg
join
-> ok
!
s('J'): !Join
fp = lend if fp < lend
-> no if lend = cur_lim2 or tabcol(fp,cur_lbeg,0) > o_width
if fp > lend then extend line else split(0)
join
-> ok
!
![unsatisfactory]
constinteger true=1,false=0
integerfn ADJUSTED
integer size
fp1 = cur_lbeg+o_margin
fp = lend and result = true if fp1 >= lend; !blank line ->
fp = fp1 if fp < fp1
cycle
fp1 = fp; !last boundary
fp = fp+1 while byteinteger(fp) = ' ' or byteinteger(fp) = tab
fp = fp+1 while byteinteger(fp) > ' '
size = tabcol(fp,cur_lbeg,0)
if size > o_width start
result = false if byteinteger(fp1) # ' ' and byteinteger(fp) # tab
fp = fp1
result = true
finish
if fp = lend start
fp1 = fp+1
fp1 = cur_start2 if fp1 = cur_lim1
result = false if fp1 = cur_lim2
foundpos = fp1
fp1 = fp1+1 while byteinteger(fp1) = ' ' or byteinteger(fp1) = tab
result = false if byteinteger(fp1) = nl or fp1-foundpos < o_margin
foundpos = fp1
fp1 = fp1+1 until byteinteger(fp1) <= ' '
foundsize = fp1-foundpos; size = size+1+foundsize
result = true if size > o_width
split(mingap)
join
byteinteger(cur_lim1) = ' '; cur_lim1 = cur_lim1+1
move(foundsize,foundpos,cur_lim1)
cur_lim1 = cur_lim1+foundsize; oldlim1 = cur_lim1
fp = foundpos+foundsize
cur_start2 = fp; oldstart2 = cur_start2
altlim = cur_start2 if altlim < cur_start2
set lbeg(cur_lbeg,fp)
finish
repeat
end ; !ADJUSTED
s('A'): !Adjust
type = adjusted
if fp = lend start ; !break position is at end of line
-> no if line after = 0
else
split(0)
fp = fp+1; cur_start2 = fp; !erase space
oldstart2 = cur_start2; altlim = cur_start2 if altlim < cur_start2
break
hold = 0
while hold < o_margin cycle
byteinteger(cur_lim1) = ' '; cur_lim1 = cur_lim1+1
hold = hold+1
repeat
oldlim1 = cur_lim1
cur_lbeg = fp-o_margin
finish
-> ok if type # 0
-> no
!
s('@'): !'at' Column NUM
-> fail if lend = cur_lim2
hold = o_width-(tabcol(lend,cur_lbeg,0)-tabcol(fp,cur_lbeg,0))
num = hold if hold < num
if fp >= lend start
fp = cur_lbeg+num and -> next if cur_lbeg+num >= lend
fp = lend
finish
hold = tabcol(fp,cur_lbeg,0) - num
-> next if hold = 0
!old? fp = fp-hold %and -> next %if fp >= lend %and fp-hold >= lend
split(mingap)
cycle
if hold < 0 start ; !left of it
byteinteger(cur_lim1) = ' '; cur_lim1 = cur_lim1+1
cur_lbeg = cur_lbeg-1; hold = hold+1
else
-> fail if fp = cur_lbeg or (byteinteger(cur_lim1-1) # ' ' and byteinteger(cur_lim1-1) # tab)
markpos = 0 if cur_lim1-1 = markpos; ! Deleted marker
cur_lim1 = cur_lim1-1; cur_lbeg = cur_lbeg+1
altmin = cur_lim1 if altmin > cur_lim1
hold = tabcol(fp,cur_lbeg,0) - num
finish
repeat until hold = 0
-> next
!
routine put number(integer v)
put number(v//10) and v = v-v//10*10 if v >= 10
byteinteger(cur_lim1) = v+'0'
cur_lim1 = cur_lim1+1; cur_lbeg = cur_lbeg-1
end
s('-'):
s('+'): !Increment Number
cycle
-> no if fp >= lend
hold = symtype(byteinteger(fp))
exit if hold&alphanum # 0
fp = fp+1
repeat
split(mingap)
if hold = digit start
hold = 0; fp1 = fp
cycle
hold = hold*10+byteinteger(fp)-'0'; fp = fp+1
repeat until symtype(byteinteger(fp)) # digit
if code = '-' start
hold = hold-num; -> fail if hold < 0
finish else hold = hold+num
cur_lbeg = cur_lbeg+(fp-fp1)
put number(hold)
else
hold = byteinteger(fp)
if code = '-' then hold = hold-num else hold = hold+num
-> fail unless 'A' <= hold <= 'z' and symtype(hold)&letter # 0
byteinteger(cur_lim1) = hold
cur_lim1 = cur_lim1+1; fp = fp+1
finish
markpos = 0 if cur_start2 <= markpos < fp
cur_start2 = fp; altlim = cur_start2 if altlim < cur_start2
-> next
s('|'): !Toggle Destructive Mode
-> disallowed if sin > 0
if sin&(\1) = 0 start
fp = lend if fp > lend
-> fail if tabcol(fp,cur_lbeg,0) > o_width
split(0); altlim = floor+1; sin = -1
else
update; altlim = floor; sin = 0
finish
-> next
!
s('^'): !Set Marker / Delimit Text
-> disallowed if sin < 0
fp = lend if fp > lend
if num = 0 and markpos = 0 start
markpos = fp; markline = cur_line
if sin = 0 start
store deletions if oldstart2 < cur_start2
oldlim1 = cur_lim1
finish
else
fp1 = markpos
if fp1 # 0 start
hold = distance(fp1,fp)
if hold < 0 start
hold = -hold
fp1 = fp
finish
markpos = 0
else
-> fail if fp # foundpos
if foundsize <= 0 start ; !following 'N' etc
fp1 = fp
fp1 = fp1+1 until symtype(byteinteger(fp1))&alphanum = 0
foundsize = fp1-fp
finish
fp1 = fp; hold = foundsize
finish
num = 'X' if num < 'X'
release(num)
if hold = 0 then def(num) = null else start
mpos = macspace(hold)
def(num) = (mpos+hold)<<limshift+mpos
while hold > 0 cycle
mac(mpos) = byteinteger(fp1)
mpos = mpos+1; fp1 = fp1+1
fp1 = cur_start2 if fp1 = cur_lim1
hold = hold-1
repeat
finish
finish
-> next
!
s('='):
-> no if markpos = 0
jump to(markpos)
cur_line = markline
markpos = 0
-> ok
s('~'): ! Toggle replace/insert data mode
-> no if video = 0
o_dmode = o_dmode!!1
-> ok
s('$'): !switch inputs
fp1 = markpos; fp = lend if fp > lend
switch
if sin&(\1) = 0 and fp1 # 0 and fp1 # sec_fp start
hold = sec_fp
hold = fp1 and fp1 = sec_fp if fp1 > hold
if fp > lend start
fp = lend if byteinteger(fp1) = nl
extend line
finish else split(mingap)
cycle
if byteinteger(fp1) = nl then break else start
byteinteger(cur_lim1) = byteinteger(fp1)
cur_lim1 = cur_lim1+1; cur_lbeg = cur_lbeg-1
finish
fp1 = fp1+1
repeat until fp1 = hold
finish
-> next
!
! C o m m a n d i n p u t
!
routine GET NAME(string (maxname)name s)
!First symbol in SYM
s = ""
while ' ' <= sym < 127 cycle
s = s.tostring(sym) if length(s) < maxname
get sym
repeat
cat(1,0); !in case of error-report
end
constinteger first=0, normal=1; !(nomac=-1)
routine GET CODE(integer mode)
! Read command unit to CODE, classifying in TYPE
! Expand macros if MODE >= 0 / Leading element if MODE = 0
integer k
cycle
get sym until sym # ' '
code = sym
if sym < ' ' start ; !control
type = 1
return if mode > 0; !non-initial
code = term
finish
!Test for printing char version of control sequence
if code = '&' start ; !control shift
get sym;
if sym = ' ' start ; ! Impossible sequence signals DEL
code = del
else
-> err if sym < '@'
code = sym&31
finish
if code = esc start
get sym
if sym = '?' start ; !canonical 2nd leadin
get sym; sym = sym!!96
finish
code = sym+128
finish
control = code {%unless def(code) = '\'; ! Don't allow Data entry mode
finish
k = code; k = def(code) unless ' ' <= k < 'X'
return if mode = nomac
exit if k < macro; !not macro
macpush(k)
mode = normal
repeat
pend = k>>8; code = k&255
type = symtype(code)&15
return
err:
type = 1; code = ' '
end
!
routine GET TEXT
integer pos,lim
if sym = '!' start
if msp # 0 start ; !dummy parameter
pos = inpos; lim = inlim
msp = msp-1
inpos = mstack(msp)&posmask; inlim = mstack(msp)>>limshift
get sym if inpos < inlim
get text
! %return %if ref = 0; !trailing
if inpos < inlim start
mstack(msp) = inlim<<limshift+inpos
msp = msp+1
finish
inpos = pos; inlim = lim
return
finish
ref = 0
finish else if sym = '"' or 'X' <= sym&95 <= 'Z' start ; !text macro
ref = sym
else
ref = nullref; ref = 0 if num # 0; !Insert,etc
pend = sym and return if symtype(sym) # 3; !not valid quote ->
ref = nullref
hold = sym
get sym
pos = inpos-1; lim = pos
cycle
if sym < ' ' start ; !closing quote omitted
return if num = 0; !allowed only for I,S
pend = sym; sym = hold
finish
exit if sym = hold
lim = inpos
if inpos >= inlim start
return if num = 0
exit
finish
get sym
repeat
if lim > pos start ; !not null
def(treflim) = lim<<limshift+pos
ref = treflim; treflim = treflim+1
finish
finish
end
!
routine UNCHAIN
! Insert forward references in left bracket and comma cells
cycle
ref = chain
return if ref = 0
chain = r(ref)_ref
r(ref)_ref = ci
repeat until r(ref)_code = '('
end
!
bytemap BVALUE(integer i)
switch b(0:enumcases-1)
-> b(i)
b(0): result == O_MAPCASE
b(1): result == O_MARK
b(2): result == O_EARLY
b(3): result == O_DMODE
b(4): result == O_EMODE
b(5): result == O_EXPTABS
b(*): event_message = "Unknown Option"; signal 10,4
end
integermap VALUE(integer i)
switch v(0:intcases-1)
-> v(i-enumcases)
v(0): result == O_WIDTH
v(1): result == O_MARGIN
v(2): result == O_MINWIN
v(*): event_message = "Unknown Option"; signal 10,4
end
routine SET OPTIONS
integer i
constinteger showpointer=1,expandtabs=5
conststring (15)array text(0:enumcases+intcases-1) =
"Case-matching [",
"Show position [",
"Update [",
"Data mode [",
"Edit mode [",
"Expand Tabs [",
"Line width [",
"Left margin [",
"Min. window ["
conststring (7)array OPTNAME(0:enumcases*2-1) =
"NOMATCH", "MATCH",
"HILIGHT","MARK",
"LATE", "EARLY",
"REPLACE", "INSERT",
"COMMAND", "DATA",
"NO","YES"
!%routine SHOW(%integer i)
! %if i >= enumcases %then write(value(i),1) %c
! %else print string(optname(i+i+bvalue(i)))
!%end
string (15)fn SHOW(integer i)
if i >= enumcases then result = itos(value(i))
result = optname(i+i+bvalue(i))
end
cat(1,0)
printstring( "RETURN to step through value or 'x' to alter ':' to exit") c
if commandstream = 0; !Not for PRE file
newline
i = 0
cycle
i = 0 if i = enumcases+intcases
cat(0,0)
o_minwin = cur_min; !relevant current setting
vt prompt(text(i).show(i)."] :")
clear line
read command line
get sym
if sym # ret start
if sym = ':' start
save command; !ie last shown
vt prompt("")
return
finish
num = 0
while sym >= ' ' cycle
num = num*10+sym-'0' if '0' <= sym <= '9'
get sym
repeat
if i >= enumcases start
value(i) = num
if cur_min # o_minwin start
cur_min = o_minwin
cur_win = offscreen; cur_diff = unknown
finish
else
bvalue(i) = bvalue(i)!!1
cur_diff = unknown if i = showpointer or i = expandtabs
finish
coerce parameters
i = i-1
finish
i = i + 1
repeat
end ; !set options
routine DEFINE(integer k)
integer m,n,pos,macpos,control
control = 1; control = 0 if ' ' <= k < del
if ' ' <= k < del start
control = 0
complain(tostring(k)." cannot be re-defined") c
unless 'X' <= k <= 'Z' or 'a' <= k <= 'z'
finish
release(k)
get sym
n = 0
if sym = '"' and cdef # null start
n = cdef>>16-cdef&posmask
else
if sym # '=' start
complain("*Missing equals-sign/colon") if sym # ':'
mac(inpos) = mac(inpos)!128 if control # 0
finish
if inpos >= inlim start
return unless term < ' ' and term # ret
mac(inlim) = term; inlim = inlim+1
finish
finish
pos = inpos
inpos = inpos+1 while inpos < inlim and mac(inpos) # nl
m = inpos-pos
macpos = macspace(n+m)
move(n,mac0+cdef&posmask,mac0+macpos); macpos = macpos+n
move(m,mac0+pos,mac0+macpos); macpos = macpos+m
def(k) = macpos<<limshift+(macpos-n-m)
end
routine EXPLAIN(integer k)
!K is initial symbol (NOMAC)
integer m,control,back,flag
conststring (35)array text(' ':127) =
"undefined",
"prefix for system command",
"'ditto' text parameter",
"Move to absolute line n",
"Switch between input files",
"prefix for Special command",
"prefix for control character",
"a possible text delimiter",
"left parenthesis",
"right parenthesis",
"repeat indefinitely",
"Increment Number",
"separator for alternatives",
"back",
"a possible text delimiter",
"a possible text delimiter",
"repeat indefinitely",
"repeat once",
"repeat twice",
"repeat three times",
"repeat four times",
"repeat five times",
"repeat six times",
"repeat seven times",
"repeat eight times",
"repeat nine times",
"Define Macro letter",
"reserved",
"Cursor Left",
"Revert to Marker",
"Cursor Right",
"ignore failure condition",
"Align to column position",
"Adjust line length",
"Break line in two",
"Case-change character",
"Delete text",
"Erase character",
"Find text",
"Get text as complete line",
"Home (north,south,east,west)",
"Insert text",
"Join next line to this",
"Kill (delete current line)",
"move Left one character",
"Move to next line",
"locate Next word/unit",
"Overwrite with text",
"Print line(s)",
"Query form",
"move Right one character",
"Substitute text",
"Traverse text",
"Uncover (delete up to) text",
"Verify text",
"reserved",
"undefined macro",
"undefined macro",
"undefined macro",
"reserved",
"invert failure condition",
"reserved",
"Set Marker to delimit text",
"reserved",
"reserved",
"reserved",
"reserved",
"Case-change character backwards",
"reserved",
"Erase character backwards",
"Find text backwards",
"Get back - recover deleted line",
"reserved",
"Insert back - recover character",
"reserved",
"Kill previous line",
"move Right one character",
"Move to previous line",
"Next word/unit backwards",
"Overwrite back (recover)",
"Print previous line",
"reserved",
"move Left one character",
"reserved",
"reserved",
"reserved",
"reserved",
"reserved",
"reserved",
"reserved",
"reserved",
"Cursor Up",
"Toggle Destructive mode",
"Cursor Down",
"Toggle INSERT/REPLACE data mode",
"illegal"
cat(1,0)
m = k; m = def(k) unless ' ' <= m < 'X'
control = 0; control = 1 unless ' ' <= k < del
if control # 0 or (m >= macro and sym < ' ') start ; !macro (alone)
print symbol(k) if control = 0
flag = '='
if m >= macro start ; !defined macro
macpush(m)
flag = ':' if mac(inpos)&128 # 0
get sym; k = sym
m = k; m = def(k) unless ' ' <= m < 'X'
get sym
finish else if control # 0 start
flag = ':'
finish
print symbol(flag); print symbol(' ')
finish
back = 0
if 'A' <= m <= 'W' and sym = '-' start
m = m+casebit; get sym; back = 1
finish
if sym >= ' ' start ; !not single command letter
print symbol(k)
print symbol('-') if back # 0
cycle
print symbol(sym)
get sym
repeat until sym < ' '
print symbol('/') and msp = 0 if msp # 0
finish else if control # 0 and m = '\' start
print string("\ : Swop between command/data modes")
finish else if control # 0 and m = '1' start
printstring("1 : repeat last command line")
else
print code(m&255)
k = m>>8
if k # 0 start
if k # '0' start
printsymbol(k)
else
printstring("* (ie ")
print code(m&255)
printstring(" indefinitely)")
finish
else
printstring(" : "); printstring(text(m))
finish
finish
newline
end ; !explain
routine OUTPUT KEYDEFS
integer i,j,kk,sym
for kk = 0,1,255 cycle
i = def(kk)
if i >= premacro and not ' ' <= kk < 'X' start
print symbol('%'); print symbol('K')
sym = kk
if sym < ' ' or sym >= 128 start
print symbol('&'); sym = sym+64
if sym >= 128 start
sym = kk&127
print symbol('['); !ESC
print symbol('?') and sym = sym!!96 if sym < 64
finish
finish
print symbol(sym)
j = i>>limshift; i = i&posmask
if mac(i)&128 = 0 then printsymbol('=') else printsymbol(':')
while i # j cycle
print symbol(mac(i)&127); i = i+1
repeat
newline
finish
repeat
end
routine ECHO COMMAND
integer pos
cat(1,0)
if control < 0 start
printsymbol(charno(curprom,1)); printsymbol(charno(curprom,2))
pos = cdef&posmask
while pos < cdef>>16 cycle
print symbol(mac(pos)); pos = pos+1
repeat
clear line
finish
end
!
! I n i t i a l i s a t i o n
!
routine macinit(string (255) s)
integer i,k
for i = 1,1,length(s) cycle
k = charno(s,i); k = k+128 if 'A' <= k <= 'Z'
mac(i+511) = k
repeat
end
conststring (2)array PROM(-1:6) = "|>", ">>", "$>", "$$",
"^?", "^>", "$^", "^$"
edistart:
o = options; ! Assign local copy of editor options
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Initialisation of former %OWNs. Some of these may be unneccessary
TOGGLE=0
CASEMASK=\casebit; !\casebit/\0 to ignore/heed case
DICT=0
TERM=ret; !last symbol read
SYM=ret; !last symbol got
LAST='}'
NUM=0; !repetition number
PAN=0
MARKLINE=0; !marker positions
PRINTLINE=0;PRINTED=0; !for hard-copy
NEWPROM="??";CURPROM=""
CI=0; CMAX=0; CMAX1=0; !indexing R
INPOS=0;INLIM=0
DELS=0;INITDELS=0;REPAIRCH=0
TREFLIM=trefbase;TREFLIM1=trefbase
INSERTLEN = 0; INSERTDIF = 0
ENDON = -1; ALTLIMLBEG = 0
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
lastcell_code = ')'; lastcell_count = 1; lastcell_ref = 0
!Stored text pointers
newdef = null; cdef = null; idef = null; mdef = null
code = null
mac0 = addr(mac(0));
macm4 = mac0-4
macbase = mac0+528
integer(macbase) = macbound+1-532
integer(macbase+(macbound+1-532)) = 0
macinit("I. .D. .D-. .")
mac(525) = ff; mac(526) = tab
! Check for newlines missing
if main_start2 # main_lim2 and byteinteger(main_lim2-1) # nl start
! no newline at end of file
message = "No Newline!!!"
if main_lim2 < main_lim start
! there is room to add the newline
byteinteger(main_lim2) = nl
main_lim2 = main_lim2+1
finishelsestart
! Cant add it so we just ignore the last line
main_lim2 = main_lim2-1 while main_lim2 > main_start2 and c
byteinteger(main_lim2-1) # nl
finish
finish
if sec_start2 # sec_lim2 and byteinteger(sec_lim2-1) # nl start
! no newline at end of file
! Cant add it so we just ignore the last line
sec_lim2 = sec_lim2-1 while sec_lim2 > sec_start2 and c
byteinteger(sec_lim2-1) # nl
finish
!File pointers
cur == main
oldlim1 = cur_lim1; oldstart2 = cur_start2
fp = cur_fp
if cur_line = 0 start
fp = cur_start1
cur_line = 1
cycle
fp = cur_start2 if fp = cur_lim1
exit if fp = cur_fp
return if fp = cur_lim2
cur_line = cur_line+1 if byteinteger(fp) = nl
fp = fp+1
repeat
finish
newlim = cur_lim2
gdiff = 0
unless cur_lim1 <= cur_lim2 <= cur_lim start
newlim = cur_lim-1024
gdiff = newlim-cur_lim2
finish
delmax = newlim; byteinteger(delmax) = nl if delmax > 0
lastdelmax = delmax
foundpos = 0; foundsize = 0; markpos = 0
cmax1 = 0; consolidated = 0
error = 0; commandstream = 0; pend = 0
joins = 0
sin = 0
if cur_change < 0 start ; !showing only
sin = 1
else
cur_change = ceiling if cur_change = 0
cur_change = ceiling-1 if cur_change # ceiling
finish
altmin = ceiling; altlim = floor
set lbeg(cur_lbeg,fp); set lend
!Initialise video info
![XOR so that o_VMODE can, awkwardly, suppress]
smode = o_vmode!!screenmode!!specialpad
define video(o_ttype) and o_ttype = -2 if o_ttype > -2
smode = 0 if vdu_fun = 0
if vttype = esprit start
def(128+'L'&31) = '{'; !cursor up
def(128+'S'&31) = 'K'; !del line
finish
! SET UP CURSOR KEYS
def(key u)='{' if key u#0
def(key d)='}' if key d#0
def(key l)='<' if key l#0
def(key r)='>' if key r#0
prompt("")
set video mode(smode)
set windows
cur_bot = o_wrows; cur_min = o_minwin
cur_win = offscreen; cur_diff = unknown
coerce parameters
begin
! Initialise log file
on event 9 start
o_logfile = ""
logstream = logstream - 1
selectoutput(0)
-> logfile failed
finish
keeplog = 0
if o_logfile # "" start
if o_logfile # ".JOURNAL" start
logstream = logstream + 1
open output(logstream,o_logfile)
select output(logstream); select output(0)
keeplog = 1
else
keeplog = -1
finish
finish
logfile failed:
end ; ! of block to set up logfile
!
cat(1,0); printstring(message); newline
!
! R e a d n e w c o m m a n d l i n e
!
comread: !Read command file if present
if o_pre # "" start
open in(o_pre)
eflag = o_emode
o_emode = 0
finish
resetread:
o_pre = ""; curprom = ""
inpos = inlim; msp = 0
read:
ci = cmax1; ! ci gets reset later, but set here for logfile routine
pcflag = 0
if markpos = 0 then newprom = prom(sin) c
else newprom = prom(sin+4)
-> data entry if o_emode # 0
pend = 0; control = -1
if inpos >= inlim start ; !no input available
if commandstream = 0 start ; !on-line
prepare for input
if video = 0 start
vt prompt(newprom)
finish else if newprom # curprom start
cat(0,0); printstring(newprom) ; clear line
else
cat(0,2); clear line
finish
curprom = newprom
finish else if video # 0 then display(o_early); !So that a log file is correctly executed
read command line until inlim > inpos or commandstream+msp = 0
vt prompt("") if video = 0
control = term if inpos >= inlim
finish
!Reset command variables
again:
chain = 0; cmax = cmax1
get code(first)
if control >= 0 and commandstream = 0 start ; !control key
if code = '\' start ; !toggle editing mode
o_emode = o_emode!!1; toggle = \toggle
remove pointer
-> resetread
finish
finish else if code = '-' and def(ret)&casemask = 'M' start
def(ret) = def(ret)!!casebit; !toggle direction
control = term if inpos >= inlim
get code(first)
finish
toggle = 0
-> read if type = 1
if code = '?' start
cat(1,40); write(cur_line,0); clear line
-> resetread
finish
if code = '!' start
get sym until sym # ' '
get name(command)
-> ignore if command = ""
remove pointer
push window
win = vdu
clear frame
set video mode(0)
hold = vttype
hold1 = keeplog; keeplog = 0; ! Inhibit logfile
newcommand:
call out(command)
if commandstream = 0 start ; !No delay if from command file
new line
vt prompt("Enter ""!<command>"" or RETURN ");
read command line
vt prompt ("")
if mac(inpos)&127 = '!' start
get sym; get sym; get name(command)
-> newcommand if command # ""
finish
get sym; get sym while sym >= ' '
finish
define video(hold) unless vttype = hold; ! In case recursive call changed TTYPE
set video mode(smode)
pop window
keeplog = hold1; ! Restore logfile
! Flag for screen redraw
! In case called from secondary file
if sin = 2 or sin = 3 then main_win = offscreen and main_diff = unknown
if sec_min # 0 then sec_win = offscreen and sec_diff = unknown
-> qread
finish
if type = 0 start ; !repetition number
sym = code; number
-> er2 if sym >= ' '
def(ret) = 'M' if def(ret) = 'm'
-> read if cmax = 0; !no command to repeat
r(cmax)_count = num
-> restore
finish
if code = '%' start
get sym; code = sym
sym = sym&95
->er2 if code < 'A'
get sym
pcflag = code&95
-> pc(pcflag)
finish
if control < 0 start ; !not control key
def(ret) = 'M' if def(ret) = 'm'; !restore
cdef = newdef
cmax = 0; treflim1 = trefbase
finish
!
! C o m m a n d i n p u t: m a i n l o o p
ci = cmax; treflim = treflim1
more: !(command code has been read)
-> er5 if type < 4
-> er0 if type < 8 and newlim <= 0; !no changes when Showing
ci = ci+1; -> er6 if ci >= cbound
num = 1; scope = 0; ref = 0; !defaults
get sym; !next symbol without mapping
if sym = '-' start
code = code!casebit; type = symtype(code)&15
-> er5 if type < 4
code = '-' if code = '+'
get sym
finish
-> c(type)
c(8): !Find
num = 0
c(7): !+ Delete, Uncover
c(9): !+ Traverse, Verify
number
scope = num
num = 0; !as indicator (not I,O,S,G)
c(6): !+ Insert, Overwrite,
! Substitute, Get
get text
-> er4 if ref = nullref and num = 0
get sym
num = 1; !restore default
c(5): !Erase, Get, etc
c(10): !+ Move, Next, Print
num = 0 if code = '#'; number
-> put
c(11): !open bracket, comma
ref = chain; chain = ci
-> put
c(12): !^
num = 0; number
if num # 0 start
-> erq if num > 6
num = num+('X'-1); num = num+('x'-'Z'-1) if num > 'Z'
finish
-> put
c(13): !: [temp]
-> erq unless 'X' <= sym&95 <= 'Z'
num = sym; code = '^'
get sym
-> put
c(14): !close bracket
unchain; -> er3 if ref = 0
number
r(ref)_count = num
c(15): !invert, query
put:
r(ci)_code = code; r(ci)_ref = ref
r(ci)_scope = scope; r(ci)_count = num
pend = sym; get code(normal)
-> more unless type = 1
ci = ci+1; cmax = ci
r(ci) = lastcell
unchain; -> er3 if ref # 0
if control < 0 start ; !not control key
cmax1 = cmax; treflim1 = treflim
if o_emode # 0 or cscroll = 0 start ; !'home' used
! or can't scroll command window
echo command if video # 0
else
save command
finish
error = 0
finish
restore:
if error # 0 start
cat(1,chalf); clear line
error = 0
finish
sym = ret if sym < ' '
! %if cur_flag >= ' ' %start
! at(cur_row,cur_col)
! print symbol(fpsym)
! at(cur_row,cur_col)
! print symbol(0); !to flush & position video cursor
! %finish
-> execute
!
routine REPORT(string (255) message)
!Make command error report (to right of command text)
if o_emode = 0 start
echo command if cscroll = 0
finish else cat(1,0)
printstring(message)
end
!
er0:
report(" "); print code(code)
print string(" when Showing")
-> erq
er3:
report(" Brackets")
-> erq
er4:
report(" Text for ")
print code(code)
-> erq
er2:
code = sym
c(*):
er5:
report(" "); print code(code)
-> erq
pc(*):
get sym while sym >= ' '
report(" "); print symbol('%'); print code(code)
-> erq
er6:
report(" Size")
erq:
print symbol('?')
cmax1 = 0 if ci > 1
newline
save command if o_emode = 0 and cscroll # 0; !(else REPORT echoed)
ignore:
! close in %if commandstream # 0
-> resetread
!
! Percent commands
pc('S'): !Secondary input
switch if sin&(\1) # 0
get sym while sym = ' '
get sym if sym = '='
if sym >= ' ' start
get name(sec_name)
sec_flag = 0
connect edfile(sec)
if sec_flag # 0 start
event_extra = sec_flag
sec = 0
signal 9
finish
if sec_start2 # sec_lim2 and byteinteger(sec_lim2-1) # nl start
! no newline at end of file
! Cant add it so we just ignore the last line
sec_lim2 = sec_lim2-1 while sec_lim2 > sec_start2 and c
byteinteger(sec_lim2-1) # nl
finish
finish
sec_line = 0; !indicator for reset
switch
-> read
pc('G'): !Get command file
get sym while sym = ' '
get name(o_pre)
! close in %if commandstream # 0
-> comread
pc('P'): !Put key definitions
get sym while sym = ' '
get name(o_pre)
open out(o_pre) if o_pre # ""
o_pre = ""
output keydefs
close out
-> read
pc('U'): !ignore/heed case
o_mapcase = 1
o_mapcase = 0 and get sym if sym = '-'
coerce parameters
-> read
pc('L'): !Line width
get sym while sym = ' '
get sym if sym = '='
number; -> erq if type # 0
o_width = num
coerce parameters
-> read
pc('M'): !Margin
get sym while sym = ' '
get sym if sym = '='
number; -> erq if type # 0
o_margin = num
coerce parameters
-> read
pc('R'):
get sym while sym = ' '
get sym if sym = '='
if sym >= ' ' start
neg = 1
get sym and neg = -1 if sym = '-'
number
num = num*neg
-> erq if type # 0
finish else num = 0
if num = 0 then cur_shift = 0 else start
cur_shift = cur_shift + num
cur_shift = 0 if cur_shift < 0
cur_shift = 1000 if cur_shift > 1000
finish
cur_win = offscreen
-> read
pc('D'): !Display
get sym while sym = ' '
get sym if sym = '='
if sym >= ' ' start
number
-> erq if type # 0
cur_min = num
finish
remove pointer
coerce parameters
qread:
cur_win = offscreen; cur_diff = unknown
curprom = ""; vdu_row = 255
-> read
pc('H'): !Help
get sym while sym = ' '
remove pointer
push window
win = vdu
hold = vttype
set video mode(0)
vt at(o_ctop+1,0); !in case of error report
if sym < ' ' then view("") c
else get name(o_pre) and view(o_pre) and o_pre = ""
define video(hold) unless vttype = hold; ! In case recursive call changed TTYPE
set video mode(smode)
pop window
! Flag for screen redraw
! In case called from secondary file
if sin = 2 or sin = 3 then main_win = offscreen and main_diff = unknown
if sec_min # 0 then sec_win = offscreen and sec_diff = unknown
-> qread
pc('E'): !Environment
remove pointer
set options
curprom = ""
-> read
pc('W'):
-> erq if sin&(\1) # 0
get sym while sym = ' '
get sym if sym = '='
num = 1; number
store deletions if oldstart2 < cur_start2
cycle
exit if delmax <= newlim
delmax = delmax-1
num = num-1 if byteinteger(delmax) = nl
repeat until num = 0
oldlim1 = cur_lim1; oldstart2 = cur_start2
-> read
pc('X'): pc('Y'): pc('Z'):
get sym while sym = ' '
if sym >= ' ' start ; !definition
pend = sym
define(code)
else ; !enquiry
explain(code)
finish
-> read
pc('Q'):
get sym while sym = ' '
if sym # ret or term # ret start
pend = sym; get code(nomac)
get sym if sym >= ' '
explain(code)
else
vt prompt("Key (or :): ")
cycle
cat(0,0); clear line
read text(nomac)
inpos = newdef&posmask; inlim = newdef>>16
get code(nomac)
get sym if sym >= ' '
exit if code = ':'
explain(code)
repeat
finish
vt prompt("")
curprom = ""
-> read
pc('K'): !define key(s)
get sym while sym = ' '
if sym # ret or term # ret start
pend = sym; get code(nomac)
if inpos >= inlim start
printsymbol('*') unless ' ' <= code < del
read command line
finish
define(code)
else
cycle
vt prompt("Key = defn: ")
cat(0,0); clear line
read text(nomac)
inpos = newdef&posmask; inlim = newdef>>16
get code(nomac)
exit if code = ':'
if inpos >= inlim start
cat(0,0) and vt prompt("Key = defn: *") unless ' ' <= code < del
read command line
finish
vt prompt(""); ! 'cause DEFINE can exit back to command
define(code)
repeat
vt prompt("")
finish
curprom = ""
-> read
pc('T'): ; ! Set TAB positions
get sym while sym = ' '
if sym = '?' start ; !Enquiry
cat(1,0); print string("Tab positions are ")
for t = 1,1,maxtab-1 cycle
write(o_tabs(t),0); print symbol(',')
repeat
write(o_tabs(maxtab),0); newline
-> read
finish
get sym if sym = '='
t = 0
cycle
number; -> ertab if type # 0
get sym if sym = ',' or sym = ';'
-> ertab unless num&(\255) = 0 and num > o_tabs(t)
t = t + 1
o_tabs(t) = num
repeat until sym < ' ' or t = maxtab
o_tabs(t) = num for t = t+1,1,maxtab; ! Remaining tabs are set to last one
-> read
ertab:
report(" Tabs ")
o_tabs(t) = 0 for t = 1,1,maxtab
-> erq
pc('B'): ; ! Backup
options = o; ! Save editor options record for re-entry
copy across if gdiff # 0
remove pointer
update
switch if sin&(\1)#0
consolidate(0,0)
pop window; win = vdu
get sym while sym = ' '
if sym >= ' ' then get name(cur_name)
cur_flag='B'
cur_fp = fp
vt at(vdu_rows-1,0)
clear line
set video mode(0)
return
pc('A'): !Abandon
update
switch if sin&(\1) # 0
if cur_change # ceiling and sin#1 and sin#3 start
!Change made and NOT showing
cat(1,0)
vt prompt(" Abandon complete edit? (y/n) "); clear line
read command line
vt prompt("")
get sym; -> ignore if sym!casebit # 'y'
get sym; -> ignore if sym >= ' '
cur_change = ceiling
finish
sym = -1;
pc('C'): !Close
options = o; ! Save editor options record for re-entry
if keeplog > 0 start
select output(logstream); close output
select output(0); logstream = logstream - 1 if logstream > 0
finish
remove pointer
update
switch if sin&(\1) # 0
fp = cur_start2; cur_lbeg = fp; set lend
consolidate(0,0); !ensure no split line
cur_flag = sym
if sym = ' ' or sym = '=' start
get sym; get sym while sym = ' '
get name(cur_name) if sym >= ' '; ! New name specified
finish
pop window; win = vdu
vt at(vdu_rows-1,0)
clear line;
set video mode(0)
end ; !END OF EDI
endoffile