!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 ! ! 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. ! ! ! ! ! ! ! ! ! ! ! !!!!!!!!!!!!!! Video Terminal Interface !!!!!!!!!!!!! ! ASCII control characters: %constinteger BS=8, TAB=9, LF=10, FF=12, RT=13, ESC=27 %constinteger DEL=127 ! Terminal mode: !$IF VAX {%constinteger SINGLE=1<<0, NOECHO=1<<2, PASSDEL=1<<3, { NOTYPEAHEAD=1<<4, NOTERMECHO=1<<5, { CONTROLTERM=1<<6, NOEVENT9=1<<7, LEAVECONTROLS=1<<8, { SPECIALPAD=1<<13, NEWTCP=1<<29, INSERTING=0 {%constinteger SCREENMODE=controlterm+notermecho+leavecontrols+passdel {%constinteger SPECIALMODE=specialpad !$IF APM @16_3F00-144 %routine PRINTCH(%integer k) %include "inc:util.imp" {for STOI, PAM, CONNECT etc} %include "inc:vtlib.imp" {Video Terminal Interface} %constinteger SPECIALMODE=single+specialpad ! !$IF EMAS {%recordformat EVENTFM(%integer event,sub,extra, %string(255) message) {%externalrecord(eventfm)%spec EVENT %alias "vtevent" {%externalroutinespec OPEN INPUT %alias "vtopin"(%integer s, { %string(255) file) {%externalroutinespec OPEN OUTPUT %alias "vtopout"(%integer s, { %string(255) file) {%externalroutinespec CLOSE INPUT %alias "vtclin" {%externalroutinespec CLOSE OUTPUT %alias "vtclout" {%externalintegerfnspec OUTSTREAM %alias "vtouts" !$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}, %byteinteger top {top row of sub_window}, win {floating top}, bot {bottom row +1 of sub_window}, min {minimum window size}, row {last row position}, col {last col position}, %string(maxname) name) ! !** Note that LBEG is such that FP-LBEG = #chars to left of FP ! even if this means that LBEG lies within the 'gap' ! !$IF VAX OR APM %constinteger CORDON=0 %constinteger BSDEF='g' !$IF VAX {%include "IMP_INCLUDE:CONNECT.INC"; !dictionary connection {%include "IMP_INCLUDE:PAM.INC"; !parameter processing {%constinteger MINWIN0=10, MAXWIN0=99 {%conststring(13) HELPFILE="ECCE:HELP.LIS" {%conststring(13) DICTFILE="ECCE:DICT.MAP" {%externalroutinespec VIEW(%string(255) S) {%externalroutinespec MOVE(%integer length,from,to) {!%externalintegerfnspec UINFI(%integer i) {!%externalintegerfnspec CHECKQUOTA(%string(127) filename) {%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 %start { %return { %finish { {! f = connect(file,s,l,0) { connect file(file,0,s,l) { base = s {%if f&1 # 0 {%end {! !$IF APM %constinteger MINWIN0=99, MAXWIN0=99 %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 !!!!!!!!!!!!!!!!!!!!!!!!! !! *** Version for OLD operating system *** %external%routine CONNECT EDFILE(%record(edfile)%name f) ! Utilises special extension to CONNECT FILE which allows additional ! space to be allocated fore and aft %constinteger EXTRA=128 %integer gap %on %event 2,3,9 %start select output(0) printstring(event_message); newline f_flag = 1 %return %finish heapput(f_start1) %if f_start1 # 0; !VM previously allocated f_start1 = 0; f_lim1 = 0 gap = f_flag>>1 f_start2 = gap; f_lim2 = gap; !extra space fore and aft f_change = 0; f_line = 0 connect file(f_name,extra,f_start2,f_lim2) f_start1 = f_start2-gap; f_lim1 = f_start1; !VM start f_lim2 = f_lim2+f_start2; !length => limit f_lim = f_lim2+gap; !VM limit f_lim2 = f_lim2-1 %while f_lim2 > f_start2 %and byteinteger(f_lim2-1) # nl f_flag = 0 %END !! *** Version for 'NEW' operating system *** !!%include "F:KERNEL.INC" !!%include "F:FSMOD.INC" !%externalintegerfnspec getvm(%integer bytes) !%externalroutinespec putvm(%integer start) !%externalintegerfnspec filesize(%string(255)s) !%externalintegerfnspec fcommz(%integer cn,%string(255)s, ! %bytename buffer,%integer max) !%external%routine CONNECT EDFILE(%record(edfile)%name f) !%integer i,fsize,vmsize ! %on %event 3,4,9 %start ! select output(0) ! printstring(event_message); newline ! f_flag = 1 ! %return ! %finish ! putvm(f_start1) %if f_start1 # 0 ! vmsize = f_flag ! f_start1 = 0; f_lim1 = 0; f_start2 = 0; f_lim2 = 0 ! f_change = 0; f_line = 0 ! fsize = 0; fsize = filesize(f_name) %unless f_name="" ! %signal 3 %if fsize < 0 ! f_start1 = getvm(fsize+f_flag); f_lim1 = f_start1 ! f_lim = f_lim1+(fsize+f_flag) ! f_start2 = f_start1+f_flag>>1; f_lim2 = f_start2+fsize ! i = 0; i = fcommz(0,f_name,byteinteger(f_start2),fsize) %unless fsize=0 ! %signal 3,1,i-fsize,"File-size unstable" %if i # fsize ! f_lim2 = f_lim2-1 %while f_lim2 > f_start2 %and byteinteger(f_lim2-1) # nl ! f_flag = 0 !%end ! !$IF EMAS {%include "ECSC10.PAMINC" {%constinteger CORDON=2; !to alleviate effects of echoed typeahead {%constinteger BSDEF='<' {%constinteger MINWIN0=7, MAXWIN0=99 {%conststring(24) HELPFILE = "ECSLIB.GENERALY_ECCEVIEW" {%conststring(24) DICTFILE = "ECSLIB.GENERALY_ECCEDICT" {%externalroutinespec PROMPT(%string(15) S) {%externalroutinespec VIEW(%string(255) S) {! {%routine MOVE(%integer length, from, to) { *LB_LENGTH { *JAT_14, { *LDTB_X'18000000' { *LDB_%B { *LDA_FROM { *CYD_0 { *LDA_TO { *MV_%L=%DR {L99: {%END {%INCLUDE "ECSC10.ECCE_FCP" {! !$FINISH ! !!!!!!!!!!!!!!!!!!! Editor parameters and options !!!!!!!!!!!!!!!!! !** NB ORDER -- see VALUE %constinteger ENUMCASES=5, INTCASES=3 ! %ownbyte MAPCASE=1 {1/0 ignore/heed case}, MARK=0 {1/0 show FP by mark/hilight}, EARLY=0 {1/0 update early/late}, DMODE=0 {1/0 insert/replace}, EMODE=0 {1/0 command/data} %owninteger WIDTH=80 {line width}, MARGIN=0 {left margin}, MINWIN=minwin0 {minimum window size} !Settable at outset only:- !$IF EMAS OR VAX {%owninteger TTYPE=-1 !$IF APM %owninteger TTYPE=11; !terminal type (ERCC coding) !$FINISH %owninteger WTOP=0, WROWS=255; !window area top,rows %owninteger WLEFT=0, WCOLS=255; !window area left,cols %owninteger CTOP=99; !command row (1st of 2) %owninteger CLEFT=0, CCOLS=255; !command area left,cols %owninteger MAXWIN=maxwin0 !$IF VAX OR APM %owninteger VMODE=0 !$IF EMAS {%owninteger VMODE=newtcp !$FINISH %external%string(maxname) PRE="" !** end of OPTIONS ! %bytemap BVALUE(%integer i) !$IF APM or EMAS %result == byteinteger(addr(mapcase)+i) !$IF VAX { %result == byteinteger(addr(mapcase)+i<<2) !$FINISH %end %integermap VALUE(%integer i) %result == integer(addr(width)+(i-enumcases)<<2) %end %externalroutine SET PARAMETERS(%string(maxname)%name in,sec,out, %string(255) parm) %on %event 5 %start printstring(event_message); newline %stop %finish define param("FILE to be edited",in,pam major+pam nodefault) define param("SECondary input",sec,0) define param("PREdefinition file",pre,0) define param("OUTput file (if not same as input)",out,pam newgroup) define enum param("NOMATCH,MATCH cases",mapcase,0) define enum param("COMmand,DATA edit mode",emode,0) define enum param("REPlace,INSert data mode",dmode,0) define enum param("HIlight,MARK",mark,0) define enum param("LATE,EARLY scrolling",early,0) define int param("WIDTH of line",width,0) define int param("MARGIN",margin,0) define int param("MINWIN",minwin,0) define int param("TTYPE",ttype,0) define int param("WTOP",wtop,0) define int param("WROWS",wrows,0) define int param("WLEFT",wleft,0) define int param("WCOLS",wcols,0) define int param("CTOP",ctop,0) define int param("CLEFT",cleft,0) define int param("CCOLS",ccols,0) define int param("MAXWIN",maxwin,0) define int param("VMODE",vmode,0) parm = ".N".parm %if parm # "" %and charno(parm,1) = pam_groupsep # ' ' process parameters(parm) %end !!!!!!!!!!!!!!!!!!! Start of Editor proper !!!!!!!!!!!!!!!!!!! ! %externalroutine EDI(%record(edfile)%name main,sec, %string(255) message) ! In the Vax version the original file is copied into the ! working space prior to entry; in the EMAS version ! it is accessed (initially) in its original mapped site. ! %constinteger STOPPER=-10000; !loop stop !$IF EMAS OR VAX {%constinteger MINGAP=4096; !room for manoeuvre !$IF APM %constinteger MINGAP=1024 !$FINISH !Own variables (plus MACROS):- %owninteger TOGGLE=0 %owninteger CASEMASK=\casebit; !\casebit/\0 to ignore/heed case %owninteger DICT=0 %owninteger TERM=ret; !last symbol read %owninteger SYM=ret; !last symbol got ! %integer CODE; !command code %owninteger LAST='}' %integer REF; !text or bracket pointer %integer SCOPE; !search limit %owninteger NUM=0; !repetition number %integer CONTROL,PEND; !characters %integer HOLD,HOLDSYM,QSYM; !work variables %integer ERROR %integer COMMANDSTREAM; !0[1] for terminal[file] %integer SIN; !-1: destroying ! 0: main file (editing) ! 1: " (showing) ! 2: sec file (from 0) ! 3: " (from 1) ! %integer FP; !current file position %integer FP1; !temporary FP %integer LEND; !line end position %integer OLDLIM1,OLDSTART2 %integer GAPLINE %integer NEWLIM; !effective limit of new file !also = start of deletion store %integer DELMAX,LASTDELMAX; !current end of deletions %integer CONSOLIDATED !$IF EMAS {%integer GDIFF !$IF VAX or APM %constinteger GDIFF=0 !$FINISH %integer FOUNDPOS,FOUNDSIZE; !matched text info %own%integer MARKPOS=0,MARKLINE=0; !marker positions %record(edfile) CUR ! ! Video control %integer VIDEO %integer SMODE %integer FSCROLL, CSCROLL %integer CHALF %integer VGAP %owninteger PAN=0 %constinteger UNKNOWN=-99999; !impossible value for _DIFF %constinteger OFFSCREEN=255; !impossible value for _WIN %integer JOINS; !count of lines added/removed %integer ENDON; !**END** displayed indic !The following assumes that (relevant) addresses are positive %constinteger FLOOR=0; !** LESS THAN ANY VALID ADDRESS ** %constinteger CEILING=16_7FFFFFFF %integer ALTMIN,ALTLIM; !pos of earliest/latest alteration %integer ALTLINE; !for ALTMIN %integer ALTLIMLBEG; !for ALTLIM %integer VP; !file pointer for displaying %integer VPLIM %owninteger PRINTLINE=0,PRINTED=0; !for hard-copy ! %ownstring(15) NEWPROM="??", CURPROM="" ! %integer DICTPOS %integer MAC0,MACM4,MACBASE %constinteger MSTBOUND=7 %integerarray MSTACK(0:mstbound) %integer MSP; !macro stack pointer ! !Cell format for storage of commands !$IF EMAS {%recordformat COMMANDCELL(%byteinteger code,ref, { %halfinteger scope, %integer count) !$IF VAX OR APM %recordformat COMMANDCELL(%byteinteger code,ref, %shortinteger scope, %integer count) !$FINISH %constinteger CBOUND=60 %record(commandcell) %array R(1:cbound) %owninteger CI=0,CMAX=0,CMAX1=0; !indexing R ! %switch C(4:15), PC('A':95), S(' ':127) %integer TYPE,CHAIN %ownrecord(commandcell) LASTCELL=0 ! !!!!!!!!!!!!! Key definition map and macros !!!!!!!!!!!!!!!!! ! The Video Terminal Interface converts multi-character ! control sequences to character values in the range 128:255. ! For 2-char sequences, the value is 2nd char + 128. ! For 3-char sequences, the value is 3rd char!!96 + 128 ! The array DEF records the significance of each symbol, ! as either a basic symbol (<32768) or macro definition. ! Initial entries are a melange of values relevant to specific ! known terminals. %constinteger POSMASK=16_3FFF, LIMSHIFT=16 %constinteger NULL=' ', NULLREF=' ', TREFBASE='"'+1, MACRO=1<'{FF}, '1'{RT}, 'E', 'I', '>', ' ', ' ', ' ', ' ', ' ', '}', ' ', '>'{CAN}, 'E'+'0'<<8, ' ', ' '{ESC}, ' ', ' ', '}', ' ', ' ', '!', '"', '#', '$', '%', '&', '''', '(', ')', '*', '+', ',', '-', '.', '/', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', ':', ';', '<', '=', '>', '?', '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', ' ', 526<'{C}, '<'{D}, 'G'{E}, ' ', ' '{G}, 'H'{H}, ' ', '$'{J}, 'e'+'0'<<8{K}, 'g'{L}, 'k'{M}, ' ', ' '{O}, ' ', 'I'{Q}, 'K'{R}, ' ', 'E'+'0'<<8{T}, ' ', ' ', 'E'{W}, ' ', ' ', ' ', ' '{[}, ' ', '|'{]}, ' '{^}, ' '('f'-'^'-1), 'S'+'"'<<8{f}, ' ', ' ', 'i'+'0'<<8{i}, ' ', '}'{k}, '{'{l}, ' '('p'-'l'-1), 'F'+'"'<<8, ' '('z'-'p'-1), 'n'{z}, ' '(127-'z') !Indexing MAC: %constinteger MACBOUND=8191 ! The initial part of the array MAC is reserved for ! a pool of 4 128-byte buffers used to hold ! new input, command text, match text, insert text %byteintegerarray MAC(0:macbound) %owninteger INPOS=0,INLIM=0 %owninteger NEWDEF=null,CDEF=null,IDEF=null,MDEF=null %owninteger DELS=0,INITDELS=0 %owninteger MPOS=0,MLIM=0 %owninteger TREFLIM=trefbase,TREFLIM1=trefbase ! %on %event 9,10,14 %start; !End-of-input, Too big curprom = "" -> ignore %finish -> edistart !!!!!!!!! Simple (command) stream opening and closing !!!!!!!!!!! ! %routine OPEN IN(%string(maxname) file) %on %event 9 %start !$IF APM select input(0) !$FINISH printstring(event_message); newline %return %finish open input(1,file); select input(1) commandstream = 1 %end %routine OPEN OUT(%string(maxname) file) %on %event 9 %start !$IF APM select output(0) !$FINISH printstring(event_message); newline %signal 10 %finish open output(1,file); select output(1) %end %routine CLOSE IN close input; select input(0); commandstream = 0 %end %routine CLOSE OUT close output; select output(0) %end ! !!!!!!!!!!!!!! General-purpose output routines !!!!!!!!!!!!!!!!!!! ! %routine PRINT CODE(%integer k) ! Print command letter (mapping 'minus' values) print symbol(k-casebit) %and k='-' %if 'a' <= k <= 'w' print symbol(k) %end ! %routine AT(%integer row,col); !file window %if win_top # wtop %start swop frame %finish !$IF EMAS OR VAX { vt at(row,col) !$IF APM gotoxy(col,row) !$FINISH %end %routine CAT(%integer row,col); !command window %if win_top # ctop %start swop frame %finish !$IF EMAS OR VAX { vt at(row,col) !$IF APM gotoxy(col,row) !$FINISH %end ! %routine COMPLAIN(%string(255) text) cat(1,chalf); print string(text); newline error = 1 %signal 14 %end ! %routine GASP complain("* Insertions too big") %end %integerfn DEF1(%integer k) k = def(k) %result = k %if k < macro %result = mac(k&posmask)-128 %end !!!!!!!!!!!!!!!!!!!! Macro management !!!!!!!!!!!!!!!!!!!!!!!!!! ! %routine MACPUSH(%integer newdef) %if newdef >= macro %start complain("* Too many macro levels") %if msp > mstbound mstack(msp) = inlim<>limshift %finish %end ! %routine RELEASE(%integer k) %integer i i = def(k) %if i >= premacro %start i = i&posmask+macm4 %if integer(i) >= 0 %then %monitor %else integer(i) = -integer(i) %finish def(k) = ' ' %end ! %integerfn MACSPACE(%integer needed) %integer p,q needed = (needed+7)&(\3); !add 4 & align p = macbase %cycle q = integer(p) complain("* Macros too long *") %if q = 0 %if q < 0 %start; !chunk in use p = p-q; !skip over %else q = q+integer(p+q) %while integer(p+q) > 0; !consolidate %exit %if q >= needed integer(p) = q p = p+q %finish %repeat integer(p) = q-needed p = p+q-needed integer(p) = -needed %result = p-macm4 %end ! E d i t o r - s p e c i f i c v i d e o r o u t i n e s ! %routine SET WINDOWS ! Make window parameters consistent and set up sub-windows ! -- called at outset only %integer vrows vrows = vdu_rows-cordon; !effective screen size [temp for Emas] wrows = vrows-2 %if wrows > vrows-2; !must have 2 lines for commands ctop = vrows-2 %if ctop > vrows-2 wtop = vrows-1 %if wtop >= vrows wrows = vrows-wtop %if wrows > vrows-wtop wtop = 0 %if wtop = 1 %and wtop+wrows > vrows-2 wcols = vdu_cols %if wcols > vdu_cols %if wtop-2 < ctop < wtop+wrows %start ctop = wtop+wrows; !try after file window ctop = wtop-2 %if ctop+2 > vrows; !before file window %finish ccols = 40 %if ccols < 40 ccols = vdu_cols %if ccols > vdu_cols chalf = ccols>>1 video = vdu_fun fscroll = 0; cscroll = 0 %if vdu_fun&anyscroll # 0 %start; !video can scroll %if wcols = vdu_cols %start; !full-length rows fscroll = 1 video = video-256 %and wrows = wrows+1 %if ctop = wtop+wrows %finish cscroll = 1 %if ccols = vdu_cols %finish set frame(wtop,wrows,wleft,wcols) wrows = wrows-1 %if video < 0; !restore win_mode = noscroll push frame; !save set frame(ctop,2,cleft,ccols) win_mode = noscroll mark = 1 %if vdu_fun&intense = 0; !cannot highlight %if maxwin >= wrows %then maxwin = wrows %c %else sec_min = wrows-maxwin-1 %and cur_top = sec_min+1 %end ! %routine COERCE PARAMETERS !Make (dynamically alterable) parameters consistent cur_min = wrows %if cur_min > wrows cur_min = 1 %if cur_min = 0; !** allow as disable? ** mark = 0 %if video = 0 width = 80 %unless 5 <= width <= 256 margin = 0 %unless margin < width casemask = \0; casemask = \casebit %if mapcase # 0 %end ! %routine HEADER(%integer r) %if video # 0 %start at(r,0) !$IF VAX OR EMAS { print string("<<"); newline !$IF APM set shade(intense+graphical) print symbol('`') %for r = 1,1,80 set shade(0) !$FINISH %finish %end ! %routine SAVE COMMAND !scroll down to preserve command swop frame %if win_top # ctop scroll(0,1,-1); curprom = "" %end ! !!!!!!!!!!!!!!!!!!!!!! Misc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !$IF AnotnowPM {%routine READ FILE {!Read in more of the file (at least one line) {%integer p {%on %event 9 %start { select input(0) { %return {%finish { p = cur_lim2 { %if p = sec_lim2 %start { %return %if p >= sec_lim-80 { select input(3) { %else { %return %if p >= newlim-80 { select input(2) { %finish { %cycle { read ch(byteinteger(p)) { p = p+1 { %repeat %until byteinteger(p-1) = nl { %if cur_lim2 = sec_lim2 %then sec_lim2 = p %else main_lim2 = p { cur_lim2 = p { select input(0) {%end !$FINISH %routine SET LEND lend = fp !$IF AnotnowPM { %if fp = cur_lim2 %start { read file !$FINISH %return %if fp = cur_lim2 !$IF AnotnowPM { %finish !$FINISH !$IF APM *MOVE LEND,A0; *MOVEQ #10,D0 *CMP.B (A0)+,D0; *BNE #-4; *SUBQ #1,A0 *MOVE A0,LEND !$IF VAX OR EMAS { %if lend # cur_lim2 %start { lend = lend+1 %while byteinteger(lend) # nl { %finish !$FINISH %end ! %routine SET LBEG !Establish line start position cur_lbeg = fp %cycle %if cur_lbeg = cur_start2 %start cur_lbeg = cur_lim1 %while cur_lbeg # cur_start1 %and byteinteger(cur_lbeg-1) # nl %cycle cur_lbeg = cur_lbeg-1 %repeat cur_lbeg = cur_lbeg+(cur_start2-cur_lim1) %return %finish %return %if cur_lbeg = cur_start1 %or byteinteger(cur_lbeg-1) = nl cur_lbeg = cur_lbeg-1 %repeat %end ! !!!!!!!!!!!!!! S c r e e n u p d a t i n g !!!!!!!!!!!!!!!!! ! %routine DISPLAY LINE %integer k,p p = fp; p = lend %if fp > lend %cycle vp = cur_start2 %if vp = cur_lim1 %exit %if vp = endon %if vp = p %start cur_diff = cur_line-win_row; !NB external ref !$IF EMAS or VAX { %while vgap > 0 %cycle { vgap = vgap-1; print symbol(' ') { %repeat !$FINISH %finish %if vp = vplim %start vplim = -1 %return %if joins = 0 %and vp-altlimlbeg = win_col-mark %finish !$IF AnotnowPM { read file %if vp = cur_lim2 !$FINISH %if vp = cur_lim2 %start endon = vp print string(" **END**") %exit %finish k = byteinteger(vp); vp = vp+1 %if k < ' ' %or k >= 127 %start %exit %if k = nl k = '_' %finish print symbol(k) %repeat newline %end ! %routine REMOVE POINTER %if cur_flag >= ' ' %start at(cur_row,cur_col) !$IF VAX or EMAS { print symbol(cur_flag) !$IF APM lolight(cur_flag) !$FINISH cur_flag = 0 %finish %end %routine REPAIR LINE at(cur_line-cur_diff,fp-cur_lbeg+mark) vp = fp display line %end %routine UPDATE ! If a change has been made to the file, update screen, ! but only if change has affected screen line(s). ! ALTMIN and ALTLIM delimit the area which has been affected ! by alterations %integer r,c,d %return %if altlim = floor; !no change => %if sin < 0 %start fp = lend %if fp > lend %return %if cur_start2 = fp %and altmin = ceiling %if cur_line # gapline %start joins = joins+(cur_line-gapline); cur_line = gapline %finish altlimlbeg = 0; cur_start2 = fp; altlim = fp set lbeg %finish cur_change = altmin %if altmin < cur_change %return %if video = 0 cur_diff = unknown %if joins+cur_min <= 0; !many breaks r = altline-cur_diff %if r < cur_win %start cur_diff = cur_diff-joins cur_diff = unknown %if cur_line-cur_diff >= cur_win %finish %else %if r < cur_bot %start; !within current window swop frame %if win_top # wtop remove pointer %if cur_flag > 0 altmin = cur_lim1 %if altmin > cur_lim1; !?[or only SIN<0] altlim = cur_start2 %if altlim < cur_start2; !? vp = altmin altmin = altmin-1 %while altmin # cur_start1 %and byteinteger(altmin-1) # nl c = vp-altmin d = 0; endon = -1 vplim = altlim %cycle vp = cur_start2 %if vp = cur_lim1 %if c+vgap = 0 %and fscroll # 0 %and joins # 0 %start %if joins < 0 %start; !net expansion %if cur_win > cur_top %start cur_win = cur_win-1; r = r-1 cur_diff = cur_diff+1 scroll(cur_top,r,1) %else scroll(r,cur_bot-1,-1) %finish joins = joins+1 %finish %else %if vplim < 0 %c %or (vp = vplim %and vp = altlimlbeg) %start d = cur_bot-r-joins %if d > 0 %start %cycle scroll(r,cur_bot-1,1) joins = joins-1 %repeat %until joins = 0 %cycle; !Scan forward %cycle vp = cur_start2 %if vp = cur_lim1 endon = vp %and %exit %if vp = cur_lim2 vp = vp+1 %repeat %until byteinteger(vp-1) = nl r = r+1; d = d-1 %repeat %until d = 0 %while r < cur_bot %cycle at(r,mark); display line; r = r+1 %repeat %exit %finish %finish %finish at(r,c+mark); display line; c = 0; r = r+1 %repeat %until r >= cur_bot %or (vplim < 0 %and joins=0) %finish joins = 0; altmin = ceiling altlim = floor; altlim = floor+1 %if sin < 0 %end ! %routine DISPLAY(%integer indic) ! Update screen & ensure that current line is on screen %integer r,fullpre,pre,count ! %routine SCANBACK count = 1 %while pre > 0 %cycle vp = cur_lim1 %if vp = cur_start2 %exit %if vp = cur_start1 %cycle vp = vp-1 vp = cur_lim1 %if vp = cur_start2 %repeat %until vp = cur_start1 %or byteinteger(vp-1) = nl count = count+1; pre = pre-1 %repeat %end ! %routine DISPLAY LINES(%integer n) %cycle at(r,0) print symbol(' ') %if mark # 0 display line r = r+1; n = n-1 %repeat %until n = 0 %or r >= cur_bot %end update; vplim = -1 vp = cur_lbeg vp = vp-cur_start2+cur_lim1 %if vp < cur_start2 <= fp %if video = 0 %start printline = cur_line; printed = cur_lim1+fp %cycle printstring("**END**") %and %exit %if vp = cur_lim2 %exit %if byteinteger(vp) = nl print symbol(byteinteger(vp)) vp = vp+1 vp = cur_start2 %if vp = cur_lim1 print symbol('^') %if vp = fp %and num = 1 %repeat newline %return %finish swop frame %if win_top # wtop remove pointer %if cur_flag > 0 endon = -1 fullpre = cur_min-1 fullpre = fullpre>>1 %if lend # cur_lim2 r = cur_line-cur_diff; pre = r-cur_win %if pre < 0 %start; !before start of window %if pre > -cur_min %start; !not far before %if fscroll # 0 %or r >= cur_top %start %while r < cur_top %cycle scroll(cur_top,cur_bot-1,-1); !scroll down r = r+1 %repeat %if cur_win # r %start cur_win = r header(cur_win-1) %if cur_win > cur_top %finish display lines(-pre) %return %finish !$IF VAX or EMAS or APM %finish !$IF APG { %finish %else fullpre = 0 !$FINISH %else pre = r-cur_bot %if pre < 0 %start; !within window %return %if indic = 0 %or pre # -1 %or lend = cur_lim2 vp = lend+1 %finish %if pre < cur_min %start; !not far ahead %if fscroll # 0 %start scanback %cycle cur_win = cur_win-1 %if cur_win > cur_top scroll(cur_top,cur_bot-1,1) cur_diff = cur_diff+1 at(cur_bot-1,mark) display line count = count-1 %repeat %until count = 0 %return %finish !$IF VAX or EMAS or APM %finish !$IF APG { %finish %else fullpre = cur_min-1-pre !$FINISH %finish !Complete refresh (including window init) pre = fullpre scanback r = cur_bot-cur_min; !floating window top %if r # cur_win %start; !changed %if r < cur_top %start; !sub-window changed %if sin < 2 %start; !on main sub-window cur_top = r %if cur_top < sec_bot+1 %start sec_bot = 0; sec_bot = r-1 %if r > 0 sec_win = offscreen %if sec_bot = 0 %finish %else; !on sec sub-window cur_bot = cur_min %if cur_bot+1 > main_top %start main_top = cur_bot+1 main_win = main_top %if main_win < main_top %finish r = 0 %finish cur_win = offscreen %finish %if cur_win = offscreen %start %if sin < 2 %start header(cur_top-1) %if cur_top > 0 %else header(cur_bot) %if cur_bot < main_bot %finish %else cur_win = cur_top %if cur_win < cur_top cur_win = cur_win-1 %if cur_win > cur_top %while cur_win < r-1 %cycle at(cur_win,0); clear line; cur_win = cur_win+1 %repeat %finish cur_win = r header(cur_win-1) %if cur_win > cur_top %finish display lines(0) %end ! !!!!!!!!!!!!!!!!! Command input routines !!!!!!!!!!!!!!!!!!!!!!!! ! %routine SHOW POINTER cur_row = cur_line-cur_diff; cur_col = fp-cur_lbeg at(cur_row,cur_col) cur_flag = ' ' %if mark = 0 %start cur_flag = byteinteger(fp) %if fp < lend !$IF VAX or EMAS { set shade(intense) { %if cur_flag > ' ' %then print symbol(cur_flag) %c { %else print symbol('|') { set shade(0) { %else { %if vttype # bantam %then print symbol('~') %c { %else print symbol(esc) %and print symbol(127); !splodge !$IF APM hilight(cur_flag) %else print symbol('~') !$FINISH %if fp # cur_lbeg %and fp <= lend %start %if fp # cur_start2 %then cur_flag = byteinteger(fp-1) %c %else cur_flag = byteinteger(cur_lim1-1) %finish %finish cur_flag = '_' %if cur_flag < ' ' %end %routine PREPARE FOR INPUT %if video = 0 %start num = 1 %and display(0) %if printed # cur_lim1+fp %and cur_min # 0 %else display(early) show pointer %finish %end; !PREPARE FOR INPUT ! %routinespec SPLIT(%integer gap) %routinespec CONSOLIDATE(%integer amount,mode) %constinteger nomac=-2, standard=-1, replacing=0, inserting=1 %routine READ TEXT(%integer mode) !MODE = nomac,standard,replacing,inserting ![most of the business of interfacing to lower-level screen ! input facilities is concentrated here] %integer p,q,pos,lim %on %event 9 %start !$IF VAX { set video mode(smode!noevent9); !to force use of TT !$FINISH !$IF APM %if commandstream # 0 %start close in %else open input(0,":T"); select input(0) %finish !$FINISH %signal 10 %finish q = 0 %cycle; !find free buffer (there are 4) p = q; q = q+128 %repeat %until %not (p <= cdef&posmask < q %c %or p <= mdef&posmask < q %c %or p <= idef&posmask < q) q = p; initdels = 0; dels = 0 %if mode >= 0 %start; !data entry length(newprom) = 2 %if sin = 0 %and lend # cur_lim2 %start %if mode # 0 %then newprom = newprom."INSERTING" %c %else newprom = newprom."REPLACING" %finish %if newprom # curprom %start curprom = newprom cat(0,0); printstring(curprom); clear line %finish %finish again: !$IF APM %if mode = inserting %start insertpos = fp insertpos = lend %if insertpos > lend %finish !$FINISH at(cur_line-cur_diff,fp-cur_lbeg+mark) %if mode >= 0 %cycle read symbol(term) %unless ' ' <= term <= del %start %exit %if mode = nomac pos = def(term) %if pos < macro %start; !test for text macro %exit ! %exit %unless pos&128 = 0 ! %cycle ! term = pos&127; print symbol(term) ! mac(q) = term; q = q+1; q = q-1 %if q&127 = 0 ! pos = pos>>8 ! %repeat %until pos = 0 %else %exit %unless mac(pos&posmask)&128 = 0; !not text macro lim = pos>>limshift; pos = pos&posmask %while pos < lim %cycle term = mac(pos) %if term < ' ' %then printsymbol('_') %else print symbol(term) mac(q) = term; q = q+1; q = q-1 %if q&127 = 0 pos = pos+1 %repeat %finish %finish %else %if term = del %start dels = dels+1 !$IF EMAS { initdels = initdels+1 %if q = p { curprom = ""; !in case corrupt !$IF APM (DEL passed through without action) %if q > p %start q = q-1 %if mode = replacing %and fp+(q-p) < lend %start printsymbol(bs) printsymbol(byteinteger(fp+(q-p))); !restore original printsymbol(bs) %finish %else print symbol(del); !specially treated by VTI ! as BS SP BS or BS DC %else %if mode >= 0 %and fp # cur_lbeg %if fp > lend %or mode = replacing %start %if fp = cur_start2 %then consolidate(1,sin) %else fp = fp-1 %else; !inserting: erase back printsymbol(del) split(0) consolidate(1,-1) cur_change = altmin %if altmin < cur_change altlim = floor; altmin = ceiling %finish -> again %finish !$FINISH %else mac(q) = term; q = q+1; q = q-1 %if q&127 = 0 %finish %repeat !$IF APM insertpos = 0 !$FINISH newdef = q<<16+p %and %return %if q > p newdef = null !$IF EMAS OR VAX { %return %if mode < 0; !not data entry { dels = 0 %and initdels = 0 %if fp >= lend !$IF EMAS { %while initdels # 0 %and fp # cur_lbeg %cycle { %if fp = cur_start2 %then consolidate(1,sin) %else fp = fp-1 { initdels = initdels-1 { %repeat !$FINISH %end ! %routine READ COMMAND LINE read text(standard) inpos = newdef&posmask; inlim = newdef>>16 %end ! %routine GET SYM !Extract next command input symbol !Deal with macro termination %if pend # 0 %start sym = pend; pend = 0 %else %while inpos >= inlim %cycle sym = ret %and %return %if msp = 0 msp = msp-1 ! inpos = mstack(msp)&posmask; inlim = mstack(msp)>>limshift inlim = mstack(msp); inpos = inlim&posmask; inlim = inlim>>limshift %repeat sym = mac(inpos)&127; inpos = inpos+1 %finish %end ! !!!!!!!!!!!!!!!!!!! Symbol types !!!!!!!!!!!!!!!!!!!!!!!!!! ! 0-3:non-commands 4-7:alteration group 7-9:location group ! 0:numeric 1:terminator 2:illegal 3:quote ! 4: 5:ABCEJKLR@$ 6:ISOG 7:DU ! 8:F 9:TV 10:MNP<>{} 11:( , ! 12:^ 13:: 14:) 15:? \ $ = !High-order bits used to classify chars in file: %constinteger lowercase=16_10,digit=16_20,uppercase=16_30, letter=16_10,upperordigit=16_20,alphanum=16_30, opener=16_40,closer=16_80 %constbyteintegerarray SYMTYPE(0:255) = %c 16_01 (32), 16_02{ }, 16_03{!}, 16_03{"}, 16_0A{#}, 16_0F{$}, 16_02{%}, 16_03{&}, 16_03{'}, 16_4B{(}, 16_8E{)}, 16_00{*}, 16_0A{+}, 16_0B{,}, 16_02{-}, 16_03{.}, 16_03{/}, 16_20{0}, 16_20{1}, 16_20{2}, 16_20{3}, 16_20{4}, 16_20{5}, 16_20{6}, 16_20{7}, 16_20{8}, 16_20{9}, 16_0D{:}, 16_01{;}, 16_0A{<}, 16_0F{=}, 16_0A{>}, 16_0F{?}, 16_05{@}, 16_35{A}, 16_35{B}, 16_35{C}, 16_37{D}, 16_35{E}, 16_38{F}, 16_36{G}, 16_3A{H}, 16_36{I}, 16_35{J}, 16_35{K}, 16_3A{L}, 16_3A{M}, 16_3A{N}, 16_36{O}, 16_3A{P}, 16_3A{Q}, 16_3A{R}, 16_36{S}, 16_39{T}, 16_37{U}, 16_39{V}, 16_32{W}, 16_32{X}, 16_32{Y}, 16_32{Z}, 16_42{[}, 16_0F{\}, 16_82{]}, 16_0C{^}, 16_02{_}, 16_02{`}, 16_12{a}, 16_12{b}, 16_15{c}, 16_17{d}, 16_15{e}, 16_18{f}, 16_15{g}, 16_12{h}, 16_15{i}, 16_12{j}, 16_15{k}, 16_1A{l}, 16_1A{m}, 16_1A{n}, 16_15{o}, 16_12{p}, 16_12{q}, 16_1A{r}, 16_12{s}, 16_17{t}, 16_12{u}, 16_12{v}, 16_12{w}, 16_12{x}, 16_12{y}, 16_12{z}, 16_4A{{}, 16_0F{|}, 16_8A{}, 16_02{~}, 16_02{127}, 16_02 (128) ! %routine NUMBER !Test for numeric item %if symtype(sym)&15 = 0 %start type = 0; num = 0 %if sym = '*' %then get sym %else %start %cycle num = num*10+sym-'0' %if num < 100000 get sym %repeat %until %not '0' <= sym <= '9' %finish %finish %end ! %routine READ MATCH TEXT prepare for input cat(0,0); print code(code); print symbol('>') curprom = "" clear line read text(standard) mdef = newdef remove pointer %if emode # 0; !in data entry mode %end ! %routine READ NUMBER %integer pos,lim,m prepare for input cat(0,0); print code(code); print symbol('>') curprom = "" pos = inpos; lim = inlim; m = msp msp = 0 clear line; read command line remove pointer %if emode # 0; !in data entry mode pend = 0; num = 0 get sym; number inpos = pos; inlim = lim; msp = m %end ! ! F i l e m a n i p u l a t i o n r o u t i n e s ! %integerfn distance(%integer from,to) %if cur_start2 <= to <= cur_lim2 %start from = from+(cur_start2-cur_lim1) %unless cur_start2 <= from <= cur_lim2 %else to = to+(cur_start2-cur_lim1) %if cur_start2 <= from <= cur_lim2 %finish %result = to-from %end ! %routine MOVE BLOCK(%integer length,from,to) !Move block of file, dealing with overlap & relocation !The following are relocated: FP, LBEG, LEND, FOUNDPOS, MARKPOS ! NB FP <= LEND %integer reloc,limit reloc = to-from; limit = from+length %if from <= fp < limit %start fp = fp+reloc; cur_lbeg = cur_lbeg+reloc; !LBEG always relative to FP %finish lend = lend+reloc %if from <= lend < limit foundpos = foundpos+reloc %if from <= foundpos < limit markpos = markpos+reloc %if from <= markpos < limit %while reloc > 0 %and length > reloc %cycle; !down and bigger than gap length = length-reloc move(reloc,from+length,to+length) %repeat move(length,from,to) %end !$IF EMAS {%routine COPY ACROSS { move block(cur_lim2-oldstart2,oldstart2,oldstart2+gdiff) { cur_start2 = cur_start2+gdiff; oldstart2 = oldstart2+gdiff { %if fp = cur_lim2 %start; !hence not relocated { fp = newlim; cur_lbeg = fp; lend = fp { %finish { cur_lim2 = newlim; gdiff = 0 {%end !$FINISH %routine MAKE ROOM(%integer mingap) !The gap has become too small: shuffle to enlarge it %integer amount,gap !$IF EMAS { copy across %if gdiff # 0 !$FINISH amount = cur_lim-delmax-1; gap = oldstart2-cur_lim1 gasp %if amount+gap < mingap amount = amount>>1 %if amount>>1+gap >= mingap move block(delmax+1-oldstart2,oldstart2,oldstart2+amount) oldstart2 = oldstart2+amount; cur_start2 = cur_start2+amount cur_lim2 = cur_lim2+amount; newlim = newlim+amount delmax = delmax+amount; lastdelmax = lastdelmax+amount %end ! %routine STORE DELETIONS %integer l,k !Discard part line %if cur_start2-consolidated > oldstart2 %start delmax = delmax-1 %while byteinteger(delmax) # nl lastdelmax = delmax %cycle l = cur_start2-consolidated-oldstart2 %exit %if l <= 0 %if l+delmax >= cur_lim %start !$IF EMAS { copy across %if gdiff # 0 !$FINISH k = oldstart2-cur_lim1; gasp %if k <= 0 %if k > 1024 %start; !a bit much %if k > l > 1024 %then k = l %else k = 1024 %finish move block(delmax+1-oldstart2,oldstart2,oldstart2-k) cur_start2 = cur_start2-k; oldstart2 = oldstart2-k cur_lim2 = cur_lim2-k; newlim = newlim-k delmax = delmax-k; lastdelmax = lastdelmax-k l = k %if k < l %finish move(l,oldstart2,delmax+1) oldstart2 = oldstart2+l; delmax = delmax+l %repeat %finish oldstart2 = cur_start2; consolidated = 0 %end %routine SPLIT(%integer mingap) !Create gap ahead of FP %integer j %if fp # cur_start2 %start update %if altlim # floor store deletions %if oldstart2 < cur_start2 foundpos = 0 %if foundpos < fp < foundpos+foundsize %if cur_start1 <= fp < cur_lim1 %start; !fp in upper half !$IF EMAS { copy across %if gdiff # 0 !$FINISH j = cur_lim1-fp; !amount to shift down cur_lim1 = cur_lim1-j; cur_start2 = cur_start2-j move block(j,cur_lim1,cur_start2) %else; !fp in lower half (old or new) j = fp-cur_start2 move block(j,cur_start2,cur_lim1) cur_lim1 = cur_lim1+j; cur_start2 = cur_start2+j %finish oldstart2 = cur_start2; oldlim1 = cur_lim1 %finish %if cur_lim1 < altmin %start altmin = cur_lim1 altline = cur_line; gapline = altline %finish %if cur_start2 > altlim %start altlim = cur_start2; altlimlbeg = cur_lbeg %finish %if mingap # 0 %start make room(mingap) %if oldstart2+gdiff-cur_lim1 < mingap %finish %end ! %routine BREAK !Break line in two (SPLIT already called) byteinteger(cur_lim1) = nl; cur_lim1 = cur_lim1+1 joins = joins-1 markline = markline+1 %if markline >= cur_line cur_line = cur_line+1; gapline = gapline+1 cur_lbeg = fp make room(mingap) %if oldstart2+gdiff-cur_lim1 < mingap %end ! %routine CONSOLIDATE(%integer amount,mode) ! Make it possible to move or erase FP back over the gap ! (in the former case, ensure that the gap lies on a ! line boundary by copying up the remainder of a split line ! or inserting a newline at end of file) %return %if cur_lim1 = cur_start1 %or mode > 0; !sec in (??) %if mode < 0 %start; !erasing %cycle cur_lim1 = cur_lim1-1 %if cur_lim1 < altmin %start altmin = cur_lim1 %if cur_lim1 < oldlim1 %start !$IF EMAS { copy across %if gdiff # 0 !$FINISH oldlim1 = cur_lim1; oldstart2 = oldstart2-1 byteinteger(oldstart2) = byteinteger(oldlim1) %finish %finish cur_lbeg = cur_lbeg+1 amount = amount-1 %repeat %until amount <= 0 %return %finish %if byteinteger(cur_lim1-1) # nl %start; !gap in mid-line %if cur_start2 # cur_lim2 %start; !not at end of file consolidated = lend+1-cur_start2 move block(consolidated,cur_start2,cur_lim1) cur_lim1 = cur_lim1+consolidated; cur_start2 = cur_start2+consolidated gapline = gapline+1 %else split(mingap) break amount = 0 %finish %finish fp = fp-amount %end ! %routine JUMP TO(%integer newfp) %if cur_start1 <= newfp < cur_lim1 %and %not cur_start1 <= fp < cur_lim1 %start fp = cur_start2; cur_lbeg = fp; set lend consolidate(0,0) fp = newfp %else fp = newfp %return %if cur_lbeg <= fp <= lend %finish set lbeg; set lend %end ! %integerfn LINE AFTER !Test Move possible and if so perform it ! update %if altlim # floor %result = 0 %if lend = cur_lim2 lend = lend+1 lend = cur_start2 %if lend = cur_lim1 fp = lend; cur_lbeg = fp cur_line = cur_line+1 !$IF AnotnowPM { read file %if fp = cur_lim2 !$FINISH %if lend # cur_lim2 %start !$IF APM *MOVE LEND,A0; *MOVEQ #10,D0 *CMP.B (A0)+,D0; *BNE #-4; *SUBQ #1,A0 *MOVE A0,LEND !$IF VAX OR EMAS { lend = lend+1 %while byteinteger(lend) # nl !$FINISH %finish %result = 1 %end ! %integerfn LINE BEFORE !Set FP to end of previous line if there is one update %if altlim # floor fp = lend %if fp > lend %if cur_lbeg < cur_start2 <= fp %then consolidate(fp-cur_lbeg,sin) %c %else fp = cur_lbeg %result = 0 %if fp = cur_start1 %if fp = cur_start2 %start %result = 0 %if cur_lim1 = cur_start1 fp = cur_lim1 %finish cur_line = cur_line-1 %if sin < 0 %start fp = cur_start2; !restore consolidate(1,-1) altline = cur_line; gapline = altline joins = joins+1 %else fp = fp-1; lend = fp %finish set lbeg %result = 1 %end ! %routine EXTEND LINE !Append spaces when FP beyond end of line %integer hold hold = fp-lend; fp = lend split(mingap) %while hold > 0 %cycle byteinteger(cur_lim1) = ' '; cur_lim1 = cur_lim1+1 cur_lbeg = cur_lbeg-1; hold = hold-1 %repeat %end ! %routine INSERT(%integer DEF) !Insert text specified by DEF %integer pos,lim pos = def&posmask; lim = def>>limshift %return %if pos >= lim %if fp > lend %start fp = lend %if mac(pos) = nl extend line %finish %else split(mingap) %cycle %if mac(pos) = nl %then break %else %start byteinteger(cur_lim1) = mac(pos) cur_lim1 = cur_lim1+1; cur_lbeg = cur_lbeg-1 %finish pos = pos+1 %repeat %until pos = lim cur_change = altmin %if altmin < cur_change %end %routine OVERWRITE(%integer DEF) !Overwrite existing text with text specified by DEF %integer pos,lim pos = def&posmask; lim = def>>limshift %return %if pos >= lim %if fp > lend %start fp = lend %if mac(pos) = nl extend line %finish %else split(mingap) %cycle %if mac(pos) = nl %start make room(mingap) %if oldstart2+gdiff-cur_lim1 <= mingap %while fp < lend %cycle byteinteger(cur_lim1) = mac(fp) cur_lim1 = cur_lim1+1; fp = fp+1 %repeat %if fp # cur_lim2 %start fp = fp+1; cur_lbeg = fp; set lend cur_line = cur_line+1; gapline = gapline+1 altlimlbeg = cur_lbeg %if altlim < fp %finish %finish %else %if fp < lend %then fp = fp+1 %c %else cur_lbeg = cur_lbeg-1 byteinteger(cur_lim1) = mac(pos) cur_lim1 = cur_lim1+1; pos = pos+1 %repeat %until pos = lim cur_start2 = fp; altlim = cur_start2 %if altlim < cur_start2 cur_change = altmin %if altmin < cur_change %end %routine JOIN ! Erase from FP to end of line AND the line terminator ! (covers Kill, Join, Uncover) ! SPLIT already called %integer j markpos = 0 %if cur_start2 <= markpos <= lend j = lend-fp+1 cur_lbeg = cur_lbeg+j; fp = fp+j; cur_start2 = cur_start2+j joins = joins+1 %if altlim < cur_start2 %start altlim = cur_start2; altlimlbeg = altlim %finish set lend markline = markline-1 %if markline > cur_line %end ! %routine SWITCH ! Switch between main and secondary input update %if altlim # floor %if sin < 0 %start; !what are you doing here? altlim = floor; sin = 0 %return %finish cur_fp = fp; !store markpos = 0; !clear marker sin = sin!!2 %if sin >= 2 %start; !main -> sec main = cur; cur = sec %if cur_min = 0 %start cur_min = 10; cur_win = offscreen coerce parameters %finish %if cur_line = 0 %start; !indicator for reset cur_line = 1 cur_fp = sec_start2; cur_lbeg = cur_fp cur_win = offscreen; cur_diff = unknown %finish %else; !sec -> main sec = cur; cur = main %if cur_flag >= ' ' %start %if cur_win <= cur_line-cur_diff < cur_bot %start cur_row = cur_line-cur_diff at(cur_row,cur_fp-cur_lbeg); print symbol(cur_flag) %finish cur_flag = 0 %finish %finish fp = cur_fp set lend %end ! %integerfn MATCHED ! Compare text @FP with text @MPOS:MLIM (full pointers) %integer p,pos,k,l p = fp; pos = mpos %cycle k = byteinteger(pos) %result = 0 %if k = nl l = k!!byteinteger(p) %if l # 0 %start %result = 0 %if l&casemask # 0 %or symtype(k)&alphanum = 0 %finish p = p+1; pos = pos+1 %repeat %until pos = mlim foundpos = fp; foundsize = p-fp %result = 1 %end ! ! extract next command ! execute: ci = 0 ci = cmax1 %if cmax > cmax1 next: s('?'): ci = ci+1 code = r(ci)_code; ref = r(ci)_ref num = r(ci)_count -> s(code) %if sin = 0 %or symtype(code)&15 >= 8 disallowed: complain("* Moving commands only") ! ! Successful return from execution oklast: last = code ok: num = num-1 -> next %if num = 0 -> s(code) fail: num = 1 ! Failure return no: s('\'): %cycle -> next %if num <= 0; !indefinite repetition -> ci = ci+1; !check following cell:- -> next %if r(ci)_code = '\'; !invert -> -> next %if r(ci)_code = '?'; !query -> %while r(ci)_code # ')' %cycle -> next %if r(ci)_code = ','; !comma -> ci = r(ci)_ref %if r(ci)_code = '(' ci = ci+1 %repeat num = r(ci)_count %repeat %until ci >= cmax -> read %if num <= 0 ! !E x e c u t i o n e r r o r ! s(*): ![safety] !suppress report for simple moves as control key macros -> read %if control >= 0 %and def(control) < 127 %c %and symtype(def(control))&15 = 10 cat(1,chalf) printstring(" Failure: ") print code(code) %if 7 <= symtype(code)&15 <= 9 %start; !text matching group print symbol('''') hold = mpos %cycle print symbol('''') %and %exit %if hold >= mlim print symbol('_') %and %exit %if byteinteger(hold) < ' ' print symbol(byteinteger(hold)) hold = hold+1 %repeat %until hold-mpos >= chalf %finish newline error = 1 -> ignore ! !I n d i v i d u a l c o m m a n d s ! s('('): !open bracket r(ref)_count = num; !restore count on ')' -> next ! s(')'): !close bracket num = num-1 %if num # 0 %and num # stopper %start r(ci)_count = num; !update ci = ref; !position of '(' %else -> read %if ci >= cmax %finish -> next ! s(','): !comma ci = ref-1; !position of ')' - 1 -> next ! s('P'): display(0) -> ok %if num = 1 smbug: s('M'): !Move -> no %if line after = 0 fp = fp+margin %if lend # cur_lim2 -> ok ! s('}'): !Cursor down hold = fp-cur_lbeg -> no %if line after = 0 fp = fp+hold %if fp # cur_lim2 -> oklast s('{'): !Cursor up hold = fp-cur_lbeg fp = cur_lbeg+hold %and -> no %if line before = 0 hold = hold+cur_lbeg %if hold < cur_start2 <= fp %then consolidate(fp-hold,sin) %c %else fp = hold -> oklast s('<'): !Cursor Left -> no %if fp = cur_lbeg last = code -> left s('>'): !Cursor right -> no %if fp-cur_lbeg >= width %or lend = cur_lim2 fp = fp+1 ->oklast ! s('#'): !absolute line n %if num = 0 %start read number -> fail %if num = 0 %finish code = 'M' num = num-cur_line -> next %if num = 0 -> smbug %if num > 0 ! -> s('M') %if num > 0 num = -num; code = 'm' s('m'): !Move back -> no %if line before = 0 %if num = 0 %and sin >= 0 %start; !M-* %if cur_start1 # cur_lim1 %then jump to(cur_start1) %c %else jump to(cur_start2) cur_line = 1 %finish hold = cur_lbeg+margin; hold = lend %if hold > lend %if hold < cur_start2 <= fp %then consolidate(fp-hold,sin) %c %else fp = hold -> ok ! s('C'): !Case-change with right-shift -> no %if fp >= lend split(mingap) holdsym = byteinteger(fp) holdsym = holdsym!!casebit %if symtype(holdsym)&letter # 0 byteinteger(cur_lim1) = holdsym cur_lim1 = cur_lim1+1; fp = fp+1 cur_start2 = fp; altlim = cur_start2 %if altlim < cur_start2 -> ok ! s('R'): s('l'): !Right-shift -> no %if fp >= lend fp = fp+1 -> ok ! s('c'): !Case-change with left-shift ![unsatisfactory] fp = lend %if fp > lend -> no %if fp = cur_lbeg split(mingap) !$IF EMAS { copy across %if gdiff # 0 !$FINISH cur_lim1 = cur_lim1-1; oldlim1 = cur_lim1 altmin = cur_lim1 %if altmin > cur_lim1 holdsym = byteinteger(cur_lim1) holdsym = holdsym!!casebit %if symtype(holdsym)&letter # 0 fp = fp-1; cur_start2 = cur_start2-1 oldstart2 = cur_start2; consolidated = 0 byteinteger(fp) = holdsym -> ok s('L'): s('r'): !Left-shift fp = lend %if fp > lend -> no %if fp = cur_lbeg left: %if fp = cur_start2 %then consolidate(1,sin) %else fp = fp-1 -> ok ! s('H'): !Home (multi-function) %if last = '<' %start num = 0 %if fp = cur_lbeg+pan %and pan # 0 %start num = wcols>>1; pan = pan-num %finish %finish %else %if last = '>' %start num = lend-fp -> next %if num <= 0 %if fp = cur_lbeg+pan+wcols %start num = wcols>>1; pan = pan+num %finish %finish %else %if last = '{' %start update num = cur_line-cur_diff-cur_win num = cur_min-2 %if num <= 0 num = 1 %if num <= 0 %else update num = cur_bot-1-(cur_line-cur_diff) num = cur_min-2 %if num <= 0 num = 1 %if num <= 0 %finish code = last -> s(code) ! s('E'): !Erase -> no %if fp >= lend split(0) cur_lbeg = cur_lbeg+1 fp = fp+1; cur_start2 = fp altlim = cur_start2 %if altlim < cur_start2 -> ok ! s('e'): !Erase back fp = lend %if fp > lend -> no %if fp = cur_lbeg split(0) consolidate(1,-1) -> ok ! s('V'): !Verify -> no %if fp >= lend %if ref = 0 %then read match text %c %else %if ref # '"' %then mdef = def(ref) mpos = mdef&posmask+mac0; mlim = mdef>>limshift+mac0 holdsym = byteinteger(mpos); !first symbol of quoted text -> no %if mpos # mlim %and matched = 0 -> next ! s('D'): !Delete s('T'): !+ Traverse %if ref = 0 %then read match text %c %else %if ref # '"' %then mdef = def(ref) fp1 = fp -> find ! s('U'): !Uncover s('F'): !+Find %if ref = 0 %then read match text %c %else %if ref # '"' %then mdef = def(ref) fp1 = fp fp = fp+1 %if fp = foundpos find: scope = r(ci)_scope; !number of lines to search -> next %if mdef < macro; !null mpos = mdef&posmask+mac0; mlim = mdef>>limshift+mac0 holdsym = byteinteger(mpos); !first symbol of quoted text %cycle %while fp < lend %cycle %if (byteinteger(fp)!!holdsym)&casemask = 0 %start -> found %if matched # 0 %finish fp = fp+1 %repeat %exit %if fp = cur_lim2 scope = scope-1 %exit %if scope = 0 %if code # 'U' %start %exit %if line after = 0 %else fp = fp1; fp = lend %if fp > lend split(0); join %finish fp1 = fp %repeat fp = fp1 -> no found: -> ok %if code = 'F' fp = fp+foundsize %and -> ok %if code = 'T' found1: %if code # 'U' %start; !'D','d' split(0) hold = foundsize %else hold = fp-fp1; fp = fp1 split(0); foundpos = fp+hold %finish cur_lbeg = cur_lbeg+hold; fp = fp+hold; cur_start2 = cur_start2+hold altlim = cur_start2 %if altlim < cur_start2 -> ok ! s('t'): s('d'): s('f'): !Find back -> no %if sin < 0; !**for now [too difficult] fp = lend %if fp > lend scope = r(ci)_scope %if ref = 0 %then read match text %c %else %if ref # '"' %then mdef = def(ref) -> next %if mdef < macro mpos = mdef&posmask+mac0; mlim = mdef>>limshift+mac0 holdsym = byteinteger(mpos); !first symbol of quoted text update %cycle %while fp = cur_lbeg %cycle scope = scope-1 -> no %if scope = 0 %or line before = 0 %repeat %if fp = cur_start2 %then consolidate(1,sin) %c %else fp = fp-1 %repeat %until (byteinteger(fp)!!holdsym)&casemask = 0 %c %and matched # 0 -> ok %if code = 'f' fp = fp+foundsize %and -> ok %if code = 't' -> found1 ! %constinteger termbit=1<<16, lastbit=1<<15, dummy='a'-1 s('Q'): !Query spelling !$IF APM complain("Dictionary not available") !$IF EMAS OR VAX { %if dict = 0 %start { connect direct(dictfile,dict) { complain("Dictionary not available") %if dict = 0 { %finish { %if fp = foundpos %and foundsize < 0 %start; !already Queried { fp = fp+1 %until symtype(byteinteger(fp))&letter = 0 { %finish {qnext: { %cycle { %while fp >= lend %cycle { -> no %if fp = cur_lim %or line after = 0 { %repeat { qsym = byteinteger(fp) { %exit %if symtype(qsym)&letter # 0 { fp = fp+1 { %repeat { foundpos = fp; foundsize = -1 {qagain: { fp1 = fp { hold = termbit>>10 { dictpos = integer(dict+qsym<<2) { %cycle { fp1 = fp1+1; holdsym = byteinteger(fp1)-dummy { %if holdsym <= 0 %or holdsym > 26 %start; !end of word { %if hold&termbit>>10 # 0 %start; !successful match { -> ok %if num > 0; !not Q* { fp = fp1 { -> qnext { %finish { %exit { %finish { -> qno %if dictpos = 0 { dictpos = dictpos+dict { %cycle { hold = integer(dictpos) { %exit %if hold&31 = holdsym { -> qno %if hold&lastbit # 0 { dictpos = dictpos+4 { %repeat { hold = hold>>5 { %if hold&31 # 0 %start { fp1 = fp1+1 { %exit %if hold&31+dummy # byteinteger(fp1) { %finish { hold = hold>>5 { %if hold&31 # 0 %start { fp1 = fp1+1 { %exit %if hold&31+dummy # byteinteger(fp1) { %finish { dictpos = hold>>5&(\3) { %repeat { holdsym = byteinteger(fp1) { -> ok %if holdsym = '-' %or symtype(holdsym)&upperordigit # 0 {qno: { -> no %if qsym >= 'a' { qsym = qsym+casebit { -> qagain !$FINISH %integerfn found closer %integer k k = byteinteger(fp)+2; k = ')' %if k = '('+2 %cycle fp = fp+1 %result = 0 %if fp >= lend %result = 1 %if byteinteger(fp) = k %if symtype(byteinteger(fp))&opener # 0 %start %result = 0 %if found closer = 0 %finish %repeat %end s('N'): !Next word/element -> no %if lend = cur_lim2 fp = lend %if fp > lend holdsym = byteinteger(fp) hold = symtype(holdsym) %if hold&alphanum # 0 %or holdsym <= ' ' %start fp = fp+1 %while symtype(byteinteger(fp))&alphanum # 0 %cycle %while fp >= lend %cycle -> no %if line after = 0 %repeat %exit %if symtype(byteinteger(fp))&alphanum # 0 fp = fp+1 %repeat foundsize = 0 %finish %else %if hold&opener # 0 %start -> no %if found closer = 0 foundsize = 1 %else %cycle fp = fp+1 -> no %if fp >= lend %repeat %until byteinteger(fp) = holdsym foundsize = 1 %finish foundpos = fp -> ok ! %routine backup %if fp = cur_start2 %start holdsym = byteinteger(cur_lim1-1) consolidate(1,sin) %else fp = fp-1; holdsym = byteinteger(fp) %finish %end %integerfn found opener %integer k k = holdsym-2; k = '(' %if k = ')'-2 %cycle %result = 0 %if fp = cur_lbeg backup %result = 1 %if holdsym = k %if symtype(holdsym)&closer # 0 %start %result = 0 %if found opener = 0 %finish %repeat %end s('n'): !Locate previous word/element %if fp >= lend %start fp = lend; holdsym = ' ' %finish %else holdsym = byteinteger(fp) hold = symtype(holdsym) %if hold&alphanum # 0 %or holdsym = ' ' %start %cycle %while fp = cur_lbeg %cycle -> no %if line before = 0 %repeat backup %repeat %until symtype(holdsym)&alphanum # 0 %cycle %exit %if fp = cur_lbeg %if fp = cur_start2 %start %exit %if symtype(byteinteger(cur_lim1-1))&alphanum = 0 consolidate(1,sin) %else %exit %if symtype(byteinteger(fp-1))&alphanum = 0 fp = fp-1 %finish %repeat foundsize = 0 %finish %else %if hold&closer # 0 %start -> no %if found opener = 0 foundsize = 1 %else hold = holdsym %cycle -> no %if fp = cur_lbeg backup %repeat %until hold = holdsym foundsize = 1 %finish foundpos = fp -> ok ! s('S'): !Substitute -> no %if fp # foundpos %if foundsize <= 0 %start; !following 'N' etc fp1 = fp fp1 = fp1+1 %until symtype(byteinteger(fp1))&alphanum = 0 foundsize = fp1-fp %finish split(0) cur_lbeg = cur_lbeg+foundsize; fp = fp+foundsize; cur_start2 = fp altlim = cur_start2 %if altlim < cur_start2 ! s('I'): !+Insert -> no %if fp-cur_lbeg > width %and code # 'S' %if ref = 0 %start -> over %if fp >= lend split(mingap) !$IF EMAS OR VAX { vgap = wcols - (lend-cur_lbeg+mark) { vgap = 10 %if vgap < 10 { display(0) { read text(inserting) { idef = newdef { %if idef >= macro %start { insert(idef) { altlim = lend+1; altlimlbeg = altlim; !to remove spaces { %finish %else repair line; !to remove spaces !$IF APM display(0) read text(inserting) idef = newdef %if idef >= macro %start insert(idef) altlim = floor; altmin = ceiling; !up-to-date %finish !$FINISH ->controlterm %if term # ret %else idef = def(ref) %if ref # '"' -> next %if idef < macro insert(idef) %finish -> ok ! !Recovery commands s('o'): !Overwrite back -> no %if cur_lim1 <= oldlim1 %and cur_start2 <= oldstart2 %if fp # cur_start2 %start update fp = cur_start2 cur_line = gapline; set lbeg; set lend %finish split(0); !(to update?) %if cur_lim1 > oldlim1 %start cur_lim1 = cur_lim1-1 %if byteinteger(cur_lim1) = nl %start joins = joins+1 cur_line = cur_line-1; altline = cur_line %finish set lbeg; altmin = cur_lim1 %finish -> ok %if cur_start2 <= oldstart2 fp = fp-1; cur_start2 = fp cur_lbeg = cur_lbeg-1 -> ok %if byteinteger(fp) # nl joins = joins-1; lend = fp set lbeg -> ok ! s('i'): !Insert back fp = lend %if fp > lend store deletions %if oldstart2 < cur_start2 -> no %if delmax <= lastdelmax split(mingap>>1) !$IF EMAS { copy across %if gdiff # 0 !$FINISH fp = fp-1 byteinteger(fp) = byteinteger(delmax) delmax = delmax-1 cur_start2 = fp; oldstart2 = cur_start2 cur_lbeg = cur_lbeg-1 %if byteinteger(fp) = nl %start joins = joins-1; lend = fp; set lbeg %finish -> ok ! s('g'): !Get back fp = lend %if fp > lend store deletions %if oldstart2 < cur_start2 split(mingap>>1) delmax = delmax-1 %while byteinteger(delmax) # nl -> no %if delmax = newlim !$IF EMAS { copy across %if gdiff # 0 !$FINISH lend = fp-1 %cycle fp = fp-1; byteinteger(fp) = byteinteger(delmax) delmax = delmax-1 %repeat %until byteinteger(delmax) = nl cur_start2 = fp; oldstart2 = cur_start2 joins = joins-1; set lbeg -> ok ! s('O'): !Overwrite -> no %if fp-cur_lbeg > width over: %if ref = 0 %start display(0) read text(replacing) idef = newdef %if idef >= macro %start overwrite(idef) altlim = floor; altmin = ceiling; !up-to-date %finish repair line %if dels # 0 -> controlterm %if term # ret %else idef = def(ref) %if ref # '"' -> next %if idef < macro overwrite(idef) %finish -> ok ! !!!!!!!!!!!!!!!!!!!!!! Data entry mode !!!!!!!!!!!!!!!!!!!!!! data entry: %cycle display(0) !$IF APM read text(dmode) !$IF VAX OR EMAS { read text(0) !$FINISH %if newdef >= macro %start; !non-null %if def1(term) = 'H' %start; !treat as command inlim = newdef>>16; inpos = newdef&posmask control = -1 repair line -> again %finish %if sin # 0 %or lend = cur_lim2 %start repair line -> read %finish %if dmode = replacing %then overwrite(newdef) %else insert(newdef) altlim = floor; altmin = ceiling; !up-to-date %finish repair line %if dels # 0 %exit %if term # ret %or dmode = inserting hold = line after fp = fp+margin %if lend # cur_lim2 %repeat controlterm: control = term; cur_flag = 0 -> again ! !!!!!!!!!!!!!!!!!!!!!!! end of data entry !!!!!!!!!!!!!!!!!!!!! s('G'): !Get (line from terminal) %if cur_lbeg < cur_start2 <= fp %start update; consolidate(fp-cur_lbeg,0); ![update needed?] %finish %else fp = cur_lbeg %if ref = 0 %start split(mingap) %if video # 0 %start %if video < 0 %start display(0) cur_row = cur_line-cur_diff scroll(cur_row,cur_bot,-1) curprom = ""; !lost it %else; !Simulate Break & Move back !SPLIT already done break update fp = cur_lim1-1; cur_lbeg = fp cur_line = cur_line-1 display(0) cur_row = cur_line-cur_diff cur_lim1 = cur_lim1-1 fp = cur_start2; cur_lbeg = fp %finish at(cur_row,fp-cur_lbeg+mark) %finish %else printsymbol(':') read text(standard) newdef = null %and term = ':' %if newdef # null %c %and mac(newdef&posmask) = ':' %if newdef = null %and term # ret %start %if video # 0 %start %if video < 0 %start scroll(cur_row,cur_bot,1) %else split(0); !to set ALT... joins = joins+1 %finish %finish term = ret %and -> no %if term = ':' -> controlterm %finish idef = newdef insert(idef) break cur_change = altmin %if altmin < cur_change altlim = floor; altmin = ceiling; !screen up-to-date joins = 0 %if video < 0 %start; !bring back %if cur_row = cur_bot-1 %start cur_win = cur_win-1 %if cur_win > cur_top cur_diff = cur_diff+1 scroll(cur_top,cur_bot,1) %finish %else %if emode # 0 %start cat(0,0); clear line %finish %finish -> controlterm %if term # ret %else idef = def(ref) %if ref # '"' insert(idef) break %finish -> ok ! s('B'): !Break fp = lend %if fp > lend num = 66 %if num = 0 %or num > 66 split(mingap) break -> ok ! s('k'): !Kill back update %if altlim # floor %if cur_lbeg < cur_start2 <= fp %start fp = lend %if fp > lend; consolidate(fp-cur_lbeg,0) %finish %else fp = cur_lbeg split(0) -> no %if cur_lim1 = cur_start1 sin = -1; hold = line before; sin = 0 consolidate(fp-cur_lbeg,-1) %if fp # cur_lbeg -> ok s('K'): !Kill -> no %if lend = cur_lim2 fp = lend %if fp > lend split(0) consolidate(fp-cur_lbeg,-1) %and cur_lbeg = fp %if fp # cur_lbeg join -> ok ! s('J'): !Join fp = lend %if fp < lend -> no %if lend = cur_lim2 %or fp-cur_lbeg > width %if fp > lend %then extend line %else split(0) join -> ok ! ![unsatisfactory] %constinteger true=1,false=0 %integerfn ADJUSTED %integer size fp1 = cur_lbeg+margin fp = lend %and %result = true %if fp1 >= lend; !blank line -> fp = fp1 %if fp < fp1 %cycle fp1 = fp; !last boundary fp = fp+1 %while byteinteger(fp) = ' ' fp = fp+1 %while byteinteger(fp) > ' ' size = fp-cur_lbeg %if size > width %start %result = false %if byteinteger(fp1) # ' ' fp = fp1 %result = true %finish %if fp = lend %start fp1 = fp+1 fp1 = cur_start2 %if fp1 = cur_lim1 !$IF AnotnowPM { read file %if fp1 = cur_lim2 !$FINISH %result = false %if fp1 = cur_lim2 foundpos = fp1 fp1 = fp1+1 %while byteinteger(fp1) = ' ' %result = false %if byteinteger(fp1) = nl %or fp1-foundpos < margin foundpos = fp1 fp1 = fp1+1 %until byteinteger(fp1) <= ' ' foundsize = fp1-foundpos; size = size+1+foundsize %result = true %if size > width split(mingap) join byteinteger(cur_lim1) = ' '; cur_lim1 = cur_lim1+1 move(foundsize,foundpos,cur_lim1) cur_lim1 = cur_lim1+foundsize; oldlim1 = cur_lim1 fp = foundpos+foundsize cur_start2 = fp; oldstart2 = cur_start2 altlim = cur_start2 %if altlim < cur_start2 cur_lbeg = fp-size %finish %repeat %end; !ADJUSTED s('A'): !Adjust type = adjusted %if fp = lend %start; !break position is at end of line -> no %if line after = 0 %else split(0) fp = fp+1; cur_start2 = fp; !erase space oldstart2 = cur_start2; altlim = cur_start2 %if altlim < cur_start2 break hold = 0 %while hold < margin %cycle byteinteger(cur_lim1) = ' '; cur_lim1 = cur_lim1+1 hold = hold+1 %repeat oldlim1 = cur_lim1 cur_lbeg = fp-margin %finish -> ok %if type # 0 -> no ! s('@'): !'at' Column NUM -> fail %if lend = cur_lim2 hold = width-(lend-fp) num = hold %if hold < num %if fp >= lend %start fp = cur_lbeg+num %and -> next %if cur_lbeg+num >= lend fp = lend %finish hold = fp-cur_lbeg-num -> next %if hold = 0 !old? fp = fp-hold %and -> next %if fp >= lend %and fp-hold >= lend split(mingap) %cycle %if hold < 0 %start; !left of it byteinteger(cur_lim1) = ' '; cur_lim1 = cur_lim1+1 cur_lbeg = cur_lbeg-1; hold = hold+1 %else -> fail %if fp = cur_lbeg %or byteinteger(cur_lim1-1) # ' ' cur_lim1 = cur_lim1-1; cur_lbeg = cur_lbeg+1 altmin = cur_lim1 %if altmin > cur_lim1 hold = hold-1 %finish %repeat %until hold = 0 -> next ! %routine put number(%integer v) put number(v//10) %and v = v-v//10*10 %if v >= 10 byteinteger(cur_lim1) = v+'0' cur_lim1 = cur_lim1+1; cur_lbeg = cur_lbeg-1 %end s('-'): s('+'): !Increment Number %cycle -> no %if fp >= lend hold = symtype(byteinteger(fp)) %exit %if hold&alphanum # 0 fp = fp+1 %repeat split(mingap) %if hold = digit %start hold = 0; fp1 = fp %cycle hold = hold*10+byteinteger(fp)-'0'; fp = fp+1 %repeat %until symtype(byteinteger(fp)) # digit %if code = '-' %start hold = hold-num; -> fail %if hold < 0 %finish %else hold = hold+num cur_lbeg = cur_lbeg+(fp-fp1) put number(hold) %else hold = byteinteger(fp) %if code = '-' %then hold = hold-num %else hold = hold+num -> fail %unless 'A' <= hold <= 'z' %and symtype(hold)&letter # 0 byteinteger(cur_lim1) = hold cur_lim1 = cur_lim1+1; fp = fp+1 %finish cur_start2 = fp; altlim = cur_start2 %if altlim < cur_start2 -> next s('|'): !Toggle Destructive Mode -> disallowed %if sin > 0 %if sin = 0 %start fp = lend %if fp > lend -> fail %if fp-cur_lbeg > width split(0); altlim = floor+1; sin = -1 markpos = 0 %else update; altlim = floor; sin = 0 %finish -> next ! s('^'): !Set Marker / Delimit Text -> disallowed %if sin < 0 fp = lend %if fp > lend %if num = 0 %and markpos = 0 %start markpos = fp; markline = cur_line %if sin = 0 %start store deletions %if oldstart2 < cur_start2 oldlim1 = cur_lim1 %finish %else fp1 = markpos %if fp1 # 0 %start hold = distance(fp1,fp) %if hold < 0 %start hold = -hold fp1 = fp %finish markpos = 0 %else -> fail %if fp # foundpos %if foundsize <= 0 %start; !following 'N' etc fp1 = fp fp1 = fp1+1 %until symtype(byteinteger(fp1))&alphanum = 0 foundsize = fp1-fp %finish fp1 = fp; hold = foundsize %finish num = 'X' %if num < 'X' release(num) %if hold = 0 %then def(num) = null %else %start mpos = macspace(hold) def(num) = (mpos+hold)< 0 %cycle mac(mpos) = byteinteger(fp1) mpos = mpos+1; fp1 = fp1+1 fp1 = cur_start2 %if fp1 = cur_lim1 hold = hold-1 %repeat %finish %finish -> next ! s('='): -> no %if markpos = 0 jump to(markpos) cur_line = markline markpos = 0 -> ok s('$'): !switch inputs fp1 = markpos; fp = lend %if fp > lend switch %if sin = 0 %and fp1 # 0 %and fp1 # sec_fp %start hold = sec_fp hold = fp1 %and fp1 = sec_fp %if fp1 > hold %if fp > lend %start fp = lend %if byteinteger(fp1) = nl extend line %finish %else split(mingap) %cycle %if byteinteger(fp1) = nl %then break %else %start byteinteger(cur_lim1) = byteinteger(fp1) cur_lim1 = cur_lim1+1; cur_lbeg = cur_lbeg-1 %finish fp1 = fp1+1 %repeat %until fp1 = hold %finish -> next ! ! C o m m a n d i n p u t ! %routine GET NAME(%string(maxname)%name s) !First symbol in SYM s = "" %while ' ' <= sym < 127 %cycle s = s.tostring(sym) %if length(s) < maxname get sym %repeat cat(1,0); !in case of error-report %end %constinteger first=0, normal=1; !(nomac=-1) %routine GET CODE(%integer mode) ! Read command unit to CODE, classifying in TYPE ! Expand macros if MODE >= 0 / Leading element if MODE = 0 %integer k %cycle get sym %until sym # ' ' code = sym %if sym < ' ' %start; !control type = 1 %return %if mode > 0; !non-initial code = term %finish !Test for printing char version of control sequence %if code = '&' %start; !control shift get sym; -> err %if sym < '@' code = sym&31 %if code = esc %start get sym %if sym = '?' %start; !canonical 2nd leadin get sym; sym = sym!!96 %finish code = sym+128 %finish %finish k = code; k = def(code) %unless ' ' <= k < 'X' %return %if mode = nomac %exit %if k < macro; !not macro macpush(k) mode = normal %repeat pend = k>>8; code = k&255 type = symtype(code)&15 %return err: type = 1; code = ' ' %end ! %routine GET TEXT %integer pos,lim %if sym = '!' %start %if msp # 0 %start; !dummy parameter pos = inpos; lim = inlim msp = msp-1 inpos = mstack(msp)&posmask; inlim = mstack(msp)>>limshift get sym %if inpos < inlim get text ! %return %if ref = 0; !trailing %if inpos < inlim %start mstack(msp) = inlim< 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<= enumcases %then write(value(i),1) %c %else print string(optname(i+i+bvalue(i))) %end cat(1,0) printstring( "RETURN to step through value or 'x' to alter ':' to exit") newline %cycle %for i = 0,1,enumcases+intcases-1 %cycle cat(0,0) printstring(text(i)) minwin = cur_min; !relevant current setting show(i) printstring("] :") clear line read command line get sym %if sym # ret %start %if sym = ':' %start save command; !ie last shown %return %finish num = 0 %while sym >= ' ' %cycle num = num*10+sym-'0' %if '0' <= sym <= '9' get sym %repeat %if i >= enumcases %start value(i) = num %if cur_min # minwin %start cur_min = minwin cur_win = offscreen; cur_diff = unknown %finish %else bvalue(i) = bvalue(i)!!1 cur_diff = unknown %if i = showpointer %finish coerce parameters i = i-1 %finish %repeat %repeat %end; !set options %routine DEFINE(%integer k) %integer m,n,pos,macpos,control control = 1; control = 0 %if ' ' <= k < del %if ' ' <= k < del %start control = 0 complain(tostring(k)." cannot be re-defined") %c %unless 'X' <= k <= 'Z' %or 'a' <= k <= 'z' %finish release(k) get sym n = 0 %if sym = '"' %start n = cdef>>16-cdef&posmask %else %if sym # '=' %start complain("*Missing equals-sign/colon") %if sym # ':' mac(inpos) = mac(inpos)!128 %if control # 0 %finish %if inpos >= inlim %start %return %unless term < ' ' %and term # ret mac(inlim) = term; inlim = inlim+1 %finish %finish pos = inpos inpos = inpos+1 %while inpos < inlim %and mac(inpos) # nl m = inpos-pos macpos = macspace(n+m) move(n,mac0+cdef&posmask,mac0+macpos); macpos = macpos+n move(m,mac0+pos,mac0+macpos); macpos = macpos+m def(k) = macpos<= macro %and sym < ' ') %start; !macro (alone) print symbol(k) %if control = 0 flag = '=' %if m >= macro %start; !defined macro macpush(m) flag = ':' %if mac(inpos)&128 # 0 get sym; k = sym m = k; m = def(k) %unless ' ' <= m < 'X' get sym %finish %else %if control # 0 %start flag = ':' %finish print symbol(flag); print symbol(' ') %finish back = 0 %if 'A' <= m <= 'W' %and sym = '-' %start m = m+casebit; get sym; back = 1 %finish %if sym >= ' ' %start; !not single command letter print symbol(k) print symbol('-') %if back # 0 %cycle print symbol(sym) get sym %repeat %until sym < ' ' print symbol('/') %and msp = 0 %if msp # 0 %finish %else %if control # 0 %and m = '\' %start print string("\ : Swop between command/data modes") %finish %else %if control # 0 %and m = '1' %start printstring("1 : repeat last command line") %else print code(m&255) k = m>>8 %if k # 0 %start %if k # '0' %start printsymbol(k) %else printstring("* (ie ") print code(m&255) printstring(" indefinitely)") %finish %else printstring(" : "); printstring(text(m)) %finish %finish newline %end; !explain %routine OUTPUT KEYDEFS %integer i,j,kk,sym %for kk = 0,1,255 %cycle i = def(kk) %if i >= premacro %and %not ' ' <= kk < 'X' %start print symbol('%'); print symbol('K') sym = kk %if sym < ' ' %or sym >= 128 %start print symbol('&'); sym = sym+64 %if sym >= 128 %start sym = kk&127 print symbol('['); !ESC print symbol('?') %and sym = sym!!96 %if sym < 64 %finish %finish print symbol(sym) j = i>>limshift; i = i&posmask %if mac(i)&128 = 0 %then printsymbol('=') %else printsymbol(':') %while i # j %cycle print symbol(mac(i)&127); i = i+1 %repeat newline %finish %repeat %end %routine ECHO COMMAND %integer pos cat(1,0) %if control < 0 %start printsymbol(charno(curprom,1)); printsymbol(charno(curprom,2)) pos = cdef&posmask %while pos < cdef>>16 %cycle print symbol(mac(pos)); pos = pos+1 %repeat clear line %finish %end ! ! I n i t i a l i s a t i o n ! %routine macinit(%string(255) s) %integer i,k %for i = 1,1,length(s) %cycle k = charno(s,i); k = k+128 %if 'A' <= k <= 'Z' mac(i+511) = k %repeat %end %conststring(2)%array PROM(-1:6) = "|>", ">>", "$>", "$$", "^?", "^>", "$^", "^$" edistart: lastcell_code = ')'; lastcell_count = 1 !Stored text pointers cdef = null; idef = null; mdef = null mac0 = addr(mac(0)); macm4 = mac0-4 macbase = mac0+528 integer(macbase) = macbound+1-532 integer(macbase+(macbound+1-532)) = 0 macinit("I. .D. .D-. .") mac(525) = ff; mac(526) = tab !$IF VAX or EMAS { def(128+'L'&31) = '{' %if vttype = esprit !$FINISH !File pointers cur = main oldlim1 = cur_lim1; oldstart2 = cur_start2 fp = cur_fp %if cur_line = 0 %start fp = cur_start1 cur_line = 1 %cycle fp = cur_start2 %if fp = cur_lim1 %exit %if fp = cur_fp %return %if fp = cur_lim2 cur_line = cur_line+1 %if byteinteger(fp) = nl fp = fp+1 %repeat %finish newlim = cur_lim2 !$IF EMAS { gdiff = 0 { %unless cur_lim1 <= cur_lim2 <= cur_lim %start { newlim = cur_lim-1024 { gdiff = newlim-cur_lim2 { %finish !$IF APM newlim = cur_lim-1024 !$FINISH delmax = newlim; byteinteger(delmax) = nl %if delmax > 0 lastdelmax = delmax foundpos = 0; foundsize = 0; markpos = 0 cmax1 = 0; consolidated = 0 error = 0; commandstream = 0; pend = 0 vgap = 0; joins = 0 sin = 0 %if cur_change < 0 %start; !showing only sin = 1 %else cur_change = ceiling %if cur_change = 0 cur_change = ceiling-1 %if cur_change # ceiling %finish altmin = ceiling; altlim = floor set lbeg; set lend ! !Initialise video info ![XOR so that VMODE can, awkwardly, suppress] smode = vmode!!(screenmode!specialmode) !$IF VAX or EMAS { define video(ttype) %and ttype = -2 %if ttype > -2 { smode = 0 %if vdu_fun = 0 !$FINISH prompt("") set video mode(smode) set windows cur_bot = wrows; cur_min = minwin cur_win = offscreen; cur_diff = unknown coerce parameters cat(1,0); printstring(message); newline ! ! R e a d n e w c o m m a n d l i n e ! comread: !Read command file if present %if pre # "" %start open in(pre) emode = 0 %finish resetread: pre = ""; curprom = "" inpos = inlim; msp = 0 read: %if markpos = 0 %then newprom = prom(sin) %c %else newprom = prom(sin+4) -> data entry %if emode # 0 pend = 0; control = -1 %if inpos >= inlim %start; !no input available %if commandstream = 0 %start; !on-line prepare for input %if newprom # curprom %or video = 0 %start curprom = newprom cat(0,0); printstring(curprom) %finish cat(0,2); clear line %finish read command line %until inlim > inpos %or commandstream+msp = 0 control = term %if inpos >= inlim %finish !Reset command variables again: chain = 0; cmax = cmax1 get code(first) %if control >= 0 %start; !control key %if code = '\' %start; !toggle editing mode emode = emode!!1; toggle = \toggle !$IF APM dmode = dmode!!1 %if toggle = 0; !insert<->replace !$FINISH remove pointer -> resetread %finish %finish %else %if code = '-' %and def(ret)&casemask = 'M' %start def(ret) = def(ret)!!casebit; !toggle direction control = term %if inpos >= inlim get code(first) %finish toggle = 0 -> read %if type = 1 %if code = '?' %start cat(1,40); write(cur_line,0); clear line -> resetread %finish %if type = 0 %start; !repetition number sym = code; number -> er2 %if sym >= ' ' def(ret) = 'M' %if def(ret) = 'm' -> read %if cmax = 0; !no command to repeat r(cmax)_count = num -> restore %finish %if code = '%' %start get sym; code = sym sym = sym&95 ->er2 %if code < 'A' get sym %until sym # ' ' -> pc(code&95) %finish %if control < 0 %start; !not control key def(ret) = 'M' %if def(ret) = 'm'; !restore cdef = newdef cmax = 0; treflim1 = trefbase %finish ! ! C o m m a n d i n p u t: m a i n l o o p ci = cmax; treflim = treflim1 more: !(command code has been read) -> er5 %if type < 4 -> er0 %if type < 8 %and newlim <= 0; !no changes when Showing ci = ci+1; -> er6 %if ci >= cbound num = 1; scope = 0; ref = 0; !defaults get sym; !next symbol without mapping %if sym = '-' %start code = code!casebit; type = symtype(code)&15 -> er5 %if type < 4 code = '-' %if code = '+' get sym %finish -> c(type) c(8): !Find num = 0 c(7): !+ Delete, Uncover c(9): !+ Traverse, Verify number scope = num num = 0; !as indicator (not I,O,S,G) c(6): !+ Insert, Overwrite, ! Substitute, Get get text -> er4 %if ref = nullref %and num = 0 get sym num = 1; !restore default c(5): !Erase, Get, etc c(10): !+ Move, Next, Print num = 0 %if code = '#'; number -> put c(11): !open bracket, comma ref = chain; chain = ci -> put c(12): !^ num = 0; number %if num # 0 %start -> erq %if num > 6 num = num+('X'-1); num = num+('x'-'Z'-1) %if num > 'Z' %finish -> put c(13): !: [temp] -> erq %unless 'X' <= sym&95 <= 'Z' num = sym; code = '^' get sym -> put c(14): !close bracket unchain; -> er3 %if ref = 0 number r(ref)_count = num c(15): !invert, query put: r(ci)_code = code; r(ci)_ref = ref r(ci)_scope = scope; r(ci)_count = num pend = sym; get code(normal) -> more %unless type = 1 ci = ci+1; cmax = ci r(ci) = lastcell unchain; -> er3 %if ref # 0 %if control < 0 %start; !not control key cmax1 = cmax; treflim1 = treflim %if emode # 0 %or cscroll = 0 %start; !'home' used ! or can't scroll command window echo command %if video # 0 %else save command %finish error = 0 %finish restore: %if error # 0 %start cat(1,chalf); clear line error = 0 %finish sym = ret %if sym < ' ' ! %if cur_flag >= ' ' %start ! at(cur_row,cur_col) ! print symbol(fpsym) ! at(cur_row,cur_col) ! print symbol(0); !to flush & position video cursor ! %finish -> execute ! %routine REPORT(%string(255) message) !Make command error report (to right of command text) %if emode = 0 %start echo command %if cscroll = 0 %finish %else cat(1,0) printstring(message) %end ! er0: report(" "); print code(code) print string(" when Showing") -> erq er3: report(" Brackets") -> erq er4: report(" Text for ") print code(code) -> erq er2: code = sym pc(*): c(*): er5: report(" "); print code(code) -> erq er6: report(" Size") erq: print symbol('?') cmax1 = 0 %if ci > 1 newline save command %if emode = 0 %and cscroll # 0; !(else REPORT echoed) ignore: close in %if commandstream # 0 -> resetread ! ! Percent commands pc('S'): !Secondary input switch %if sin&(\1) # 0 get sym %if sym = '=' %if sym >= ' ' %start get name(sec_name) sec_flag = 0 connect edfile(sec) sec_flag = 0 %finish sec_line = 0; !indicator for reset switch -> read pc('G'): !Get command file get name(pre) close in %if commandstream # 0 -> comread pc('P'): !Put key definitions get name(pre) open out(pre) %if pre # "" pre = "" output keydefs close out -> read pc('U'): !ignore/heed case mapcase = 1 mapcase = 0 %and get sym %if sym = '-' coerce parameters -> read pc('L'): !Line width get sym %if sym = '=' number; -> erq %if type # 0 width = num coerce parameters -> read pc('M'): !Margin get sym %if sym = '=' number; -> erq %if type # 0 margin = num coerce parameters -> read pc('D'): !Display get sym %if sym = '=' %if sym >= ' ' %start number -> erq %if type # 0 cur_min = num %finish remove pointer coerce parameters qread: cur_win = offscreen; cur_diff = unknown curprom = "" -> read pc('H'): !Help remove pointer !$IF EMAS or VAX { push window { win = vdu { vt at(ctop+1,0); !in case of error report !$IF EMAS { set video mode(0) !$FINISH !$IF EMAS OR VAX { %if sym < ' ' %then view(helpfile) %c { %else get name(pre) %and view(pre) %and pre = "" !$IF EMAS { set video mode(smode) !$FINISH !$IF EMAS OR VAX { pop window { -> qread !$IF APM complain("Help not available") !$FINISH pc('E'): !Environment remove pointer set options curprom = "" -> read pc('W'): -> erq %if sin # 0 get sym %if sym = '=' num = 1; number store deletions %if oldstart2 < cur_start2 %cycle %exit %if delmax <= newlim delmax = delmax-1 num = num-1 %if byteinteger(delmax) = nl %repeat %until num = 0 oldlim1 = cur_lim1; oldstart2 = cur_start2 -> read pc('X'): pc('Y'): pc('Z'): %if sym >= ' ' %start; !definition pend = sym define(code) %else; !enquiry explain(code) %finish -> read pc('Q'): %if sym # ret %or term # ret %start pend = sym; get code(nomac) get sym %if sym >= ' ' explain(code) %else %cycle cat(0,0); printstring("Key (or :): "); clear line read text(nomac) inpos = newdef&posmask; inlim = newdef>>16 get code(nomac) get sym %if sym >= ' ' %exit %if code = ':' explain(code) %repeat %finish curprom = "" -> read pc('K'): !define key(s) %if sym # ret %or term # ret %start pend = sym; get code(nomac) %if inpos >= inlim %start printsymbol('*') %unless ' ' <= code < del read command line %finish define(code) %else %cycle cat(0,0); printstring("Key = defn: "); clear line read text(nomac) inpos = newdef&posmask; inlim = newdef>>16 get code(nomac) %exit %if code = ':' %if inpos >= inlim %start printsymbol('*') %unless ' ' <= code < del read command line %finish define(code) %repeat %finish curprom = "" -> read pc('A'): !Abandon update switch %if sin&(\1) # 0 %if cur_change # ceiling %start !Change made printstring(" Abandon complete edit? (y/n) ") read command line get sym; -> ignore %if sym!casebit # 'y' get sym; -> ignore %if sym >= ' ' %finish sym = -1; cur_change = ceiling pc('C'): !Close remove pointer update switch %if sin&(\1) # 0 fp = cur_start2; cur_lbeg = fp; set lend consolidate(0,0); !ensure no split line cur_flag = sym main = cur pop frame; pop frame !$IF EMAS OR VAX { vt at(vdu_rows-1,0) !$IF APM gotoxy(0,vdu_rows-1) !$FINISH clear line; ! print symbol(rt); print symbol(0); !to flush set video mode(0) %end; !END OF EDI ! !$IF VAX {%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_lim2-out_start2; !lower half { move(i,out_start2,out_lim1); ! concatenated to upper { out_lim1 = out_lim1+i { %cycle { i = writeout(out_name,out_start1,out_start1,out_lim1,out_lim) { %exit %if i = 0 { print string(" *".sysmess(i).": ".out_name) { newline { print string(" Please supply alternative file-name: ") { select input(0); prompt("") { out_name = "" { read symbol(k) %until k # ' ' { %cycle { out_name = out_name.tostring(k); read symbol(k) { %repeat %until k < ' ' { newline { %repeat {%end !$IF APM %external%routine DISCONNECT EDFILE(%record(edfile)%name out) %integer i,k %on %event 3,9 %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 %if i # out_lim1 %start %cycle print ch(byteinteger(i)); i = i+1 %repeat %until i = out_lim1 %finish i = out_start2 %if i # out_lim2 %start %cycle print ch(byteinteger(i)); i = i+1 %repeat %until i = out_lim2 %finish close output select output(0) %finish heapput(out_start1) out_start1 = 0 %end !$FINISH %endoffile