!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
! V6.1 (01/05/85): use VMS command line parsing (ADC at Lattice)
!
! 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.
!
!
!
!
!
!
!
!
!
!
!
!!!!!!!!!!!!!! Standard Video Terminal Interface !!!!!!!!!!!!!
!$IF EMAS OR VAX
! ASCII control characters:
constinteger BS=8, TAB=9, LF=10, FF=12, RT=13, ESC=27
constinteger DEL=127
! Terminal mode:
constinteger SINGLE=1<<0, NOECHO=1<<2, PASSDEL=1<<3,
NOTYPEAHEAD=1<<4, NOTERMECHO=1<<5,
CONTROLTERM=1<<6, NOEVENT9=1<<7, LEAVECONTROLS=1<<8,
SPECIALPAD=1<<13, NEWTCP=1<<29, INSERTING=0
constinteger SCREENMODE=controlterm+notermecho+leavecontrols+passdel
! Video FUNction/MODE flag values:
constinteger INTENSE=1, REVERSE=2, UNDERLINE=4, BLINK=8,
GRAPHICAL=16, SHADE=31
constinteger FULLSCROLL=64, ANYSCROLL=128; !FUN only
constinteger NOSCROLL=64, FREEZE=128; !MODE only
recordformat WININFO(byteinteger top,rows,left,cols,
row,col,fun,mode)
externalrecord(wininfo)spec VDU
externalrecord(wininfo)spec WIN
externalintegerspec VTTYPE
!
externalroutinespec DEFINE VIDEO alias "VTDEFVIDEO"(integer emastype)
externalroutinespec SET VIDEO MODE alias "VTSETVIDEO"(integer mode)
externalroutinespec PUSH WINDOW alias "VTPUSH"
externalroutinespec POP WINDOW alias "VTPOP"
externalroutinespec SWOP WINDOW alias "VTSWOP"
externalroutinespec SET FRAME alias "VTSETFRAME"(integer t,r,l,c)
externalroutinespec SET MODE alias "VTSETMODE"(integer m)
externalroutinespec SET SHADE alias "VTSETSHADE"(integer s)
externalroutinespec CLEAR LINE alias "VTCROL"
externalroutinespec CLEAR FRAME alias "VTCFRAME"
externalroutinespec SCROLL alias "VTSCROLL"(integer t,b,n)
externalroutinespec VT AT alias "VTSETCURSOR"(integer row,col)
externalroutinespec GOTOXY alias "VTGOTOXY"(integer x,y)
!
!$IF EMAS
{%recordformat EVENTFM(%integer event,sub,extra, %string(255) message)
{%externalrecord(eventfm)%spec EVENT %alias "VTEVENT"
{%externalroutinespec OPEN INPUT %alias "VTOPIN"(%integer s,
{ %string(255) file)
{%externalroutinespec OPEN OUTPUT %alias "VTOPOUT"(%integer s,
{ %string(255) file)
{%externalroutinespec CLOSE INPUT %alias "VTCLIN"
{%externalroutinespec CLOSE OUTPUT %alias "VTCLOUT"
{%externalintegerfnspec OUTSTREAM %alias "VTOUTS"
!$IF EMAS OR VAX
externalroutinespec SELECT INPUT alias "VTSELIN"(integer i)
externalroutinespec SELECT OUTPUT alias "VTSELOUT"(integer i)
externalroutinespec PRINT SYMBOL alias "VTPSYM"(integer sym)
externalroutinespec SPACE alias "VTSP"
externalroutinespec SPACES alias "VTSPS"(integer n)
externalroutinespec NEWLINE alias "VTNL"
externalroutinespec NEWLINES alias "VTNLS"(integer n)
externalroutinespec PRINT STRING alias "VTPSTRING"(string(255) s)
externalroutinespec WRITE alias "VTWRITE"(integer v,p)
externalroutinespec VTPROMPT alias "VTPROMPT"(string(255) s)
externalroutinespec READ SYMBOL alias "VTRSYM"(integername k)
externalintegerfnspec NEXT SYMBOL alias "VTNSYM"
externalroutinespec SKIP SYMBOL alias "VTSSYM"
externalroutinespec READ alias "VTREAD"(integername v)
!$FINISH
constinteger BANTAM=6, ESPRIT=13
!
!!!!!!!!!!!!!!!!! Other external refs and globals !!!!!!!!!!!!!!!!!!!!!!!!!
constinteger RET=10
constinteger CASEBIT=32; !upper<->lower
!
constinteger MAXNAME=255
recordformat EDFILE(integer start1,lim1, {part 1}
start2,lim2, {part2}
lim, {VMLIM}
lbeg,fp,change,flag,
line {line number of current pos},
diff {diff between LINE and ROW},
byteinteger top {top row of sub_window},
win {floating top},
bot {bottom row +1 of sub_window},
min {minimum window size},
row {last row position},
col {last col position},
string(maxname) name)
!
!** Note that LBEG is such that FP-LBEG = #chars to left of FP
! even if this means that LBEG lies within the 'gap'
!
!$IF VAX OR APM
constinteger CORDON=0
constinteger BSDEF='g'
!$IF VAX
!$$$%include "IMP_INCLUDE:CONNECT.INC"; !dictionary connection
!$$$%include "IMP_INCLUDE:PAM.INC"; !parameter processing
from Imp include Connect, CLIParse
!ADC!%constinteger MINWIN0=7, MAXWIN0=99
{ADC}constinteger MINWIN0=24,MAXWIN0=99 {More sensible default}
conststring(13) HELPFILE="ECCE_HELP"
conststring(13) DICTFILE="ECCE_DICT"
externalroutinespec VIEW(string(255) S)
externalroutinespec MOVE(integer length,from,to)
!%externalintegerfnspec UINFI(%integer i)
!%externalintegerfnspec CHECKQUOTA(%string(127) filename)
{¬V10IMP %externalstring(72)%fnspec SYSMESS (%integer i)
{V10IMP} from imp include sysmisc
!
! Special routines from PMM to handle file referencing and i/o
externalintegerfnspec READIN(string(maxname)name file,
integer extra, integername base,start,fend,limit)
externalintegerfnspec WRITEOUT(string(maxname)name file,
integer base,start,fend,limit)
externalroutinespec DELETEVM(integer base,limit)
!
externalroutine CONNECT EDFILE(record(edfile)name f)
! Reference file specified by F_NAME
! allocate store to hold it + extra bytes specified by F_FLAG
! place the file in store
! Return store addresses in F_START1/F_LIM
! file addresses in F_START2/F_LIM2
! ( START1 <= START2 <= LIM2 <= LIM )
! Update F_NAME to full file name
!
! Discard any previous input file
deletevm(f_start1,f_lim) if f_start1 # 0
! Read the file in
f_flag = readin(f_name,f_flag>>9,f_start1,f_start2,f_lim2,f_lim)
if f_flag # 0 start
{¬V10IMP print string(" *".sysmess(f_flag).": ".f_name)
{V10IMP} print string(" *".get message(f_flag).": ".f_name)
newline
f_start1 = 0; f_start2 = 0; f_lim2 = 0
finish
f_lim1 = f_start1
! Ensure that file does not end with partial line
f_lim2 = f_lim2-1 while f_lim2 # f_start2 and byteinteger(f_lim2-1)#nl
end; !connect edfile
routine CONNECT DIRECT(string(255) file, integername base)
integer f,s,l
!%externalintegerfnspec connect(%string(127) file,
! %integername start,length, %integer mode)
on event 3,4,9 start
return
finish
! f = connect(file,s,l,0)
connect file(file,0,s,l)
base = s {%if f&1 # 0
end
!
!$IF APM
{!UTIL should be in PAM but no nested includes
{%include "I:UTIL.INC" {for STOI, etc -- also PAM flags}
{%include "UTILS:PAM"; !parameter processing
{%constinteger MINWIN0=10, MAXWIN0=10
{%routine MOVE(%integer length,from,to)
{! %while length > 0 %cycle
{! byteinteger(to) = byteinteger(from)
{! to = to+1; from = from+1; length = length-1
{! %repeat
{! %return
{ *MOVE FROM,A0; *MOVE TO,A1; *MOVE LENGTH,D0
{ *BLE #6
{ *MOVE.B (A0)+,(A1)+; *SUBQ #1,D0; *BNE #-6
{%end
{!
{!!!!!!!!!!!!!!!!!!!!!! 'Connect' file !!!!!!!!!!!!!!!!!!!!!!!!!
{%recordformat CONNINFO(%integer memstart,fstart,flim,memlim)
{@16_11B8 %routine CONNECT(%string(255) s, %record(conninfo)%name r)
{%external%routine CONNECT EDFILE(%record(edfile)%name f)
{%record(conninfo) r
{%integer i
{%on %event 3,4,9 %start
{ select output(0)
{ printstring(event_message); newline
{ f_flag = 1
{ %return
{%finish
{ i = f_start1
{ %if i # 0 %start; !VM previously allocated
{ i = i+256; *MOVE i,D6; !restore heap pointer
{ %finish
{ r_fstart = f_flag>>1; r_memlim = r_fstart; !extra space fore and aft
{ f_start1 = 0; f_lim1 = 0; f_start2 = 0; f_lim2 = 0
{ f_change = 0; f_line = 0
{ connect(f_name,r)
{ r_flim = r_flim-1 %while r_flim > r_fstart %and byteinteger(r_flim-1) # nl
{ f_start1 = r_memstart; f_lim1 = f_start1; !VM start
{ f_start2 = r_fstart; f_lim2 = r_flim; !file start/limit
{ f_lim = r_memlim; !VM limit
{ f_flag = 0
{%END
{!
!$IF EMAS
{%include "ECSC10.PAMINC"
{%constinteger CORDON=2; !to alleviate effects of echoed typeahead
{%constinteger BSDEF='<'
{%constinteger MINWIN0=7, MAXWIN0=99
{%conststring(24) HELPFILE = "ECSLIB.GENERALY_ECCEVIEW"
{%conststring(24) DICTFILE = "ECSLIB.GENERALY_ECCEDICT"
{%externalroutinespec PROMPT(%string(15) S)
{%externalroutinespec VIEW(%string(255) S)
{!
{%routine MOVE(%integer length, from, to)
{ *LB_LENGTH
{ *JAT_14,<L99>
{ *LDTB_X'18000000'
{ *LDB_%B
{ *LDA_FROM
{ *CYD_0
{ *LDA_TO
{ *MV_%L=%DR
{L99:
{%END
{%INCLUDE "ECSC10.ECCE_FCP"
{!
!$FINISH
!
!!!!!!!!!!!!!!!!!!! Editor parameters and options !!!!!!!!!!!!!!!!!
!** NB ORDER -- see VALUE
constinteger ENUMCASES=5, INTCASES=3
!
ownbyte MAPCASE=1 {1/0 ignore/heed case},
MARK=0 {1/0 show FP by mark/hilight},
EARLY=0 {1/0 update early/late},
DMODE=0 {1/0 insert/replace},
EMODE=0 {1/0 command/data}
owninteger WIDTH=80 {line width},
MARGIN=0 {left margin},
MINWIN=minwin0 {minimum window size}
!Settable at outset only:-
!$IF EMAS OR VAX
owninteger TTYPE=-1
!$IF APM
{%owninteger TTYPE=11; !terminal type (ERCC coding)
!$FINISH
owninteger WTOP=0, WROWS=255; !window area top,rows
owninteger WLEFT=0, WCOLS=255; !window area left,cols
owninteger CTOP=99; !command row (1st of 2)
owninteger CLEFT=0, CCOLS=255; !command area left,cols
owninteger MAXWIN=maxwin0
!$IF VAX OR APM
owninteger VMODE=0
!$IF EMAS
{%owninteger VMODE=newtcp
!$FINISH
externalstring(maxname) PRE=""
!** end of OPTIONS
!
bytemap BVALUE(integer i)
!$IF APM or EMAS
{ %result == byteinteger(addr(mapcase)+i)
!$IF VAX
result == byteinteger(addr(mapcase)+i<<2)
!$FINISH
end
integermap VALUE(integer i)
result == integer(addr(width)+(i-enumcases)<<2)
end
!!!!!!!!!!!!!!!!! Command parameter processing !!!!!!!!!!!!!!!!!
!
! SET PARAMETERS rewritten by ADC (1-MAY-1985) to do
! standard VMS command line parsing, with an external .CLD file.
! Old code commented out: !ADC!
!
externalroutine SET PARAMETERS(string(maxname)name in,sec,out,
string(255) parm)
!The value of PARM is ignored. QUALIFIERx routines access the DCL
!command line directly.
!NB QualifierI returns zero if the qualifier is not present. Similarly,
! QualifierS returns the null string
Map Case = 0
Map Case = 1 if Qualifier Present("MATCH")
Width = Qualifier I("WIDTH")
Margin = Qualifier I("MARGIN")
Min Win = Min Win 0
Min Win = Qualifier I("MINWIN") if Qualifier Present("MINWIN")
Mark = 0 if Qualifier Present("HILIGHT")
Mark = 1 if Qualifier Present("MARK")
Early = 0 if Qualifier Present("EARLY")
Early = 1 if Qualifier Present("LATE")
T Type = Qualifier I("TTYPE") if Qualifier Present("TTYPE")
W Top = Qualifier I("WTOP")
W Rows = 255
W Rows = Qualifier I("WROWS") if Qualifier Present("WROWS")
W Left = Qualifier I("WLEFT")
W Cols = 255
W Cols = Qualifier I("WCOLS") if Qualifier Present("WCOLS")
C Top = 99
C Top = Qualifier I("CTOP") if Qualifier Present("CTOP")
C Left = Qualifier I("CLEFT")
C Cols = 255
C Cols = Qualifier I("CCOLS") if Qualifier Present("CCOLS")
Max Win = Qualifier I("MAXWIN") if Qualifier Present("MAXWIN")
Vmode = Qualifier I("VMODE")
Pre = Qualifier S("PRE")
In = Qualifier S("FILE")
In = "" if In = "NL:" {Ugh. Indicates "Creating" a new file}
Sec = Qualifier S("SECNAME")
Out = Qualifier S("OUTPUT")
Out = In if Out ="" { V INFILE == V INFILE INFILE }
end
!ADC/JGH!%externalroutine SET PARAMETERS(%string(maxname)%name in,sec,out,
!ADC/JGH! %string(255) parm)
!ADC/JGH!%on %event 5 %start
!ADC/JGH! printstring(event_message); newline
!ADC/JGH! %stop
!ADC/JGH!%finish
!ADC/JGH! define param("FILE to be edited",in,pam major+pam nodefault)
!ADC/JGH! define param("SECondary input",sec,0)
!ADC/JGH! define param("PREdefinition file",pre,0)
!ADC/JGH! define param("OUTput file (if not same as input)",out,pam newgroup)
!ADC/JGH! define enum param("NOMATCH,MATCH cases",mapcase,0)
!ADC/JGH! define enum param("COMmand,DATA edit mode",emode,0)
!ADC/JGH! define enum param("REPlace,INSert data mode",dmode,0)
!ADC/JGH! define enum param("HIlight,MARK",mark,0)
!ADC/JGH! define enum param("LATE,EARLY scrolling",early,0)
!ADC/JGH! define int param("WIDTH of line",width,0)
!ADC/JGH! define int param("MARGIN",margin,0)
!ADC/JGH! define int param("MINWIN",minwin,0)
!ADC/JGH! define int param("TTYPE",ttype,0)
!ADC/JGH! define int param("WTOP",wtop,0)
!ADC/JGH! define int param("WROWS",wrows,0)
!ADC/JGH! define int param("WLEFT",wleft,0)
!ADC/JGH! define int param("WCOLS",wcols,0)
!ADC/JGH! define int param("CTOP",ctop,0)
!ADC/JGH! define int param("CLEFT",cleft,0)
!ADC/JGH! define int param("CCOLS",ccols,0)
!ADC/JGH! define int param("MAXWIN",maxwin,0)
!ADC/JGH! define int param("VMODE",vmode,0)
!ADC/JGH! parm = ".N".parm %if parm # "" %and charno(parm,1) = pam_groupsep # ' '
!ADC/JGH! process parameters(parm)
!ADC/JGH!%end
!!!!!!!!!!!!!!!!!!! Start of Editor proper !!!!!!!!!!!!!!!!!!!
!
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 STOPPER=-10000; !loop stop
!$IF EMAS OR VAX
constinteger MINGAP=4096; !room for manoeuvre
!$IF APM
{%constinteger MINGAP=1024
!$FINISH
!Own variables (plus MACROS):-
owninteger TOGGLE=0
owninteger CASEMASK=¬casebit; !¬casebit/¬0 to ignore/heed case
owninteger DICT=0
owninteger TERM=ret; !last symbol read
owninteger SYM=ret; !last symbol got
!
integer CODE; !command code
owninteger LAST='}'
integer REF; !text or bracket pointer
integer SCOPE; !search limit
owninteger NUM=0; !repetition number
integer CONTROL,PEND; !characters
integer HOLD,HOLDSYM,QSYM; !work variables
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
!$IF EMAS
{%integer GDIFF
!$IF VAX or APM
constinteger GDIFF=0
!$FINISH
integer FOUNDPOS,FOUNDSIZE; !matched text info
owninteger MARKPOS=0,MARKLINE=0; !marker positions
record(edfile) CUR
!
! Video control
integer VIDEO
integer SMODE
integer FSCROLL, CSCROLL
integer CHALF
integer VGAP
owninteger PAN=0
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
owninteger PRINTLINE=0,PRINTED=0; !for hard-copy
!
ownstring(15) NEWPROM="??", CURPROM=""
!
integer DICTPOS
integer MAC0,MACM4,MACBASE
constinteger MSTBOUND=7
integerarray MSTACK(0:mstbound)
integer MSP; !macro stack pointer
!
!Cell format for storage of commands
!$IF EMAS
{%recordformat COMMANDCELL(%byteinteger code,ref,
{ %halfinteger scope, %integer count)
!$IF VAX OR APM
recordformat COMMANDCELL(byteinteger code,ref,
shortinteger scope, integer count)
!$FINISH
constinteger CBOUND=60
record(commandcell) array R(1:cbound)
owninteger CI=0,CMAX=0,CMAX1=0; !indexing R
!
switch C(4:15), PC('A':95), S(' ':127)
integer TYPE,CHAIN
ownrecord(commandcell) LASTCELL = 0
!
!!!!!!!!!!!!! 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]
ownintegerarray DEF(0:255) =
' ', 'G', 'K', ' ',
' ', ' ', ' ', ' ',
bsdef{BS}, 'N'{TAB}, 'M'{LF}, '{'{VT},
'>'{FF}, '1'{RT}, 'E', 'I',
'>', ' ', ' ', ' ',
' ', ' ', '}', ' ',
'>'{CAN}, 'E'+'0'<<8, ' ', ' '{ESC},
' ', ' ', '}', ' ',
' ', '!', '"', '#', '$', '%', '&', '''',
'(', ')', '*', '+', ',', '-', '.', '/',
'0', '1', '2', '3', '4', '5', '6', '7',
'8', '9', ':', ';', '<', '=', '>', '?',
'@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
' ', 526<<limshift+525{Y}, 527<<limshift+526{Z}, '[',
'¬', ']', '^', '_',
'`', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
'%'+'H'<<8, 'I', 'J', 'K', 'L', 'M', 'N', 'O',
'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
' ', ' ', ' ', '{', '|', '}', '~', null,
' ', ' ', 'F'+'"'<<8, ' '{?c},
' ', ' ', ' ', ' '{?g},
' ', ' '{?i}, ' ', '}'{ESC:VT,?k},
'%'+'C'<<8{?l}, 'm'+'0'<<8{?m}, '%'+'D'<<8, ' '{?o},
'F'+'!'<<8{?p}, 'E'+'0'<<8{?q}, 'S'+'!'<<8{?r}, '^'{?s},
'K'{?t}, 'E'{?u}, 520<<limshift+516{?v}, 'G'+'0'<<8{?w},
'I'{?x}, 516<<limshift+512{?y}, 'G'+'0'<<8{?z}, ' ',
' ', ' ', ' ', ' ',
' ', ' ', ' ', ' '{?C},
' ', ' ', ' ', ' '{?G},
' ', ' ', ' ', '}'{?K},
'{'{?L}, '¬'{?M}, ' ', ' '{?O},
' ', 'o'+'0'<<8{?Q}, 525<<limshift+520{?R}, ' '{?S},
' ', ' ', ' ' ,' '{?W},
' ', ' ', ' ', ' '{?[},
' '{¬}, ' '{]}, ' '{^}, ' '{_},
'}'{@}, '{'{A}, '}'{B}, '>'{C},
'<'{D}, 'G'{E}, ' ', ' '{G},
'H'{H}, ' ', '$'{J}, 'e'+'0'<<8{K},
'g'{L}, 'k'{M}, ' ', ' '{O},
' ', 'I'{Q}, 'K'{R}, ' ',
'E'+'0'<<8{T}, ' ', ' ', 'E'{W},
' ', ' ', ' ', ' '{[},
' ', '|'{]}, ' '{^},
' '('f'-'^'-1), 'S'+'"'<<8{f}, ' ', ' ',
'i'+'0'<<8{i}, ' ', '}'{k}, '{'{l},
' '('p'-'l'-1), 'F'+'"'<<8,
' '('z'-'p'-1), 'n'{z}, ' '(127-'z')
!Indexing MAC:
constinteger MACBOUND=8191
! 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
byteintegerarray MAC(0:macbound)
owninteger INPOS=0,INLIM=0
owninteger NEWDEF=null,CDEF=null,IDEF=null,MDEF=null
owninteger DELS=0,INITDELS=0
owninteger MPOS=0,MLIM=0
owninteger TREFLIM=trefbase,TREFLIM1=trefbase
!
on event 9,10,14 start; !End-of-input, Too big
curprom = ""
-> ignore
finish
-> edistart
!!!!!!!!! Simple (command) stream opening and closing !!!!!!!!!!!
!
routine OPEN IN(string(maxname) file)
on event 3,4,9 start
!$IF APM
{ select input(0)
!$FINISH
printstring(event_message); newline
return
finish
!$IF VAX
set video mode(smode); !without NOEVENT9
!$FINISH
open input(1,file); select input(1)
commandstream = 1
end
routine OPEN OUT(string(maxname) file)
on event 3,4,9 start
!$IF APM
{ select output(0)
!$FINISH
printstring(event_message); newline
signal 10
finish
open output(1,file); select output(1)
end
routine CLOSE IN
close input; select input(0); commandstream = 0
end
routine CLOSE OUT
close output; select output(0)
end
!
!!!!!!!!!!!!!! General-purpose output routines !!!!!!!!!!!!!!!!!!!
!
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
if win_top # wtop start
swop window
finish
!$IF EMAS OR VAX
vt at(row,col)
!$IF APM
{ gotoxy(col,row)
!$FINISH
end
routine CAT(integer row,col); !command window
if win_top # ctop start
swop window
finish
!$IF EMAS OR VAX
vt at(row,col)
!$IF APM
{ gotoxy(col,row)
!$FINISH
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
integer vrows
vrows = vdu_rows-cordon; !effective screen size [temp for Emas]
wrows = vrows-2 if wrows > vrows-2; !must have 2 lines for commands
ctop = vrows-2 if ctop > vrows-2
wtop = vrows-1 if wtop >= vrows
wrows = vrows-wtop if wrows > vrows-wtop
wtop = 0 if wtop = 1 and wtop+wrows > vrows-2
wcols = vdu_cols if wcols > vdu_cols
if wtop-2 < ctop < wtop+wrows start
ctop = wtop+wrows; !try after file window
ctop = wtop-2 if ctop+2 > vrows; !before file window
finish
ccols = 40 if ccols < 40
ccols = vdu_cols if ccols > vdu_cols
chalf = ccols>>1
video = vdu_fun
fscroll = 0; cscroll = 0
if vdu_fun&anyscroll # 0 start; !video can scroll
if wcols = vdu_cols start; !full-length rows
fscroll = 1
video = video-256 and wrows = wrows+1 if ctop = wtop+wrows
finish
cscroll = 1 if ccols = vdu_cols
finish
set frame(wtop,wrows,wleft,wcols)
wrows = wrows-1 if video < 0; !restore
win_mode = noscroll
push window; !save
set frame(ctop,2,cleft,ccols)
win_mode = noscroll
mark = 1 if vdu_fun&intense = 0; !cannot highlight
if maxwin >= wrows then maxwin = wrows c
else sec_min = wrows-maxwin-1 and cur_top = sec_min+1
end
!
routine COERCE PARAMETERS
!Make (dynamically alterable) parameters consistent
cur_min = wrows if cur_min > wrows
cur_min = 1 if cur_min = 0; !** allow as disable? **
mark = 0 if video = 0
width = 80 unless 5 <= width <= 256
margin = 0 unless margin < width
casemask = ¬0; casemask = ¬casebit if mapcase # 0
end
!
routine HEADER(integer r)
if video # 0 start
at(r,0)
!$IF VAX OR EMAS
print string("<<"); newline
!$IF APM
{ set shade(intense+graphical)
{ print symbol('`') %for r = 1,1,80
{ set shade(0)
!$FINISH
finish
end
!
routine SAVE COMMAND
!scroll down to preserve command
swop window if win_top # ctop
scroll(0,1,-1); curprom = ""
end
!
!!!!!!!!!!!!!!!!!!!!!! Misc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!$IF AnotnowPM
{%routine READ FILE
{!Read in more of the file (at least one line)
{%integer p
{%on %event 9 %start
{ select input(0)
{ %return
{%finish
{ p = cur_lim2
{ %if p = sec_lim2 %start
{ %return %if p >= sec_lim-80
{ select input(3)
{ %else
{ %return %if p >= newlim-80
{ select input(2)
{ %finish
{ %cycle
{ read ch(byteinteger(p))
{ p = p+1
{ %repeat %until byteinteger(p-1) = nl
{ %if cur_lim2 = sec_lim2 %then sec_lim2 = p %else main_lim2 = p
{ cur_lim2 = p
{ select input(0)
{%end
!$FINISH
routine SET LEND
lend = fp
!$IF AnotnowPM
{ %if fp = cur_lim2 %start
{ read file
!$FINISH
return if fp = cur_lim2
!$IF AnotnowPM
{ %finish
!$FINISH
!$IF APM
{ *MOVE LEND,A0; *MOVEQ #10,D0
{ *CMP.B (A0)+,D0; *BNE #-4; *SUBQ #1,A0
{ *MOVE A0,LEND
!$IF VAX OR EMAS
if lend # cur_lim2 start
lend = lend+1 while byteinteger(lend) # nl
finish
!$FINISH
end
!
routine SET LBEG
!Establish line start position
cur_lbeg = fp
cycle
if cur_lbeg = cur_start2 start
cur_lbeg = cur_lim1
while cur_lbeg # cur_start1 and byteinteger(cur_lbeg-1) # nl cycle
cur_lbeg = cur_lbeg-1
repeat
cur_lbeg = cur_lbeg+(cur_start2-cur_lim1)
return
finish
return if cur_lbeg = cur_start1 or byteinteger(cur_lbeg-1) = nl
cur_lbeg = cur_lbeg-1
repeat
end
!
!!!!!!!!!!!!!! S c r e e n u p d a t i n g !!!!!!!!!!!!!!!!!
!
routine DISPLAY LINE
integer k,p
p = fp; p = lend if fp > lend
cycle
vp = cur_start2 if vp = cur_lim1
exit if vp = endon
if vp = p start
cur_diff = cur_line-win_row; !NB external ref
!$IF EMAS or VAX
while vgap > 0 cycle
vgap = vgap-1; print symbol(' ')
repeat
!$FINISH
finish
if vp = vplim start
vplim = -1
return if joins = 0 and vp-altlimlbeg = win_col-mark
finish
!$IF AnotnowPM
{ read file %if vp = cur_lim2
!$FINISH
if vp = cur_lim2 start
endon = vp
print string(" **END**")
exit
finish
k = byteinteger(vp); vp = vp+1
if k < ' ' or k >= 127 start
exit if k = nl
k = '_'
finish
print symbol(k)
repeat
newline
end
!
routine REMOVE POINTER
if cur_flag >= ' ' start
at(cur_row,cur_col)
!$IF VAX or EMAS
print symbol(cur_flag)
!$IF APM
{ lolight(cur_flag)
!$FINISH
cur_flag = 0
finish
end
routine REPAIR LINE
at(cur_line-cur_diff,fp-cur_lbeg+mark)
vp = fp
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
altlimlbeg = 0; cur_start2 = fp; altlim = fp
set lbeg
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 # 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,mark); display line; r = r+1
repeat
exit
finish
finish
finish
at(r,c+mark); 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,fullpre,pre,count
!
routine SCANBACK
count = 1
while pre > 0 cycle
vp = cur_lim1 if vp = cur_start2
exit 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
end
!
routine DISPLAY LINES(integer n)
cycle
at(r,0)
print symbol(' ') if 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 # wtop
remove pointer if cur_flag > 0
endon = -1
fullpre = cur_min-1
fullpre = fullpre>>1 if lend # cur_lim2
r = cur_line-cur_diff; pre = r-cur_win
if pre < 0 start; !before start of window
if pre > -cur_min start; !not far before
if fscroll # 0 or r >= cur_top start
while r < cur_top cycle
scroll(cur_top,cur_bot-1,-1); !scroll down
r = r+1
repeat
if cur_win # r start
cur_win = r
header(cur_win-1) if cur_win > cur_top
finish
display lines(-pre)
return
finish
!$IF VAX or EMAS or APM
finish
!$IF APG
{ %finish %else fullpre = 0
!$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
if pre < cur_min start; !not far ahead
if fscroll # 0 start
scanback
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,mark)
display line
count = count-1
repeat until count = 0
return
finish
!$IF VAX or EMAS or APM
finish
!$IF APG
{ %finish %else fullpre = cur_min-1-pre
!$FINISH
finish
!Complete refresh (including window init)
pre = fullpre
scanback
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
main_top = cur_bot+1
main_win = main_top if main_win < main_top
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
header(cur_win-1) if cur_win > cur_top
finish
display lines(0)
end
!
!!!!!!!!!!!!!!!!! Command input routines !!!!!!!!!!!!!!!!!!!!!!!!
!
routine SHOW POINTER
cur_row = cur_line-cur_diff; cur_col = fp-cur_lbeg
at(cur_row,cur_col)
cur_flag = ' '
if mark = 0 start
cur_flag = byteinteger(fp) if fp < lend
!$IF VAX or EMAS
set shade(intense)
if cur_flag > ' ' then print symbol(cur_flag) c
else print symbol('|')
set shade(0)
else
if vttype # bantam then print symbol('~') c
else print symbol(esc) and print symbol(127); !splodge
!$IF APM
{ hilight(cur_flag)
{ %else
{ print symbol('~')
!$FINISH
if fp # cur_lbeg and fp <= lend start
if fp # cur_start2 then cur_flag = byteinteger(fp-1) c
else cur_flag = byteinteger(cur_lim1-1)
finish
finish
cur_flag = '_' if cur_flag < ' '
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(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 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,pos,lim
on event 9 start
if commandstream # 0 start
close in
else; !input 0 EOF
!$IF VAX
set video mode(smode!noevent9); !to force use of TT
!$IF APM
{ open input(0,":T"); select input(0)
{ read symbol(q); !!***TEMP ignore spurious NL***
!$FINISH
finish
signal 10
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
if mode >= 0 start; !data entry
length(newprom) = 2
if sin = 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
again:
!$IF APM
{ %if mode = inserting %start
{ insertpos = fp
{ insertpos = lend %if insertpos > lend
{ %finish
!$FINISH
at(cur_line-cur_diff,fp-cur_lbeg+mark) if mode >= 0
cycle
read symbol(term)
unless ' ' <= term <= del 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)
if term < ' ' then printsymbol('_') else print symbol(term)
mac(q) = term; q = q+1; q = q-1 if q&127 = 0
pos = pos+1
repeat
finish
finish else if term = del start
dels = dels+1
!$IF EMAS
{ initdels = initdels+1 %if q = p
{ curprom = ""; !in case corrupt
!$IF APM (DEL passed through without action)
{ %if q > p %start
{ q = q-1
{ %if mode = replacing %and 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
{ ! as BS SP BS or BS DC
{ %else %if mode >= 0 %and fp # cur_lbeg
{ %if fp > lend %or mode = replacing %start
{ %if fp = cur_start2 %then consolidate(1,sin) %else fp = fp-1
{ %else; !inserting: erase back
{ printsymbol(del)
{ split(0)
{ consolidate(1,-1)
{ cur_change = altmin %if altmin < cur_change
{ altlim = floor; altmin = ceiling
{ %finish
{ -> again
{ %finish
!$FINISH
else
mac(q) = term; q = q+1; q = q-1 if q&127 = 0
finish
repeat
!$IF APM
{ insertpos = 0
!$FINISH
newdef = q<<16+p and return if q > p
newdef = null
!$IF EMAS OR VAX
return if mode < 0; !not data entry
dels = 0 and initdels = 0 if fp >= lend
!$IF EMAS
{ %while initdels # 0 %and fp # cur_lbeg %cycle
{ %if fp = cur_start2 %then consolidate(1,sin) %else fp = fp-1
{ initdels = initdels-1
{ %repeat
!$FINISH
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_12{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_02{~}, 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
prepare for input
cat(0,0); print code(code); print symbol('>')
curprom = ""
clear line
read text(standard)
mdef = newdef
remove pointer if emode # 0; !in data entry mode
end
!
routine READ NUMBER
integer pos,lim,m
prepare for input
cat(0,0); print code(code); print symbol('>')
curprom = ""
pos = inpos; lim = inlim; m = msp
msp = 0
clear line; read command line
remove pointer if 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
!$IF EMAS
{%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
!$FINISH
routine MAKE ROOM(integer mingap)
!The gap has become too small: shuffle to enlarge it
integer amount,gap
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
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
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
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
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
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
cur_lim1 = cur_lim1-1
if cur_lim1 < altmin start
altmin = cur_lim1
if cur_lim1 < oldlim1 start
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
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
fp = cur_start2; cur_lbeg = fp; set lend
consolidate(0,0)
fp = newfp
else
fp = newfp
return if cur_lbeg <= fp <= lend
finish
set lbeg; 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 AnotnowPM
{ read file %if fp = cur_lim2
!$FINISH
if lend # cur_lim2 start
!$IF APM
{ *MOVE LEND,A0; *MOVEQ #10,D0
{ *CMP.B (A0)+,D0; *BNE #-4; *SUBQ #1,A0
{ *MOVE A0,LEND
!$IF VAX OR EMAS
lend = lend+1 while byteinteger(lend) # nl
!$FINISH
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
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
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 start
make room(mingap) if oldstart2+gdiff-cur_lim1 <= mingap
while fp < lend cycle
byteinteger(cur_lim1) = mac(fp)
cur_lim1 = cur_lim1+1; fp = fp+1
repeat
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
finish else if fp < lend then fp = fp+1 c
else cur_lbeg = cur_lbeg-1
byteinteger(cur_lim1) = mac(pos)
cur_lim1 = cur_lim1+1; pos = pos+1
repeat until pos = lim
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
main = cur; 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
sec = cur; 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,cur_fp-cur_lbeg); 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 = 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
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+margin if lend # cur_lim2
-> ok
!
s('}'): !Cursor down
hold = fp-cur_lbeg
-> no if line after = 0
fp = fp+hold if fp # cur_lim2
-> oklast
s('{'): !Cursor up
hold = fp-cur_lbeg
fp = cur_lbeg+hold and -> no if line before = 0
hold = hold+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 fp-cur_lbeg >= 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 and sin >= 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+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
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)
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
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 = wcols>>1; pan = pan-num
finish
finish else if last = '>' start
num = lend-fp
-> next if num <= 0
if fp = cur_lbeg+pan+wcols start
num = wcols>>1; pan = pan+num
finish
finish else if last = '{' start
update
num = cur_line-cur_diff-cur_win
num = cur_min-2 if num <= 0
num = 1 if num <= 0
else
update
num = cur_bot-1-(cur_line-cur_diff)
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
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
-> 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
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
-> 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
!
constinteger termbit=1<<16, lastbit=1<<15, dummy='a'-1
s('Q'): !Query spelling
!$IF APM
{ complain("Dictionary not available")
!$IF EMAS OR VAX
if dict = 0 start
connect direct(dictfile,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:
-> no if qsym >= 'a'
qsym = qsym+casebit
-> qagain
!$FINISH
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)
cur_lbeg = cur_lbeg+foundsize; fp = fp+foundsize; cur_start2 = fp
altlim = cur_start2 if altlim < cur_start2
!
s('I'): !+Insert
-> no if fp-cur_lbeg > width and code # 'S'
if ref = 0 start
-> over if fp >= lend
split(mingap)
!$IF EMAS OR VAX
vgap = wcols - (lend-cur_lbeg+mark)
vgap = 10 if vgap < 10
display(0)
read text(inserting)
idef = newdef
if idef >= macro start
insert(idef)
altlim = lend+1; altlimlbeg = altlim; !to remove spaces
finish else repair line; !to remove spaces
!$IF APM
{ display(0)
{ read text(inserting)
{ idef = newdef
{ %if idef >= macro %start
{ insert(idef)
{ altlim = floor; altmin = ceiling; !up-to-date
{ %finish
!$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; set lend
finish
split(0); !(to update?)
if cur_lim1 > oldlim1 start
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; 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
-> ok
!
s('i'): !Insert back
fp = lend if fp > lend
store deletions if oldstart2 < cur_start2
-> no if delmax <= lastdelmax
split(mingap>>1)
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
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
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
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
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
-> ok
!
s('O'): !Overwrite
-> no if fp-cur_lbeg > width
over:
if ref = 0 start
display(0)
read text(replacing)
idef = newdef
if idef >= macro start
overwrite(idef)
altlim = floor; altmin = ceiling; !up-to-date
finish
repair line if dels # 0
-> 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(0)
!$IF APM
{ read text(dmode)
!$IF VAX OR EMAS
read text(0)
!$FINISH
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 # 0 or lend = cur_lim2 start
repair line
-> read
finish
if dmode = replacing then overwrite(newdef) else insert(newdef)
altlim = floor; altmin = ceiling; !up-to-date
finish
repair line if dels # 0
exit if term # ret or dmode = inserting
hold = line after
fp = fp+margin if lend # cur_lim2
repeat
controlterm:
control = term; cur_flag = 0
-> again
!
!!!!!!!!!!!!!!!!!!!!!!! end of data entry !!!!!!!!!!!!!!!!!!!!!
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(0)
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,fp-cur_lbeg+mark)
finish else printsymbol(':')
read text(standard)
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(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 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
sin = -1; hold = line before; sin = 0
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 fp-cur_lbeg > 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+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) = ' '
fp = fp+1 while byteinteger(fp) > ' '
size = fp-cur_lbeg
if size > width start
result = false if byteinteger(fp1) # ' '
fp = fp1
result = true
finish
if fp = lend start
fp1 = fp+1
fp1 = cur_start2 if fp1 = cur_lim1
!$IF AnotnowPM
{ read file %if fp1 = cur_lim2
!$FINISH
result = false if fp1 = cur_lim2
foundpos = fp1
fp1 = fp1+1 while byteinteger(fp1) = ' '
result = false if byteinteger(fp1) = nl or fp1-foundpos < margin
foundpos = fp1
fp1 = fp1+1 until byteinteger(fp1) <= ' '
foundsize = fp1-foundpos; size = size+1+foundsize
result = true if size > 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
cur_lbeg = fp-size
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 < margin cycle
byteinteger(cur_lim1) = ' '; cur_lim1 = cur_lim1+1
hold = hold+1
repeat
oldlim1 = cur_lim1
cur_lbeg = fp-margin
finish
-> ok if type # 0
-> no
!
s('@'): !'at' Column NUM
-> fail if lend = cur_lim2
hold = width-(lend-fp)
num = hold if hold < num
if fp >= lend start
fp = cur_lbeg+num and -> next if cur_lbeg+num >= lend
fp = lend
finish
hold = fp-cur_lbeg-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) # ' '
cur_lim1 = cur_lim1-1; cur_lbeg = cur_lbeg+1
altmin = cur_lim1 if altmin > cur_lim1
hold = hold-1
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
cur_start2 = fp; altlim = cur_start2 if altlim < cur_start2
-> next
s('|'): !Toggle Destructive Mode
-> disallowed if sin > 0
if sin = 0 start
fp = lend if fp > lend
-> fail if fp-cur_lbeg > width
split(0); altlim = floor+1; sin = -1
markpos = 0
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('$'): !switch inputs
fp1 = markpos; fp = lend if fp > lend
switch
if sin = 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; -> err if sym < '@'
code = sym&31
if code = esc start
get sym
if sym = '?' start; !canonical 2nd leadin
get sym; sym = sym!!96
finish
code = sym+128
finish
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
!
routine SET OPTIONS
integer i,k
constinteger showpointer=1
conststring(15)array text(0:enumcases+intcases-1) =
"Case-matching [",
"Show position [",
"Update [",
"Data mode [",
"Edit mode [",
"Line width [",
"Left margin [",
"Min. window ["
conststring(7)array OPTNAME(0:enumcases*2-1) =
"NOMATCH", "MATCH",
"HILIGHT","MARK",
"LATE", "EARLY",
"REPLACE", "INSERT",
"COMMAND", "DATA"
routine SHOW(integer i)
integer j
if i >= enumcases then write(value(i),1) c
else print string(optname(i+i+bvalue(i)))
end
cat(1,0)
printstring( "RETURN to step through value or 'x' to alter ':' to exit")
newline
cycle
for i = 0,1,enumcases+intcases-1 cycle
cat(0,0)
printstring(text(i))
minwin = cur_min; !relevant current setting
show(i)
printstring("] :")
clear line
read command line
get sym
if sym # ret start
if sym = ':' start
save command; !ie last shown
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 # minwin start
cur_min = minwin
cur_win = offscreen; cur_diff = unknown
finish
else
bvalue(i) = bvalue(i)!!1
cur_diff = unknown if i = showpointer
finish
coerce parameters
i = i-1
finish
repeat
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 = '"' 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",
"reserved",
"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:
lastcell_code = ')'; lastcell_count = 1
!Stored text pointers
cdef = null; idef = null; mdef = 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
!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
!$IF EMAS
{ gdiff = 0
{ %unless cur_lim1 <= cur_lim2 <= cur_lim %start
{ newlim = cur_lim-1024
{ gdiff = newlim-cur_lim2
{ %finish
!$IF APM
{ newlim = cur_lim-1024
!$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
vgap = 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; set lend
!
!Initialise video info
![XOR so that VMODE can, awkwardly, suppress]
smode = vmode!!screenmode!!specialpad
!$IF VAX or EMAS
define video(ttype) and ttype = -2 if 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
!$FINISH
prompt("")
set video mode(smode)
set windows
cur_bot = wrows; cur_min = minwin
cur_win = offscreen; cur_diff = unknown
coerce parameters
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 pre # "" start
open in(pre)
emode = 0
finish
resetread:
pre = ""; curprom = ""
inpos = inlim; msp = 0
read:
if markpos = 0 then newprom = prom(sin) c
else newprom = prom(sin+4)
-> data entry if emode # 0
pend = 0; control = -1
if inpos >= inlim start; !no input available
if commandstream = 0 start; !on-line
prepare for input
if newprom # curprom or video = 0 start
curprom = newprom
cat(0,0); printstring(curprom)
finish
cat(0,2); clear line
finish
read command line until inlim > inpos or commandstream+msp = 0
control = term if inpos >= inlim
finish
!Reset command variables
again:
chain = 0; cmax = cmax1
get code(first)
if control >= 0 start; !control key
if code = '¬' start; !toggle editing mode
emode = emode!!1; toggle = ¬toggle
!$IF APM
{ dmode = dmode!!1 %if toggle = 0; !insert<->replace
!$FINISH
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 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 until sym # ' '
-> pc(code&95)
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 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 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
pc(*): c(*):
er5:
report(" "); print code(code)
-> erq
er6:
report(" Size")
erq:
print symbol('?')
cmax1 = 0 if ci > 1
newline
save command if 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 if sym = '='
if sym >= ' ' start
get name(sec_name)
sec_flag = 0
connect edfile(sec)
sec_flag = 0
finish
sec_line = 0; !indicator for reset
switch
-> read
pc('G'): !Get command file
get name(pre)
close in if commandstream # 0
-> comread
pc('P'): !Put key definitions
get name(pre)
open out(pre) if pre # ""
pre = ""
output keydefs
close out
-> read
pc('U'): !ignore/heed case
mapcase = 1
mapcase = 0 and get sym if sym = '-'
coerce parameters
-> read
pc('L'): !Line width
get sym if sym = '='
number; -> erq if type # 0
width = num
coerce parameters
-> read
pc('M'): !Margin
get sym if sym = '='
number; -> erq if type # 0
margin = num
coerce parameters
-> read
pc('D'): !Display
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 = ""
-> read
pc('H'): !Help
remove pointer
!$IF EMAS or VAX
push window
win = vdu
vt at(ctop+1,0); !in case of error report
!$IF EMAS
{ set video mode(0)
!$FINISH
!$IF EMAS OR VAX
if sym < ' ' then view(helpfile) c
else get name(pre) and view(pre) and pre = ""
!$IF EMAS
{ set video mode(smode)
!$FINISH
!$IF EMAS OR VAX
pop window
-> qread
!$IF APM
{ complain("Help not available")
!$FINISH
pc('E'): !Environment
remove pointer
set options
curprom = ""
-> read
pc('W'):
-> erq if sin # 0
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'):
if sym >= ' ' start; !definition
pend = sym
define(code)
else; !enquiry
explain(code)
finish
-> read
pc('Q'):
if sym # ret or term # ret start
pend = sym; get code(nomac)
get sym if sym >= ' '
explain(code)
else
cycle
cat(0,0); printstring("Key (or :): "); 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
curprom = ""
-> read
pc('K'): !define key(s)
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
cat(0,0); printstring("Key = defn: "); clear line
read text(nomac)
inpos = newdef&posmask; inlim = newdef>>16
get code(nomac)
exit if code = ':'
if inpos >= inlim start
printsymbol('*') unless ' ' <= code < del
read command line
finish
define(code)
repeat
finish
curprom = ""
-> read
pc('A'): !Abandon
update
switch if sin&(¬1) # 0
if cur_change # ceiling start
!Change made
printstring(" Abandon complete edit? (y/n) ")
read command line
get sym; -> ignore if sym!casebit # 'y'
get sym; -> ignore if sym >= ' '
finish
sym = -1; cur_change = ceiling
pc('C'): !Close
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
main = cur
pop window; pop window
!$IF EMAS OR VAX
vt at(vdu_rows-1,0)
!$IF APM
{ gotoxy(0,vdu_rows-1)
!$FINISH
clear line; ! print symbol(rt); print symbol(0); !to flush
set video mode(0)
end; !END OF EDI
!
!$IF VAX
externalroutine DISCONNECT EDFILE(record(edfile)name out)
integer i,k
if out_flag < 0 or out_change < 0 start
deletevm(out_start1,out_lim)
return
finish
i = out_lim2-out_start2; !lower half
move(i,out_start2,out_lim1); ! concatenated to upper
out_lim1 = out_lim1+i
cycle
i = writeout(out_name,out_start1,out_start1,out_lim1,out_lim)
exit if i = 0
{¬V10IMP print string(" *".sysmess(i).": ".out_name)
{V10IMP} print string(" *".get message(i).": ".out_name)
newline
print string(" Please supply alternative file-name: ")
select input(0); prompt("")
out_name = ""
read symbol(k) until k # ' '
cycle
out_name = out_name.tostring(k); read symbol(k)
repeat until k < ' '
newline
repeat
end
!$IF APM
{%external%routine DISCONNECT EDFILE(%record(edfile)%name out)
{%label nogo
{%integer i,k
{%on %event 9,4 %start
{ select output(0)
{ printstring("*Unable to write to ".out_name." [".event_message."]")
{ newline
{ printstring("Please supply alternative filename [eg PUB:...] ")
{ select input(0); prompt("")
{ out_name = ""
{ read symbol(k) %until k # ' '
{ %cycle
{ k = k-32 %if k > 96
{ out_name = out_name.tostring(k); read symbol(k)
{ %repeat %until k < ' '
{ newline
{%finish
{ %if out_flag >= 0 %and out_change >= 0 %start
{ open output(2,out_name)
{ select output(2)
{ i = out_start1
{ %while i # out_lim1 %cycle
{ print ch(byteinteger(i)); i = i+1
{ %repeat
{ i = out_start2
{ %while i # out_lim2 %cycle
{ print ch(byteinteger(i)); i = i+1
{ %repeat
{ close output
{ select output(0)
{ %finish
{ i = out_lim+256
{ *cmp i,d6
{ *bne nogo
{ i = out_start1+256
{ *move i,d6
{nogo:
{%end
!$FINISH
endoffile