!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.
!
!
!
!
!
!
!
!
!
!
!
!!!!!!!!!!!!!! Standard Video Terminal Interface !!!!!!!!!!!!!
!$IF VAX or AMDAHL
! 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, NODELECHO=1<<14, INSERTMODE=1<<15
constinteger SCREENMODE=controlterm+notermecho+leavecontrols
! 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 CANINSERT=32; !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 key u, key d, key l, key r
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 AMDAHL
{%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 VAX or AMDAHL
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=127
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},
shift {right shift of window on file},
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)
! Machine code routines to do fast searches for and counts of bytes
external integer fn spec search(integer start,finish,key)
external integer fn spec search back(integer start,finish,key)
external integer fn spec count(integer start,finish,key)
!
!** 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
constinteger MINWIN0=24, MAXWIN0=99
conststring (13) HELPFILE="ECCE_HELP"
conststring (13) DICTFILE="ECCE_DICT"
externalroutinespec MOVE(integer length,from,to)
!%externalintegerfnspec CHECKQUOTA(%string(127) filename)
! %alias needed for Lattice imp. Also if file LLEXTRA
externalstring (72)fnspec SYSMESS (integer i)
!
! 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)
!
external routine 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
print string(" *".sysmess(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,15 start
return
finish
! f = connect(file,s,l,0)
connect file(file,0,s,l)
base = s {%if f&1 # 0
end
routine call out(string (255) s)
record format desc fm(integer len, addr)
external integer fn spec spawn alias "LIB$SPAWN" (record (desc fm)name com)
record (desc fm) comdesc
integer flag
comdesc_len=length(s)
comdesc_addr=addr(s)+1
if s # "" then flag = spawn(comdesc) else flag = spawn(nil)
printstring(sysmess(flag)) if flag&1=0
end
! This crashes if the help library is not available
!%routine view(%string(255) key)
! %externalroutinespec help %alias "IMP_GIVE_HELP"(%string(255)l,c,%integer p)
! %on %event 9 %start; %finish
! %conststring(13) HELPLIB="ECCE_HELP"
! help(helplib,"VECCE ".key,1)
!%end
!
routine view(string (255) key)
record format desc fm(integer len, addr)
external integer fn spec spawn alias "LIB$SPAWN" (record (desc fm)name com)
record (desc fm) comdesc
integer flag
string (255) s
s <- "HELP/LIBRARY=".helpfile." VECCE ".key
comdesc_len=length(s)
comdesc_addr=addr(s)+1
flag = spawn(comdesc)
return if flag&1#0
printstring(" * Help not available")
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 AMDAHL
{%constinteger CORDON=0; !to alleviate effects of echoed typeahead
{%constinteger BSDEF='<'
{%constinteger MINWIN0=7, MAXWIN0=99
{%external %integer %function %spec existtype %alias "S#EXISTTYPE"(%string(255)f)
{%external %routine %spec emas3string(%stringname vec,val)
{%external %routine %spec emas3integer(%stringname vec,%integername val)
{%routine emas3byte(%stringname vec,%byteintegername val)
{! to make calls on emas3integer easier when all we want is a byte
{ %integer x
{ emas3integer(vec, x)
{ x = x & 255
{ val <- x
{%end
{%externalroutinespec EMAS3(%stringname com, par, %integername flag)
{%externalstringfnspec SYSMESS %alias "S#FAILUREMESSAGE" (%integer i)
{%external %integer %function %spec vdui %alias "S#VDUI"(%integer i)
{%external %string %function %spec itos %alias "S#ITOS"(%integer i)
{%conststring(17) helpfile="ERCLIB:VECCE.VIEW"
{%conststring(17) dictfile="ERCLIB:VECCE.DICT"
{%integer %function set trap(%integer %name id, class, subclass)
{ %external %routine %spec proc %alias "EMAS3SETTRAP"(%integer %name id,
{ class, subclass, flag)
{ %integer flag
{ proc(id, class, subclass, flag)
{ %result = flag
{%end; ! Of %integer %function set trap.
{%integer %function discard trap(%integer %name id)
{ %external %routine %spec proc %alias "EMAS3DISCARDTRAP"(%integer %name id,
{ flag)
{ %integer flag
{ proc(id, flag)
{ %result = flag
{%end; ! Of %integer %function discard trap.
{%external %routine %spec reset context %alias "EMAS3RESETCONTEXT" %C
{ (%integername trap,flag)
{%external %routine %spec set message control %alias "S#SETMESSAGECONTROL" %C
{ (%integer type)
{%external %routine %spec trap %alias "EMAS3TRAP"(%integer %name id, prot, flag)
{%external %routine %spec give event %alias "EMAS3GIVEEVENT"(%integer %c
{ %name class, subclass)
{%external %routine %spec signal %alias "EMAS3SIGNAL"(%integer %name %c
{ class, subclass)
{%external %routine %spec allow interrupts %alias "S#ALLOWINTERRUPTS"
{%externalroutinespec prompt %alias "S#PROMPT"(%string(255)s)
{%externalroutinespec tojournal %alias "S#TOJOURNAL" (%integer from, len)
{%externalintegerfnspec %c
{ dmessage(%stringname user, %integername len, act, invoc, fsys, adr)
{
{%routine view(%string(255)s)
{ %integer flag
{ s = ",".s %if s # ""
{ emas3("VIEW",helpfile.s,flag)
{ prompt("")
{%end; !of routine view
{
{%routine call out(%string(255)s)
{ %string(255)command,parameters
{ %integer flag
{ %external %routine %spec emas3h(%stringname com,par,%integer %name flag)
{ command = s %and parameters = "" %unless s -> command.(" ").parameters
{ emas3h(command,parameters,flag)
{ prompt("")
{%end
{
{%externalroutinespec move %Alias "S#MOVE" (%integer len,from,to)
{
{!%include "FCP#INC"; !*****Assumes that FCP is in the same directory***
{!****** Now part of XECCE, KR.*****
{
{%externalroutinespec emas3checkname %c
{ (%string %name name, %integer %name type, qualifier, flag) {sriririw}
{%external %routine %spec TRIM %alias "s#trim"(%string (255) FILE,
{ %integer %name FLAG)
{%external %integer %map %spec COMREG %alias "s#comregmap"(%integer N)
{%external %routine %spec CONNECT %alias "s#connect"(%string (255) FILE,
{ %integer MODE, HOLE, PROT, %integername CONAD, TYPE, START, END, FLAG)
{%external %routine %spec DISCONNECT %alias "S#DISCONNECT"(%string(255) FILE,
{ %integer %name flag)
{%external %routine %spec OUT FILE %alias "s#outfile"(%string (255) FILE,
{ %integer SIZE, HOLE, PROT, %integer %name CONAD, FLAG)
{%external %routine %spec NEWGEN %alias "s#newgen"(%string (255) FILE,
{ NEWFILE, %integer %name FLAG)
{%external %routine %spec RENAME %alias "s#rename"(%string (255) FILE,
{ NEWFILE, %integer %name FLAG)
{%external %string(255) %fn %spec NEXT TEMP %alias "S#NEXTTEMP"
{!%external %routine %spec SET FNAME %alias "s#setfname"(%string (255) FNAME)
{%external %routine %spec SET FNAME %alias "emas3setfname"(%string(255)%name FNAME)
{%external %routine %spec MOD PD FILE %alias "s#modpdfile"(%integer EP,
{ %string (255) PDFILE, %string (11) MEMBER, %string (255) INFILE,
{ %integer %name FLAG)
{%routine CHERISH(%string (255) S)
{ %integer FLAG
{ emas3("CHERISH", s, flag)
{%end; ! Of %ROUTINE cherish.
{%external %string %function %spec UINFS %alias "s#uinfs"(%integer N)
{%external %integer %function %spec UINFI %alias "s#uinfi"(%integer N)
{%constinteger max file size = 6, default define size = 36
{%constinteger ksh=10
{%external %integer TEMPID = 0
{%const %integer macbound = 8191
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
{%external %routine MAKE OUTPUT FILE(%record(edfile)%name out)
{ %integer holesize,tempsize,outhead,extra, i, newstart
{ holesize = uinfi(default define size);extra = out_flag; tempid = tempid + 1
{ holesize = holesize>>1 %while holesize >= 2*16384 %and %c
{ holesize+extra > uinfi(max file size)<<ksh
{ %if holesize+extra > uinfi(max file size)<<ksh %start
{ tempid = tempid - 1
{ out_flag=280
{ %return
{ %finish
{
{ %cycle
{ tempsize = extra + holesize
{ outfile("T#ETEMP".itos(tempid),-tempsize,tempsize,0,outhead,out_flag)
{ %exit %if out_flag=0
{ tempid = tempid - 1 %and %return %if holesize = 16384; ! 16k - minimum reasonable
{ holesize = holesize>>1
{ %repeat
{ out_start1 = outhead+32; out_lim1 = out_start1
{ out_lim = out_start1+integer(outhead+8)-32
{ out_lim = out_lim - (macbound+1+1024); ! Leave room for macro storage
{ %if out_start2 = 0 %start
{ out_start2 = out_start1+1; out_lim2 = out_start2
{! %else; ! Copy input file to new area
{! i = out_lim2 - out_start2
{! newstart = out_lim-1024-i
{! move(i,out_start2,newstart)
{! out_start2 = newstart
{! out_lim2 = out_start2+i
{ %finish
{%end
{
{%own %integer ignore exist = 0
{%external %integer %function CHECK OUTPUT FILE(%string (255) S, %integer DEFAULT)
{%string (255) user,junk, s1, s2
{%integer flag
{ default = 1 %if ignore exist # 0; ! Allow overwrite without quey
{ emas3checkname(s,1,x'4000' ! x'80' ! 4 ! 2 , flag)
{ ! myfile char exist write
{! Keith - if we use the x'4000' we dont need to check ownership -- Graham
{! ( I know its not in the manual but it is in the subsystem!)
{! %if ( s -> user.("{").junk %or s -> user.(":"). junk ) %c
{! %and user # uinfs(1) %and user # "" %c
{! %then setfname(s) %and %result = 258 {Illegal use of another user's file}
{ %if s -> s1.("_").s2 %start; !PD file
{ flag = 287 %if flag = 0 %and default = 0 {Member already exists}
{ %if flag = 288 %then %c {Member does not exist}
{ emas3checkname(s1, 2 , x'400' ! 4 , flag)
{ ! file pdfile exist
{ setfname(s2)
{ %else
{ flag = 219 %if flag = 0 %and default = 0 {File already exists}
{ flag = 0 %if flag = 218 {File doesn't exist}
{ setfname(s)
{ %finish
{ %result = flag
{%END; !of check output file
{!
{%EXTERNAL %ROUTINE connect edfile(%RECORD (edfile) %NAME f)
{ %integer conad, filetype, datastart, dataend
{ f_start2 = 0; f_lim2 = 0; f_flag = 0; f_change = 0
{ %RETURN %IF f_name = ""
{ connect(f_name, 0, 0, 0, conad, filetype, datastart, dataend, f_flag); !any mode,any size,no protect
{ %IF f_flag = 0 %START
{ %IF filetype = 3 %START
{ f_start2 = conad + datastart
{ f_lim2 = conad + dataend
{!***** f_lim2 = f_lim2 - 1 %WHILE %C
{ f_lim2 # f_start2 %AND byteinteger(f_lim2 - 1) # nl
{ %FINISH %ELSE %START
{ f_flag = 267; !invalid filetype
{ setfname(f_name)
{ %FINISH
{ %FINISH
{%END; !of connect input
{
{%ROUTINE connect direct(%STRING (255) name, %INTEGER %NAME start)
{ %integer conad, filetype, datastart, dataend, f
{ connect(name, 0, 0, 0, conad, filetype, datastart, dataend, f)
{ start = 0; start = conad + datastart %IF f = 0
{%END
{
{%routine newgen or rename(%string(255) from, to, %integer %name flag)
{! Keith - I have added this routine to abstract out all the occurrences
{! of newgen then rename. This is also a suitable place to handle the
{! case of using secondary indexes. As far as I can see both ECCE and EDIT
{! get round this by creating their workfile in the index to be written to.
{! I have just added code to copy the output file across.
{! (In case you have never seen a secondary index - the problem is quite
{! clear when you write out the edit. - a message appears that both files
{! (presumably of the newgen or rename) have to be on the same index.)
{! Graham
{
{ %routine copy to index(%string %name from file, to file, %integer %name flag)
{ %external %routine %spec copy %alias "S#COPY"(%string(255) from file,
{ to file, %integer %name flag)
{ %integer from fsys, to fsys, xflag
{ %string(255)from index, to index, invocs, tempfile
{
!$FINISH
! eg if we have to handle ERCC14:T#ETEMP and ERCC14{TEX}:XXX
! it is clear that we must copy T#ETEMP to the index {TEX}: before the
! newgen and rename calls used below have any chance of working
! so we will copy ERCC14:T#ETEMP to ERCC14{TEX}:T#ETEMP and return
! the new value of 'from file'
! we do NOT destroy ERCC14:T#ETEMP as it may be needed later if the
! rename and newgens both fail (it will end up being renamed
! ERCC14:VECCE#SAVE so has to be in ERCC14: rather than ERCC14{TEX}:
!$IF AMDAHL
{
{ emas3checkname(from file, 1, 1 ! 4 ! 16 , 0)
{ ! fileormem read exist nosuffix
{ emas3checkname(to file, 1, 2 ! 16 , 0)
{ ! fileormem write nosuffix
{ { names are now fully expanded so we can just resolve on : }
{ to file -> to index.(":")
{ from file -> (":").temp file
{ copy(from file, toindex.":".temp file, flag)
{ flag = flag & x'7fffffff' { strip off top bit }
{ %if flag = 0 %then from file = to index.":".temp file
{ %end;! of copy to index
{
{ %if to -> ("{") %then %start
{ copy to index(from, to, flag)
{ %finish
{ newgen(from, to, flag)
{ %IF flag # 0 %START
{ rename(from, to, flag)
{ cherish(to) %IF flag = 0
{ %FINISH
{%end;! of newgen or rename
{
{%EXTERNAL %ROUTINE disconnect edfile(%RECORD (edfile) %NAME out)
{ %STRING (255) s1, s2, tempfile
{ %INTEGER i, outhead, f
{ %RETURN %IF out_change < 0 %OR out_flag < 0 %OR out_lim1 = 0
{ i = out_lim2 - out_start2; !lower half
{ move(i, out_start2, out_lim1); ! concatenated to upper
{ out_lim1 = out_lim1 + i
{ outhead = out_start1 - 32
{ integer(outhead) = out_lim1 - outhead; !including header
{ tempfile = "T#ETEMP".itos(tempid)
{ tempid = tempid - 1
{ trim(tempfile, out_flag)
{ %RETURN %IF out_flag # 0; ! EMAS is broke if this happens!!
{ %IF out_name -> s1.("_").s2 %THEN %START
{ modpdfile(2, s1, s2, "", out_flag); !destroy first
{ modpdfile(1, s1, s2, tempfile, out_flag)
{ %IF out_flag # 0 %START
{ printstring("Unable to write to pdfile ".s1); newline
{ %FINISH
{ %FINISH %ELSE %START
{ newgen or rename(tempfile, out_name, out_flag)
{ %FINISH
{ %if out_flag#0 %start
{ out_name = ":VECCE#SAVE".itos(tempid+1)
{ newgen(tempfile, out_name,f)
{ %if f # 0 %start
{ rename(tempfile, out_name,f)
{ cherish(out_name) %if f = 0
{ %finish
{ %if f # 0 %then disconnect(tempfile,f) %and out_name = tempfile
{ %finish
{%END; !disconnect edfile
{
{%external %routine BACKUP EDFILE (%record(edfile)%name out)
{ %STRING (255) s1, s2, tempfile
{ %INTEGER i, outhead,f, tempsize
{ %RETURN %IF out_change < 0 %OR out_flag < 0 %OR out_lim1 = 0
{ tempsize = out_lim1-out_start1 + out_lim2-out_start2 + 32
{ tempfile = "T#".nexttemp; ! Don't care what it's called
{ outfile(tempfile,tempsize,0,0,outhead,out_flag); ! Make new file
{ %return %unless out_flag = 0
{ i = out_lim1 - out_start1
{ move(i,out_start1,outhead+32); ! Copy upper half to new file
{ move(out_lim2-out_start2,out_start2,outhead+32+i); ! Lower half
{ integer(outhead) = tempsize
{ trim(tempfile, out_flag)
{ %RETURN %IF out_flag # 0; ! EMAS is broke if this happens!!
{ %IF out_name -> s1.("_").s2 %THEN %START
{ modpdfile(2, s1, s2, "", out_flag); !destroy first
{ modpdfile(1, s1, s2, tempfile, out_flag)
{ %IF out_flag # 0 %START
{ printstring("Unable to write to pdfile ".s1); newline
{ %FINISH
{ %FINISH %ELSE %START
{ newgen or rename(tempfile, out_name, out_flag)
{ %FINISH
{ %if out_flag#0 %start
{ out_name = ":VECCE#SAVE".itos(tempid+1)
{ newgen or rename(tempfile, out_name, f)
{ %if f # 0 %then disconnect(tempfile,f) %and out_name = tempfile
{ %finish
{%end; ! of BACKUP EDFILE
{!
{!
!$FINISH
!
!!!!!!!!!!!!!!!!!!! Editor parameters and options !!!!!!!!!!!!!!!!!
!** NB ORDER -- see VALUE
constinteger ENUMCASES=6, INTCASES=3
const integer MAXTAB=15
!
record format opt fm ( c
byte MAPCASE {1/0 ignore/heed case},
MARK {1/0 show FP by mark/hilight},
EARLY {1/0 update early/late},
DMODE {1/0 insert/replace},
EMODE {1/0 data/command},
EXPTABS {1/0 expand/standard},
integer WIDTH {line width},
MARGIN {left margin},
MINWIN {minimum window size},
integer TTYPE {EMAS terminal number},
integer WTOP, WROWS {window area top,rows},
integer WLEFT, WCOLS {window area left,cols},
integer CTOP {command row (1st of 2)},
integer CLEFT, CCOLS {command area left,cols},
integer MAXWIN {Maximum window size},
integer VMODE {Video mode flags},
bytearray TABS(0:maxtab) {Tab columns},
string (maxname) LOGFILE {Name of Editor Log Output file},
string (maxname) PRE {Pre definitions file} )
own record (opt fm) OPTIONS
!** end of OPTIONS
!
!$IF AMDAHL
{%conststring(11) profile key = "V.profile"
{%constinteger profile version = 1
{
{%routine get saved profile(%record(opt fm)%name options)
{ %externalroutinespec readprofile %alias "S#READPROFILE" %c
{ (%string(11) key, %name data, %integername version, flag)
{ %record(opt fm)new opt
{ %integer version,flag
{ new opt = 0
{ read profile(profile key, new opt, version, flag)
{ %if flag # 0 %then %return
{ %if version # profile version %then %return
{ options = new opt
{%end
{
{%routine set saved profile(%record(opt fm) options)
{ %externalroutinespec writeprofile %alias "S#WRITEPROFILE" %c
{ (%string(11) key, %name data, %integername version, flag)
{ %integer version,flag
{ version = profile version
{ write profile(profile key, options, version, flag)
{%end
{
{%const %string(10) %array btext(0:1, 1:enumcases) = %c
{ "NOMATCH", "MATCH",
{ "HILIGHT", "MARK",
{ "LATE", "EARLY",
{ "REPLACE", "INSERT",
{ "COMMAND", "DATA",
{ "NO", "YES"
!$FINISH
externalroutine SET PARAMETERS(string (maxname)name in,sec,out,
string (255) parm)
integer t, save options
on event 5 start
printstring(event_message); newline
stop
finish
! Initialise the Editor Options to their default values
options = 0; ! Zero whole record
OPTIONS_mapcase = 1
OPTIONS_width = 80
OPTIONS_minwin = minwin0
OPTIONS_ttype = -1
!$IF APM
{OPTIONS_ttype = 11
!$FINISH
OPTIONS_wrows = 255
OPTIONS_wcols = 255
OPTIONS_ctop = 99
OPTIONS_ccols = 255
OPTIONS_maxwin = maxwin0
OPTIONS_tabs(t) = 8*t for t = 0,1,maxtab
!$IF AMDAHL
{OPTIONS_logfile = ".JOURNAL"
!$FINISH
!$IF VAX
! this vax version if for use with the CLD definitions etc supplied by Alan Culloch
! of Lattice Logic
! In this case "parm" is ignored but "in","sec",and "out" will be filled in
! %from IMP %include CLIParse
! This for CS IMP
include "IMP_INCLUDE:CLIPARSE.INC"
!NB QualifierI returns zero if the qualifier is not present. Similarly,
! QualifierS returns the null string
In = Qualifier S("FILE")
Out = Qualifier S("OUTPUT")
Sec = Qualifier S("SECNAME")
OPTIONS_Pre = Qualifier S("PRE")
OPTIONS_Logfile = Qualifier S("LOG")
OPTIONS_Map Case = 0 unless Qualifier Present("MATCH")
OPTIONS_Mark = 0 if Qualifier Present("HILIGHT")
OPTIONS_Mark = 1 if Qualifier Present("MARK")
OPTIONS_Early = 0 if Qualifier Present("LATE")
OPTIONS_Early = 1 if Qualifier Present("EARLY")
OPTIONS_Dmode = 1 if Qualifier Present("INSERT")
OPTIONS_Emode = 1 if Qualifier Present("EMODE")
OPTIONS_Exptabs = 1 if Qualifier Present("TAB_EXPAND")
OPTIONS_Width = Qualifier I("WIDTH")
OPTIONS_Margin = Qualifier I("MARGIN")
OPTIONS_Min Win = Qualifier I("MINWIN") if Qualifier Present("MINWIN")
!GR??? I dont think the next should still be here!!!
!KR Yes it should to allow /TTYPE=0 for line mode
OPTIONS_T Type = Qualifier I("TTYPE") if Qualifier Present("TTYPE")
OPTIONS_W Top = Qualifier I("WTOP")
OPTIONS_W Rows = Qualifier I("WROWS") if Qualifier Present("WROWS")
OPTIONS_W Left = Qualifier I("WLEFT")
OPTIONS_W Cols = Qualifier I("WCOLS") if Qualifier Present("WCOLS")
OPTIONS_C Top = Qualifier I("CTOP") if Qualifier Present("CTOP")
OPTIONS_C Left = Qualifier I("CLEFT")
OPTIONS_C Cols = Qualifier I("CCOLS") if Qualifier Present("CCOLS")
OPTIONS_Max Win = Qualifier I("MAXWIN") if Qualifier Present("MAXWIN")
OPTIONS_Vmode = Qualifier I("VMODE")
!$IF APM
{ in = ""
{ define param("FILE to be edited",in,pam major+pam nodefault)
{ sec = ""
{ define param("SECondary input",sec,0)
{ OPTIONS_pre = ""
{ define param("PREdefinition file",OPTIONS_pre,0)
{ define param("LOGfile name",OPTIONS_logfile,0)
{ define param("OUTput file (if not same as input)",out,pam newgroup)
{ out = ""
{ define enum param("NOMATCH,MATCH cases",OPTIONS_mapcase,0)
{ define enum param("HIlight,MARK",OPTIONS_mark,0)
{ define enum param("LATE,EARLY scrolling",OPTIONS_early,0)
{ define enum param("REPlace,INSert data mode",OPTIONS_dmode,0)
{ define enum param("COMmand,DATA edit mode",OPTIONS_emode,0)
{ define enum param("NOEXPand,EXPand Tabs",OPTIONS_exptabs,0)
{ define int param("WIDTH of line",OPTIONS_width,0)
{ define int param("MARGIN",OPTIONS_margin,0)
{ define int param("MINWIN",OPTIONS_minwin,0)
{ define int param("TTYPE",OPTIONS_ttype,0)
{ define int param("WTOP",OPTIONS_wtop,0)
{ define int param("WROWS",OPTIONS_wrows,0)
{ define int param("WLEFT",OPTIONS_wleft,0)
{ define int param("WCOLS",OPTIONS_wcols,0)
{ define int param("CTOP",OPTIONS_ctop,0)
{ define int param("CLEFT",OPTIONS_cleft,0)
{ define int param("CCOLS",OPTIONS_ccols,0)
{ define int param("MAXWIN",OPTIONS_maxwin,0)
{ define int param("VMODE",OPTIONS_vmode,0)
{ parm = ".N".parm %if parm # "" %and charno(parm,1) = pam_groupsep # ' '
{ process parameters(parm)
!$IF AMDAHL
{ get saved profile(OPTIONS)
{ emas3string("FILE to be edited;fileormem,or.null,cowild;?;". %c
{ "call pamhelp(ERCLIB:VECCE.PAM)",in)
{ emas3string("OUTPUT file;fileormem,write,ornull,or.null,cowild;".in,out)
{ emas3string("SECondary input;fileormem,exist,char,ornull;;",sec)
{ emas3integer("TTYPE;;".itos(vdui(1)),OPTIONS_ttype)
{ OPTIONS_pre = ":VDEFS_ED".itos(OPTIONS_ttype)
{ %unless existtype(OPTIONS_pre)=3 %then %start
{ OPTIONS_pre = "ERCLIB:VECCE.PREDEFS".itos(OPTIONS_ttype)
{ OPTIONS_pre = "" %unless existtype(OPTIONS_pre)=3
{ %finish
{ emas3string("PREdefinition file;filelist,join,exist,char,ornull;".OPTIONS_pre.";",OPTIONS_pre)
{ emas3string("LOGfile name;fileordev,write,noexist,char,ornull;".OPTIONS_logfile.";",OPTIONS_logfile)
{emas3byte("Case Matching;word,NOMATCH,MATCH;".btext(OPTIONS_mapcase,1).";",
{ OPTIONS_mapcase)
{emas3byte("Show Position;word,Hilight,Mark;".btext(OPTIONS_mark,2).";",
{ OPTIONS_mark)
{emas3byte("Update;word,Late,Early;".btext(OPTIONS_early,3).";",
{ OPTIONS_early)
{emas3byte("Data Mode;word,Replace,Insert;".btext(OPTIONS_dmode,4).";",
{ OPTIONS_dmode)
{emas3byte("Edit mode;word,COMMAND,DATA;".btext(OPTIONS_emode,5).";",
{ OPTIONS_emode)
{emas3byte("Tab expansion;word,no,yes;".btext(OPTIONS_exptabs,6).";",
{ OPTIONS_exptabs)
{emas3integer("Width of line;1:;".itos(OPTIONS_width),OPTIONS_width)
{emas3integer("Margin;;".itos(OPTIONS_margin),OPTIONS_margin)
{emas3integer("Minwindow size;1:;99",OPTIONS_minwin)
{emas3integer("WTOP;;".itos(OPTIONS_wtop),OPTIONS_wtop)
{emas3integer("WROWS;;".itos(OPTIONS_wrows),OPTIONS_wrows)
{emas3integer("WLEFT;;".itos(OPTIONS_wleft),OPTIONS_wleft)
{emas3integer("WCOLS;;".itos(OPTIONS_wcols),OPTIONS_wcols)
{emas3integer("CTOP;;".itos(OPTIONS_ctop),OPTIONS_ctop)
{emas3integer("CLEFT;;".itos(OPTIONS_cleft),OPTIONS_cleft)
{emas3integer("CCOLS;;".itos(OPTIONS_ccols),OPTIONS_ccols)
{emas3integer("Maxwindow size;1:;".itos(OPTIONS_maxwin),OPTIONS_maxwin)
{emas3integer("VMODE;;".itos(OPTIONS_vmode),OPTIONS_vmode)
{! **** The following 2 parameters are specific to EMAS
{emas3integer("Overwrite;word,no,yes;no",ignore exist)
{emas3integer("Save options;word,no,yes;no",save options)
{set saved profile(OPTIONS) %if save options # 0
!$FINISH
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.
!
record (opt fm) O; !Local copy of editor options
constinteger STOPPER=-10000; !loop stop
!$IF VAX or AMDAHL
constinteger MINGAP=4096; !room for manoeuvre
!$IF APM
{%constinteger MINGAP=1024
!$FINISH
!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,HOLD1,HOLDSYM,QSYM; !work variables
integer AMOUNT; !amount of text to be moved (multi-use)
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
!$IF AMDAHL
{%string(255) backmess
{%integer trapno
{%integer flag,class,subclass,i
!$FINISH
integer GDIFF
integer FOUNDPOS,FOUNDSIZE; !matched text info
integer MARKPOS,MARKLINE; !marker positions
record (edfile) CUR
!
! Video control
integer VIDEO
integer SMODE
integer FSCROLL, CSCROLL
integer CHALF
integer VGAP
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]
ownintegerarray 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}bsdef , {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} ' '
!$IF VAX OR APM
integer array (1) name DEF
!$IF AMDAHL
{%integer %array %name DEF
{%integer %array %format deff(0:255)
!$FINISH
!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
!$IF VAX OR APM
constinteger MACBOUND=8191
own byte integer array MAC(0:macbound)
!$IF AMDAHL
{%byte %integer %array %format macf(0:macbound)
{%byte %integer %array %name mac
!$FINISH
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)
!
on event 9,10,13,14 start ; !End-of-input, Too big
! traps events signalled in program - print out a message if event is 9 or 10
!$IF AMDAHL
{ event_event = event inf>>8; event_sub = event inf&255
!$IF VAX
if event_extra # 0 start
mess = sysmess(event_extra)
unless event_message -> (mess) then c
event_message = event_message . mess; ! Lattice compiler doesn't include message
finish
!$IF VAX OR AMDAHL
if event_event = 13 start ; ! End of file from batch or file
-> pc('C')
finish
if event_event = 9 or event_event = 10 start
cat(1,0); print string(event_message); new line
finish
!$FINISH
curprom = ""
-> ignore
finish
-> edistart
!!!!!!!!! Simple (command) stream opening and closing !!!!!!!!!!!
!
const integer maxstream = 15
routine OPEN IN(string (maxname) file)
on event 3,4,9 start
!$IF APM
{ select input(0)
!$IF VAX
mess = sysmess(event_extra)
unless event_message -> (mess) then c
event_message = event_message . mess; ! Lattice compiler doesn't include message
!$IF VAX OR AMDAHL
printstring(event_message); newline
commandstream = commandstream - 1; select input(commandstream)
return
finish
commandstream = commandstream + 1
event_message = "Command files nested too deeply" and signal 9,2 if commandstream > maxstream
open input(commandstream,file); select input(commandstream)
!$FINISH
end
routine OPEN OUT(string (maxname) file)
on event 3,4,9 start
!$IF APM
{ select output(0)
!$IF VAX
mess = sysmess(event_extra)
unless event_message -> (mess) then c
event_message = event_message . mess; ! Lattice compiler doesn't include message
!$IF VAX OR AMDAHL
printstring(event_message); newline
signal 14
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
!$IF VAX or AMDAHL
vt at(row,col)
!$IF APM
{ gotoxy(col,row)
!$FINISH
end
routine CAT(integer row,col); !command window
if win_top # o_ctop start
swop window
finish
!$IF VAX or AMDAHL
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]
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)
!$IF VAX or AMDAHL
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 # o_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 PANIC; ! Emergency stop routine
!$IF AMDAHL
{ %const %string(255) panic save name = ":VECCE#SAVE",
{ diagnostic file = ":VECCE#DIAG"
!$IF VAX
const string (255) panic save name = "VECCE_PANIC.SAVE",
diagnostic file = "VECCE_PANIC.DIAG"
!$FINISH
external routine spec DISCONNECT EDFILE(record (edfile)name out)
routine print frame(string (255) text)
integer i
if text = "*" start
print symbol('*') for i = 1,1,o_wcols-1
else
text = "* ".text
text = text." " while length(text) < o_wcols-2
length(text) = o_wcols - 2
text = text."*"
print string(text)
finish
new line
end
if keeplog > 0 start
select output(logstream); close output
select output(0); logstream = logstream - 1 if logstream > 0
finish
pop window; win = vdu
clear frame;
set video mode(0)
select output(0)
print frame("*")
print frame("")
print frame("PANIC - Internal error in VECCE")
print frame("")
print frame("Writing diagnostics to file ".diagnostic file)
! select output(1); close output; select output(0)
open output(1,diagnostic file); select output(1)
monitor
close output; select output(0)
print frame("Diagnostics written")
print frame("")
main = cur if sin <= 0
main_name = panic save name
print frame("Attempting to save your edit in file ".main_name)
if main_lim1 >= main_start1 and main_lim2 >= main_start2 c
and (gdiff # 0 or (main_lim >= main_lim2 and main_start2 > main_lim1)) start ; !consistency check
disconnect edfile(main)
print frame("Saved")
else
print frame("!!! WARNING - file pointers inconsistent !!!")
if main_lim1 >= main_start1 start ; ! main_start2 is the culprit
if main_lim2 >= oldstart2 start ; ! OLDSTART2 is a good guess
main_start2 = oldstart2
print frame("!!! WARNING - unable to save whole edit buffer ")
print frame(" - text may be wrong around site of last alteration !!!")
else
main_start2 = main_lim2
print frame("!!! WARNING - unable to save whole edit buffer ")
print frame(" - text after site of last change will be MISSING !!!")
finish
else ; ! main_lim1 is wrong
if oldlim1 >= main_start1 start ; ! OLDLIM1 is a good guess
main_lim1 = oldlim1
print frame("!!! WARNING - unable to save whole edit buffer ")
print frame(" - text may be wrong around site of last alteration !!!")
else
main_lim1 = main_start1
print frame("!!! WARNING - unable to save whole edit buffer ")
print frame(" - text before site of last change will be MISSING !!!")
finish
finish
disconnect edfile(main)
finish
print frame("")
print frame("Please report this bug by electronic mail to REFSON@UK.AC.OX.VAX")
print frame("You should include the following files")
print frame("1) The original file you were editing")
print frame("2) Any secondary files you used")
print frame("3) The diagnostics file ".diagnostic file)
if keeplog = 0 start
print frame("4) Some idea of what you were doing at the time of the crash")
finishelseif keeplog < 0 start
print frame("4) The edit log. You can extract this from your journal using VRECAP")
else
print frame("4) The edit log. This is in file ".o_logfile)
finish
print frame("")
print frame("Thank you for your co-operation in reporting this bug")
print frame("*")
!$IF AMDAHL
{ %if trapno >= 0 %then i = discard trap(trapno)
!$FINISH
stop
end
routine SET LEND
lend = fp
return if fp = cur_lim2
if cur_start2 <= lend < cur_lim2 start
lend = search(lend,cur_lim2-1,nl); ! Machine code routine to return addr of next nl
finishelseif cur_start1 <= lend < cur_lim1 start
lend = search(lend,cur_lim1-1,nl)
else
panic
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
! Faster version using Machine code routine to search back for NL
if cur_start1 <= p <= cur_lim1 start ; ! Pointer in upper half
lbeg = 1+search back(cur_start1,p-1,nl); ! Search upper half
lbeg = cur_start1 if lbeg = 1
finish else if cur_start2 <= p <= cur_lim2 start
lbeg = 1+search back(cur_start2,p-1,nl); ! Find preceding NL
if lbeg = 1 start ; ! NL not found in lower half
lbeg = 1+search back(cur_start1,cur_lim1-1,nl); ! Look in upper half
lbeg = cur_start1 if lbeg = 1; ! Beginning of file - no previous NL
lbeg = lbeg+(cur_start2-cur_lim1); ! Make sure p-lbeg is line length.
finish
else
panic
finish
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
unless cur_start1 <= lbeg < cur_lim1 or c
cur_start2 <= lbeg <= cur_lim2 start
result = col if search(lbeg-(cur_start2-cur_lim1),cur_lim1,tab) = 0 c
and search(cur_start2,lbeg+col-1,tab) = 0
lbeg = lbeg - (cur_start2 - cur_lim1)
else
result = col if search(lbeg,lbeg+col,tab) = 0
finish
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
panic unless 0 <= vp-lbeg <= 2000
result = vp - lbeg if o_exptabs = 0
unless cur_start1 <= lbeg < cur_lim1 or c
cur_start2 <= lbeg <= cur_lim2 start
! Check if any tabs in line up to VP and return if not
result = vp-lbeg if search(lbeg-(cur_start2-cur_lim1),cur_lim1,tab) = 0 c
and search(cur_start2,vp-1,tab) = 0
lbeg = lbeg - (cur_start2 - cur_lim1)
else
result = vp-lbeg if search(lbeg,vp-1,tab) = 0
finish
! VP may be > lend and in gap. Put it back into upper half
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
panic if col > 2000
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
!$IF VAX or AMDAHL
while vgap > 0 cycle
vgap = vgap-1; print symbol(' ')
repeat
!$FINISH
finish
if vp = vplim start
vplim = -1
return if joins = 0 and lbeg = altlimlbeg
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)
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)
!$IF VAX or AMDAHL
print symbol(cur_flag)
!$IF APM
{ lolight(cur_flag)
!$FINISH
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
altmin = 1 + search back(cur_start1,altmin-1,nl)
altmin = cur_start1 if altmin = 1
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
set lbeg(vp, vp); ! Make sure vp is at beginning of line
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
if cur_start2 < vp <= cur_lim2 start
vp = 1 + search back(cur_start2,vp-2,nl)
vp = 1 + search back(cur_start1,cur_lim1-1,nl) if vp = 1
finishelse vp = 1 + search back(cur_start1,vp-2,nl)
vp = cur_start1 if vp = 1
count = count + 1; pre = pre-1
repeat
vp = cur_start2 if vp = cur_lim1
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
if cur_start1 <= vp <= cur_lim1 start
vp = 1 + search(vp,cur_lim1-1,nl)
vp = 1 + search(cur_start2,cur_lim2-1,nl) if vp = 1
finishelse vp = 1 + search(vp,cur_lim2-1,nl)
vp = cur_lim2 and return if vp = 1
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-indic*standoff >= 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
!$IF VAX or AMDAHL
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 APM
{ hilight(cur_flag)
{ %else
{ print symbol('~')
!$FINISH
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 9,4
finish
!$IF VAX
routine out symbol(integer k)
print symbol(k)
end
routine out string(string (255) s)
print string(s)
end
!$IF AMDAHL
{ %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
!$FINISH
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}
! code#'I' %and code#'O' %and code#'S' %and code#'G'
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 q > p and 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
if vdu_fun&caninsert#0 start ; ! Terminal has insert capability
if o_exptabs # 0 start ; ! Use dumb mode if there is a tab
dumbinsert = 1 if search(fp,lend,tab) # 0; ! on the rest of the line
finish
finish else dumbinsert = 1
if dumbinsert = 0 then set video mode(smode ! insertmode ! passdel ! nodelecho) c
else if fp < lend then set video mode(smode ! single) c
else set video mode(smode ! nodelecho ! passdel)
insertpos = fp; insertpos = lend if fp > lend
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 AMDAHL OR VAX
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!passdel!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 dels = dels + 1
!$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
!$IF AMDAHL
{ %finish %else %if term=del+1 %then %start
{ repairch=repairch+1
{ skipsymbol %and repairch=repairch+1 %while nextsymbol=del+1
!$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 = inserting 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
!$IF VAX or AMDAHL
return if mode < 0; !not data entry
dels = 0 and initdels = 0 if fp >= lend
!$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_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
delmax = search back(0,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 > l > 1024 then k = l; ! Free space > needed : shuffle by needed
if k > 1024 > l then k = 1024; ! Shuffle by min of 1024 if possible
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)
integer l
return if cur_lim1 = cur_start1 or mode > 1; !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
markpos = 0 if cur_lim1-amount <= markpos < cur_lim1
cur_lim1 = cur_lim1 - amount
cur_lbeg = cur_lbeg + amount
if cur_lim1 < altmin start
altmin = cur_lim1
l = oldlim1 - cur_lim1
if l > 0 start
copy across if gdiff # 0
oldstart2 = oldstart2 - l
if l = 1 then byteinteger(oldstart2) = byteinteger(cur_lim1) C
else move(l,cur_lim1,oldstart2)
oldlim1 = cur_lim1
finish
finish
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-cur_start2
consolidated = consolidated+1 unless lend = cur_lim2
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 AnotnowPM
{ read file %if fp = cur_lim2
!$FINISH
set lend
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, lines, amount
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
amount = lim-pos
make room(amount) if oldstart2-gdiff-cur_lim1 < amount
move(amount,addr(mac(pos)),cur_lim1)
lines = count(cur_lim1,cur_lim1+amount-1,nl)
markline = markline + lines if markline > cur_line
cur_line = cur_line+lines; gapline = gapline + lines
joins = joins - lines
cur_lim1 = cur_lim1+amount
set lbeg(cur_lbeg,fp)
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
fp = lend if fp < lend; ! Better correction Jan 88
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
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,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
-> no if line after = 0
fp = fp+o_margin if lend # cur_lim2
-> ok
s('M'): !Move
-> no if line after = 0
if num = 0 start
fp = lend if fp > lend
if cur_start1 <= fp < cur_lim1 start
cur_line = cur_line + count(fp,cur_lim1-1,nl)
fp = cur_start2
finish
cur_line = cur_line + count(fp,cur_lim2-1,nl)
jump to(cur_lim2)
-> no
finish
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
hold = tabcol(fp,cur_lbeg,0)
hold1 = line before
hold = coltab(hold,cur_lbeg) + cur_lbeg
if hold < cur_start2 <= fp then consolidate(fp-hold,sin) c
else fp = hold
-> no if hold1 = 0
-> oklast
s('<'): !Cursor Left
-> no if fp = cur_lbeg
last = code
if fp = cur_start2 then consolidate(1,sin) else fp = fp-1
-> ok
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
if num <= 0 or num > lend-fp then hold = lend-fp else hold = num
fp = fp+hold
num = num-hold+1
-> ok if num > 0
-> no
!
s('c'): !Case-change with left-shift
![unsatisfactory]
fp = lend if fp > lend
-> no if fp = cur_lbeg
split(mingap)
if cur_start2 = cur_lim2 and byteinteger(cur_lim1-1) # nl start
consolidate(0,0)
-> no
finish
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
if num <= 0 or num > fp-cur_lbeg then hold = fp-cur_lbeg else hold = num
if fp-hold < cur_start2 <= fp then consolidate(hold,sin) else fp = fp-hold
num = num-hold+1
-> ok if num > 0
-> no
!
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)
if num <= 0 or num > lend-fp then amount = lend-fp else amount = num
cur_lbeg = cur_lbeg+amount
markpos = 0 if fp <= markpos < fp+amount; ! Destroyed marker
fp = fp+amount; cur_start2 = fp
altlim = cur_start2 if altlim < cur_start2
num = num - amount + 1
-> ok if num > 0
-> no
!
s('e'): !Erase back
fp = lend if fp > lend
-> no if fp = cur_lbeg
split(0)
if num <= 0 or num > fp-cur_lbeg then amount = fp-cur_lbeg else amount = num
consolidate(amount,-1)
num = num - amount + 1
-> ok if num > 0
-> no
!
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 APM
{ complain("Dictionary not available")
!$IF VAX or AMDAHL
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:
!$IF VAX
-> no if qsym >= 'a'
qsym = qsym+casebit
-> qagain
!$IF AMDAHL
{ ! 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
!$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)
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
delmax = search back(0,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
amount = delmax-search back(0,delmax-1,nl)
delmax = delmax - amount; fp = fp - amount
move(amount,delmax+1,fp)
cur_start2 = fp; oldstart2 = cur_start2
joins = joins-1; 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
if cur_lbeg < cur_start2 <= fp c
then fp = cur_lbeg - (cur_start2-cur_lim1) and cur_lbeg = fp c
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
if cur_lbeg < cur_start2 <= fp c
then fp = cur_lbeg - (cur_start2-cur_lim1) and cur_lbeg = fp c
else fp = cur_lbeg
split(0)
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
fp = lend if fp > lend
result = false if fp=cur_lim2
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
!$IF AnotnowPM
{ read file %if fp1 = cur_lim2
!$FINISH
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 > 1
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
! More efficient macro definition using MOVE
if cur_start1 <= fp1 < cur_lim1 and c
cur_lim1 < fp1+hold start ; ! Macro text split over gap.
hold1 = cur_lim1 - fp1; ! Size of part in first half
move(hold1,fp1,addr(mac(mpos))); ! Move it to macro area
hold = hold - hold1; ! Calculate remaining length
fp1 = cur_start2
finishelse hold1 = 0
move(hold,fp1,hold1+addr(mac(mpos))) if hold > 0; ! Move the rest
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)
make room(hold-fp1) if oldstart2+gdiff-cur_lim1 < hold-fp1; ! make sure gap is big enough
! %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
move(hold-fp1,fp1,cur_lim1); ! Move text to primary buffer
cur_lim1 = cur_lim1+hold-fp1; ! Update text pointer
hold1 = markline-sec_line; ! Number of newlines in moved text
hold1 = -hold1 if hold1 < 0
joins = joins-hold1; ! Use for display in UPDATE
cur_line = cur_line+hold1; ! Add to current line number.
gapline = cur_line
set lbeg(cur_lbeg,fp)
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
inpos = search(addr(mac(inpos)),addr(mac(inlim)),nl)
inpos = inlim if inpos = 0
m = inpos-pos
macpos = macspace(n+m)
move(n,mac0+cdef&posmask,mac0+macpos) if n > 0; macpos = macpos+n
move(m,mac0+pos,mac0+macpos) if m > 0; 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
length(curprom) = 2 if length(curprom) > 2
printstring(curprom)
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
FOUNDPOS = 0; FOUNDSIZE = 0; MARKPOS = 0
CMAX1 = 0; CONSOLIDATED = 0
ERROR = 0; COMMANDSTREAM = 0; PEND = 0
VGAP = 0; JOINS = 0; LEND = 0
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
lastcell_code = ')'; lastcell_count = 1; lastcell_ref = 0
!Stored text pointers
newdef = null; cdef = null; idef = null; mdef = null
code = null
!$IF VAX OR APM
mac0 = addr(mac(0));
def == initdef
!$IF AMDAHL
{ ! Use file storage for macros on Amdahl only
{ ! Map after file - there will be enough space
{ mac0 = main_lim + 1024
{ mac == array(mac0,macf)
{ def == array(main_lim,deff)
{ move(1024,addr(initdef(0)),main_lim) %if def(0) = 0
!$FINISH
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
!Set line number into CUR_LINE
if cur_line = 0 start
if cur_start2 <= fp <= cur_lim2 start
cur_line = cur_line + count(cur_start1,cur_lim1-1,nl)
fp1 = cur_start2
finish else fp1 = cur_start1
cur_line = cur_line + 1 + count(fp1,fp-1,nl)
finish
newlim = cur_lim2
gdiff = 0
unless cur_lim1 <= cur_lim2 <= cur_lim start
newlim = cur_lim-1024
gdiff = newlim-cur_lim2
finish
! Check for newlines missing
if cur_start2 # cur_lim2 and byteinteger(cur_lim2-1) # nl start
! no newline at end of file
copy across if gdiff # 0
message = "No Newline!!!"
if cur_lim2 < cur_lim start
! there is room to add the newline
byteinteger(cur_lim2) = nl
cur_lim2 = cur_lim2+1
finishelsestart
! Cant add it so we just ignore the last line
! cur_lim2 = cur_lim2-1 %while cur_lim2 > cur_start2 %and %c
! byteinteger(cur_lim2-1) # nl
cur_lim2 = 1 + search back(cur_start2,cur_lim2-1,nl)
cur_lim2 = cur_start2 if cur_lim2 = 1
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
sec_lim2 = 1 + search back(sec_start2,sec_lim2-1,nl)
sec_lim2 = sec_start2 if sec_lim2 = 1
finish
delmax = newlim; byteinteger(delmax) = nl if delmax > 0
lastdelmax = delmax
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
!$IF AMDAHL
{ trap(trapno, 1, flag)
{ %if flag # 0 %start
{ ! This code is (somehow) branched to by the Subsystem when a
{ ! trapped event (in this case an interrupt) occurs.
{ ! Now write to :VECCE#SAVEn file.
{ ! save current edit as if a %b had been done
{ %if keeplog > 0 %start
{ select output(logstream); close output
{ select output(0); logstream = logstream - 1 %if logstream > 0
{ %finish
{ fp = cur_start2; cur_lbeg = fp; set lend
{ consolidate(0,0); !ensure no split line
{ main = cur
{ pop window; win = vdu
{ cur_flag = 0
{ reset context(trapno,0)
{ give event(class, subclass)
{ i = discard trap(trapno)
{ %if main_change=16_7FFFFFFF %start; ! File Unchanged
{ tempid = tempid - 1
{ %finishelseif main_change # -1 %start
{ main_name = ":VECCE#SAVE".itos(tempid)
{ disconnect edfile(main)
{ backmess = "Edit of ".cur_name." saved in file ".main_name
{ %if class = 69 %or ( class = 65 %and 'V' <= subclass <= 'Y' ) %start
{ set message control(1)
{ i = dmessage(uinfs(1),length(backmess), 1, 0, -1, 1+addr(backmess))
{ %finish
{ backmess = tostring(nl).backmess.tostring(nl).tostring(nl)
{ tojournal(1+addr(backmess),length(backmess))
{ %if class # 65 %or subclass # 'Y' %start
{ remove pointer
{ update
{ switch %if sin&(\1) # 0
{ vt at(vdu_rows-1,0)
{ printstring(backmess)
{ set video mode(0)
{ %finish
{ %finish
{ allow interrupts
{ signal(class, subclass); ! Propagate int back to Subsys - does not return.
{ %finish
{ i = set trap(trapno, 65, 'C') ; ! Escape
{ i = set trap(trapno, 65, 'A') ; ! Escape
{! i = set trap(trapno, 65, 'Q') ; ! %monitor
{ i = set trap(trapno, 65, 'V') ; ! Terminal Booking
{ i = set trap(trapno, 65, 'W') ; ! Inactivity
{ i = set trap(trapno, 65, 'X') ; ! Operator log-off
{ i = set trap(trapno, 65, 'Y') ; ! Terminal Disconnected
{ i = set trap(trapno, 69, 1) ; ! Stop, Quit
{ i = set trap(trapno, 69, 2) ; ! Logoff
{ i = set trap(trapno, 17, -1) ; ! CPU time exceeded
!$FINISH
!Initialise video info
![XOR so that o_VMODE can, awkwardly, suppress]
smode = o_vmode!!screenmode!!specialpad
!$IF VAX or AMDAHL
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 AMDAHL
{ %if o_logfile # ".JOURNAL" %start
!$FINISH
logstream = logstream + 1
open output(logstream,o_logfile)
select output(logstream); select output(0)
keeplog = 1
!$IF AMDAHL
{ %else
{ keeplog = -1
{ %finish
!$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
!$IF APM
{ o_dmode = o_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 code = '_' start
cat(1,0)
vt prompt(" Do you want a diagnostic dump? (y/n) "); clear line
read command line
vt prompt("")
get sym; -> ignore if sym!casebit # 'y'
panic
finish
!$IF VAX OR AMDAHL
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
!$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 and video # 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 AMDAHL
{ %if sec_flag # 0 %start
{ event_message = sysmess(sec_flag)
{ sec = 0
{ %signal 10
{ %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
{ sec_lim2 = 1 + search back(sec_start2,sec_lim2-1,nl)
{ sec_lim2 = sec_start2 %if sec_lim2 = 1
{ %finish
!$IF VAX
if sec_flag # 0 start
sec = 0
signal 14, 10; ! Error Message already printed by Connect Edfile
finish
!$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 = ' '
!$IF AMDAHL OR VAX
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 = ""
!$IF AMDAHL
{ define video(hold) %unless vttype = hold; ! In case recursive call changed TTYPE
!$IF AMDAHL OR VAX
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
!$IF APM
{ complain("Help not available")
!$FINISH
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
!$IF VAX OR AMDAHL
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'
fp = lend if fp > lend
cur_fp = fp
main=cur
vt at(vdu_rows-1,0)
clear line
set video mode(0)
!$IF VAX
return
!$IF AMDAHL
{ %if trapno>=0 %then i = discard trap(trapno)
{ %return
!$FINISH
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
main = cur
pop window; win = vdu
!$IF VAX or AMDAHL
vt at(vdu_rows-1,0)
!$IF APM
{ gotoxy(0,vdu_rows-1)
!$FINISH
clear line;
set video mode(0)
!$IF AMDAHL
{ %if trapno >= 0 %then i = discard trap(trapno)
!$FINISH
end ; !END OF EDI
!
!$IF VAX
endoflist
include "IMP_INCLUDE:RMSDEF.INC"
list
external routine 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_lim1-out_start1; !upper half
out_start2=out_start2-i
move(i,out_start1,out_start2); ! concatenated to lower
out_fp = out_fp + out_start2 - out_start1 if out_start1 <= out_fp < out_lim1
! In case backup needs to re-enter
out_lim1=out_start1
cycle
i = writeout(out_name,out_start1,out_start2,out_lim2,out_lim)
exit if i = 0
print string(" *".sysmess(i).": ".out_name)
newline
if i = rms cre or i = rms ext or i = rms ful start
print string(" * Insufficient disc space to write the output file *")
newlines(2)
print string(" Do you want a chance to delete some files?"); new line
vt prompt("Y(es) or N(o)? ")
read symbol(k) until k!casebit = 'y' or k!casebit = 'n'
vt prompt("")
if k!casebit = 'y' start
print string("You will need at least ")
write((out_lim2-out_start2)>>9+1,0)
print string(" free blocks to write the file."); new line
print string("LOGOUT will return control to VECCE"); newline
set video mode(0); ! to flush
call out("")
else
print string(" Abandon complete edit? "); new line
vt prompt("Y(es) or N(o)? ")
read symbol(k) until k!casebit = 'y' or k!casebit = 'n'
vt prompt("")
out_change = -1 and exit if k!casebit = 'y'
finish
else
new line
vt prompt(" Please supply alternative file-name: ")
select input(0)
out_name = ""
read symbol(k) until k # ' '
cycle
out_name = out_name.tostring(k); read symbol(k)
repeat until k < ' ' or k >= 127
newline
finish
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