IMD 1.16: 6/09/2007 20:19:05 edits editors  @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@   A APx?7J6 >zCF ANx ̋R   ҁӤӤ5 :7hbBAJ RT-11SJ V02C-02 1̋΀R  y &  %C e  7 ?B-I/O ERROR vߋtȋ xE  e  pZ@ `D fHT HTHTS K,e 6 e @BEDITSEZL2.TEXTLX ENVIRON.TEXTm COPYFILE.TEXTm UTIL.TEXTm  HEAD.TEXTm  MISC.TEXTmٜ" COMMAND.TEXTm"*OUT.TEXTmV*0PUTSYNTAX.TEXTmٜ0D FIND.TEXTmDX INIT.TEXTmXp INSERTIT.TEXTmpz EDITOR.TEXTm z USER.TEXTm MOVEIT.TEXTm MARKDUPDIR.TEXTCOPYDUPDIR.TEXT YALOE.TEXTnPROGRAM FORWARD INIT OUT COPYFILEENVIRON PUTSYN COMMAND INSERT MOVEIT ADJUST MOVING DELETE FIND USER MISCg UTIL GETPAGESPUTPAGESBODY  !"+6<@CEOPT_ad)7,] r7X/=  *)  (* IIS | Version | *)  (* University of California, San Diego 255; ;EXPANSION: PACKED ARRAY [0..3] OF CHAR 9END; 0CRTINFO: PACKED RECORD ;WIDTH,HEIGHT: INTEGER; ;RIGHT,LEFT,DOWN,UP: CHA | L.2 | *)  (* La Jolla CA 92093 \_________/ *)  (* R; ;BADCH,CHARDEL,STOP,BREAK,FLUSH,EOF: CHAR; ;ALTMODE,LINEDEL: CHAR; ;EXPANSION: PACKED ARRAY [0..5] OF CHAR 9END .END (*S *)  (* Copyright (c) 1978, by The Regents of the University of *)  (* YSCOM*);   VAR (* I.4 Globals as of 30-Jan-78 *) "SYSCOM: ^SYSCOMREC; "TRASHY: ARRAY [0..5] OF INTEGER; "USERINFO: INFORECO^XX California at San Diego *)  (* *)  (**********************************************************************)   (*$U-*)  PROGRAM PASCALSYSTEM;   CONST "VIDLENG = 7; (* Number of characters in a volume ID *) "TIDLENG = 15; (* Number of characters in a title ID *) %  TYPE  "VID = STRING[VIDLENG]; " "TID = STRING[TIDLENG]; " "DATEREC=PACKED RECORD ,MONTH: 0..12; ,DAY: 0..31; ,YEAR: 0..100 *END; * "INFOREC = RECORD .TRASH1,TRASH2: INTEGER; .ERRSYM,ERRBLK,ERRNUM: INTEGER; (* Error com for EDIT *) .TRASH3: ARRAY [0..2] OF INTEGER; .GOTSYM,GOTCODE: BOOLEAN; .WORKVI (*$TS c r e e n E d i t o r*)  (*$L PRINTER: *)  (*$S+*)   (***********************************************************D,SYMVID,CODEVID: VID; (* Perm&Cur workfile volumes *) .WORKTID,SYMTID,CODETID: TID (* Perm&Cur workfile titles *) ***********)  (* *)  (* Screen Oriented Editor ,END (*INFOREC*) ; " "SYSCOMREC = RECORD 0JUNK: ARRAY [0..6] OF INTEGER; 0LASTMP: INTEGER; 0EXPANSION: ARRAY [0..20] OF INT July 8, 1978 *)  (* ------ -------- ------ *)  (* EGER; 0MISCINFO: PACKED RECORD ' or '<' *) "REPEATFACTOR: INTEGER; "BUFSIZE: INTEGER; "SCREENWIDTH: INTEGER; OF CHAR; "PTYPE=PACKED ARRAY [0..MAXSTRING] OF CHAR; "COMMANDS=(ILLEGAL, ADJUSTC, BANISHC, COPYC, DELETEC, FINDC, INSERTC, JUM(* Moved to var 26-Jan *) "SCREENHEIGHT: INTEGER; (* " " " " *) "COMMAND: COMMANDS; "LASTPAT: 0..MAXBUFSIPC, ,LISTC, MACRODEFC, NEXTC, PARAC, QUITC, REPLACEC, SETC, VERIFYC, ,XECUTEC, ZAPC, REVERSEC, FORWARDC, UP, DOWN, LEFT, RIGHTZE; "EBUF: ^BUFRTYPE; "KIND: ARRAY [CHAR] OF INTEGER; (* for token find *) "LINE1PTR: 0..MAXBUFSIZE; "MIDDLE: INTEGER; , TAB, ,DIGIT, DUMPC, ADVANCE, SPACE, EQUALC, SLASHC); "CTYPE=(FS,GOHOME,ETOEOL,ETOEOS,US); "LEFTRIGHT=(LEFTSTACK,RIGHTSTACK) (* Middle line on the screen *) "NEEDPROMPT: BOOLEAN; "ETX,BS,DEL,ESC: INTEGER; (* Moved from CONST 30-Jan-78 *; " "HEADER= (* Page Zero layout changed 20-Jun-78 *) $RECORD CASE BOOLEAN OF ) "FLENGTH: INTEGER; (* The length of the workfile in pages *) "LPAGE,RPAGE: INTEGER; (* Left and Right &TRUE: (BUF: PACKED ARRAY[0..MAXOFFSET] OF CHAR); &FALSE:(DEFINED: INTEGER; (* New file => 0; Old file => 1 *) -COUNT: stack pointers *) "TRASH: INTEGER; (* Totally without redeeming social value *) "TARGET: PTYPE; "SUBSTRING: PT; "TRASHYY: ARRAY [0..4] OF INTEGER; "SYVID,DKVID: VID; "THEDATE: DATEREC;    (*$TEditor Segment*)  SEGMENT PROCEDURE E INTEGER; (* The count of valid markers *) -NAME: ARRAY [0..19] OF PACKED ARRAY [0..7] OF CHAR; -PAGEN: PACKED ARDITOR;  CONST "(* Unless otherwise noted all constants are upper bounds %from zero. *)  "MAXBUFSIZE=32767; "MRAY [0..19] OF INTEGER; -POFFSET: PACKED ARRAY [0..19] OF OFFSET; -TABSTOP: PACKED ARRAY [0..127] OF TABATTRIBUTE; -AUTAXSW=84; (* Maximum allowable SCREENWIDTH *) "MAXSTRING=127; "MAXCHAR=1023; (* The maximum number of characters on a line in OINDENT: BOOLEAN; (* Environment stuff follows *) -FILLING: BOOLEAN; -TOKDEF: BOOLEAN; -LMARGIN: 0..MAXSW; -RMARGIthe EBUF *) "TIDLENG=15; (* From SYSCOM *) "CHARINBUF=2048; (* For final version. Not used. *) N: 0..MAXSW; -PARAMARGIN: 0..MAXSW; -RUNOFFCH: CHAR; -CREATED: DATEREC; -LASTUPD: DATEREC; -REVISION: INTEGER;"MAXOFFSET=1023; (* Maximum offset in a page *) "MAXPAGE=255; (* Ridiculous upper bound! *) " "(* The following ASCII charac -FILLER: ARRAY [0..91] OF INTEGER) $END; $    VAR "CURSOR: 0..MAXBUFSIZE; "BUFCOUNT: 0..MAXBUFSIZE; (* Numbters are hard-wired in *) "BSPCE=8; HT=9; LF=10; EOL=13; DLE=16; SP=32; "DC1=17; BELL=7; RUBOUT=127; CR=13; "   TYPE "PTRer of valid characters in the EBUF *) "STUFFSTART: 0..MAXBUFSIZE; (* GETLEADING *) "LINESTART: 0..MAXBUFSIZE; TYPE=0..MAXBUFSIZE; "BUFRTYPE=PACKED ARRAY [0..0] OF CHAR; "BLOCKTYPE=PACKED ARRAY [0..511] OF CHAR; "ERRORTYPE=(FATAL,NONFAT (* sets *) "BYTES,BLANKS: INTEGER; (* these *) "CH: CHAR;  l patch - for BLANKCRT(1) *) "PAGEBUFFER: PACKED ARRAY [0..1023] OF CHAR; "BLANKAREA: PACKED ARRAY [0..MAXSW] OF CHAR;  WFN;  PROCEDURE LINEOUT(VAR PTR:PTRTYPE; BYTES,BLANKS,LINE: INTEGER); FORWARD; AME,BACKFNAME: STRING;   SEGMENT PROCEDURE NUM2; BEGIN END; SEGMENT PROCEDURE NUM3; BEGIN END;  SEGMENT PROCEDURE NUM4; PROCEDURE UPSCREEN(FIRSTLINE,WHOLESCREEN:BOOLEAN; LINE: INTEGER); FORWARD;  PROCEDURE READJUST(CURSOR: PTRTYPE; DELTA: INTEGE BEGIN END; SEGMENT PROCEDURE NUM5; BEGIN END;  SEGMENT PROCEDURE NUM6; BEGIN END; SEGMENT PROCEDURE NUM7; BEGIN END;R); FORWARD;  PROCEDURE THEFIXER(PARAPTR: PTRTYPE;RFAC: INTEGER;WHOLE: BOOLEAN); FORWARD;  PROCEDURE GETNAME(MSG:STRING; VAR M  SEGMENT PROCEDURE NUM8; BEGIN END; SEGMENT PROCEDURE NUM9; BEGIN END;      (* Forward declared procedures.. all:NAME); FORWARD;  PROCEDURE GETPAGES(WHICH:LEFTRIGHT); FORWARD;  PROCEDURE PUTPAGES(WHICH:LEFTRIGHT); FORWARD;  FUNCTION REA procedures are in MISC and UTIL *)   PROCEDURE ERROR(S:STRING;HOWBAD:ERRORTYPE); FORWARD;  PROCEDURE ERASETOEOL(X,LINE:INTEDIT(WHICH:LEFTRIGHT): BOOLEAN; FORWARD;  FUNCTION WRITEIT(WHICH:LEFTRIGHT): BOOLEAN; FORWARD;  PROCEDURE CHECKINDENT(VAR CURSGER); FORWARD;  FUNCTION GETCH:CHAR; FORWARD;  PROCEDURE CLEARSCREEN; FORWARD; OR:PTRTYPE); FORWARD;   (*$TI n i t i a l i z e*)  SEGMENT PROCEDURE INITIALIZE;  LABEL 1;  TYPE PHYLE=FILE;  VAR "BLOC PROCEDURE ERASEOS(X,LINE:INTEGER); FORWARD;  PROCEDURE CLEARLINE(Y:INTEGER); FORWARD;  FUNCTION MAPTOCOMMAND(CH:CHAR): COMMK: ^BLOCKTYPE; "ONEWD: ^INTEGER; "DONE,OVFLW: BOOLEAN; "CH: CHAR; "I,QUIT,GAP,BLKS,PAGE,NOTNULS: INTEGER; "FILENAME: STRINGANDS; FORWARD;  FUNCTION UCLC(CH:CHAR): CHAR; FORWARD;  PROCEDURE PROMPT; FORWARD;  PROCEDURE REDISPLAY; FORWARD;  FUNCTION; "BUFFER: PACKED ARRAY [0..1023] OF CHAR; "FIBAREA: ARRAY [0..17] OF INTEGER;   PROCEDURE MAP(CH:CHAR; C:COMMANDS);  BEGI MIN(A,B:INTEGER): INTEGER; FORWARD;  FUNCTION MAX(A,B:INTEGER): INTEGER; FORWARD;  PROCEDURE CONTROL(CH:CTYPE); FORWARD;  N "TRANSLATE[CH]:=C; "IF CH IN ['A'..'Z'] THEN TRANSLATE[CHR(32+ORD(CH))]:=C; (* LC TOO *)  END;  YPE; "SLENGTH,TLENGTH: INTEGER; (* Length of target and substring *) "SDEFINED,TDEFINED: BOOLEAN; (* Whether the strinPROCEDURE PUTMSG; FORWARD;  PROCEDURE HOME; FORWARD;  PROCEDURE ERRWAIT; FORWARD;  PROCEDURE BLANKCRT(Y: INTEGER); FORWARD; gs are valid *) "COPYLENGTH,COPYSTART: PTRTYPE; (* For Copyc *) "COPYLINE,COPYOK: BOOLEAN; (* " *)  FUNCTION LEADBLANKS(PTR:PTRTYPE;VAR BYTES: INTEGER): INTEGER; FORWARD;  PROCEDURE CENTERCURSOR(VAR LINE: INTEGER; LINESUP: IN"INFINITY: BOOLEAN; (* for slashc *) "THEFILE: FILE; "PR: FILE; (* DEBUG *) "TRANSLATE: ARRTEGER; NEWSCREEN:BOOLEAN); "FORWARD;  PROCEDURE FINDXY(VAR INDENT,LINE: INTEGER); FORWARD;  PROCEDURE SHOWCURSOR; FORWARD;  AY [CHAR] OF COMMANDS; "PAGEZERO: HEADER; "MSG: STRING; "PROMPTLINE: STRING; "SAVETOP: STRING; (* Dumb terminaFUNCTION GETNUM: INTEGER; FORWARD;  PROCEDURE GETLEADING; FORWARD;  FUNCTION OKTODEL(CURSOR,ANCHOR:PTRTYPE):BOOLEAN; FORWARD R I:=1 TO LENGTH(T) DO T[I]:=UCLC(T[I]); "IF (POS('.TEXT',T)=LENGTH(T)-4) AND (LENGTH(T)>=5) THEN $DELETE(T,LENGTH(T)-4,5); "s the original .BACK, and #names the copy .TEXT *)  VAR "INBNUM,OUTBNUM,OUTFSIZE,BLKSREAD,MAXBLOCKINBUF: INTEGER; "CH: CHAR;WFNAME:=CONCAT(T,'.TEXT'); "BACKFNAME:=CONCAT(T,'.BACK');  END;   PROCEDURE DEFAULTPZ;  BEGIN "WITH PAGEZERO DO $IF DEFI "F: FILE;  BEGIN "REWRITE(F,BACKFNAME); "IF IORESULT<>0 THEN ERROR('Can''t open backup file! ',FATAL); NED<>2 THEN &BEGIN (FILLCHAR(BUF,1024,CHR(0)); (TOKDEF:=TRUE; (* Default mode is T(oken *) (FILLING:=FALSE; AUTOINDENT:=TRU"OUTFSIZE:=FINDLENGTH(F); "IF OUTFSIZE2 THEN $ERROR('Reading Page Zero',FATAL); "(* Compensate for shift in filhis code relies on a "special feature" in the #I/O subsystem, namely when the year is set to 100 the title gets updated e *) "WITH PAGEZERO DO $FOR I:=0 TO COUNT-1 DO &PAGEN[I]:=PAGEN[I]+RPAGE-1; "IF BLOCKWRITE(F,PAGEZERO,2,0)<>2 THEN $ERROR('#when the file is closed *)  VAR "COLON: INTEGER; "D: DATEREC; "FIBPA: PACKED ARRAY [0..57] OF CHAR;  BEGIN "(* Make sureWriting Page Zero',FATAL); "MAXBLOCKINBUF:=BUFSIZE DIV 512; "REPEAT $BLKSREAD:=BLOCKREAD(THEFILE,EBUF^,MAXBLOCKINBUF,INBNUM); that the filename doesn't include the volume name (or "*") *) "COLON:=POS(':',T); "IF COLON>0 THEN DELETE(T,1,COLON); "IF T[ $IF IORESULT<>0 THEN ERROR('Bad input file.',FATAL); $IF BLKSREAD<>0 THEN &BEGIN (IF BLOCKWRITE(F,EBUF^,BLKSREAD,OUTBNUM)<>1]='*' THEN DELETE(T,1,1); "MOVELEFT(F,FIBPA,58); (* Transfers the FIB for the file F to FIBPA *) "MOVELEFT(T,FIBPA[38],16); BLKSREAD THEN *ERROR('Ran out of room.',FATAL); (IF IORESULT<>0 THEN ERROR('On backup file.',FATAL); &END; "WITH D DO BEGIN DAY:=2; MONTH:=3; YEAR:=100 END; "MOVELEFT(D,FIBPA[56],2); "MOVELEFT(FIBPA,F,58)  END;   FUNCTION FINDLEN$OUTBNUM:=OUTBNUM+BLKSREAD; $INBNUM:=INBNUM+BLKSREAD "UNTIL BLKSREAD=0; "CHANGENAME(THEFILE,BACKFNAME); "CLOSE(THEFILE,LOCKGTH(VAR F:PHYLE):INTEGER;  BEGIN "(* KLUDGE logic. Returns the length of the file in pages! *) "MOVELEFT(F,FIBAREA,36); "FI); "CHANGENAME(F,WFNAME); "CLOSE(F,LOCK); "FLENGTH:=OUTFSIZE; (* Copy over the length attribute, *) "RESET(THEFILE,W PROCEDURE CLEANTITLE(VAR T:STRING);  (* Attaches the default '.TEXT' to the end of the filename if necessary. *)  BEGIN "FONDLENGTH:=(FIBAREA[17]-FIBAREA[16]) DIV 2;  END;   PROCEDURE BACKUP;  (* Copies the file to be edited to another file, name NAME); *IF IORESULT<>0 THEN ERROR('Workfile lost.',FATAL) (END &ELSE (BEGIN *MSG:='No workfile is present. File? ( for no file ) '; *REPEAT ,WRITE(MSG); ,READLN(INPUT,FILENAME); ,IF LENGTH(FILENAME)=0 THEN (* Open up good ol' SYSTEM.WRK.TEXTFNAME) (* and make the file you copied the workfile! *)  END;   PROCEDURE READFILE;  BEGIN "CLEARSCREEN; (* Dumb terminal patch *) "WRITELN('>Edit:'); "WRITE('Reading'); "RESET(THEFILE); (* Was potentially closed by BACKUP *) "IF B&(* NEXTCOMMAND and GETNUM handle VT-52 style vector keys *) &IF SYSCOM^.CRTCTRL.ESCAPE=CHR(0) THEN (BEGIN *MAP(SYSCOM^.CRTILOCKREAD(THEFILE,PAGEZERO,2)<>2 THEN ERROR('Reading file',FATAL); "WRITE('.'); "GETPAGES(RIGHTSTACK)  END;    (* People NFO.LEFT,LEFT); *MAP(SYSCOM^.CRTINFO.DOWN,DOWN); *MAP(SYSCOM^.CRTINFO.RIGHT,RIGHT); *MAP(SYSCOM^.CRTINFO.UP,UP); (END; &MAPwith word machines -- L O O K A T M E ! ! *)   FUNCTION BYTESLEFT: INTEGER;  (* Returns the number of bytes between BLO(SYSCOM^.CRTINFO.CHARDEL,LEFT); &MAP(CHR(EOL),ADVANCE); (* CR IS ADVANCE *) &MAP(CHR(HT),TAB); &MAP(CHR(SP),SPACE);   &(CK and LASTMP *)  BEGIN "BYTESLEFT:=(* DOUBLE FOR WORD MACHINES *) (ORD(SYSCOM^.LASTMP)-ORD(BLOCK))  END;   BEGIN "WITH P* Digits *) & &FOR CH:='0' TO '9' DO MAP(CH,DIGIT);   &(* Variable buffer sizing... added 17-Jan-78 *) & &QUIT:=11000+ AGEZERO DO $BEGIN & &(* Init the translate table *) & &FILLCHAR(TRANSLATE,SIZEOF(TRANSLATE),ILLEGAL); &  (* Sizeof(editcore)-Sizeof(initialize) *) ,512; (* Slop! *) &MARK(EBUF); &BLKS:=0; &REPEAT (NEW(BLOCK); (BLKS&MAP('A',ADJUSTC); MAP('B',BANISHC); MAP('C',COPYC); &MAP('D',DELETEC); MAP('F',FINDC); MAP('I',INSERTC); &MAP(':=BLKS+1; (GAP:=BYTESLEFT-512 (* Bytesleft returns the # of bytes between Cthe pointers BLOCK and LASTMP *) &UNTIL ((GAPJ',JUMPC); MAP('L',LISTC); MAP('M',MACRODEFC); &MAP('N',NEXTC); MAP('P',PARAC); MAP('Q',QUITC); &MAP('R',REPLA>0) AND (GAP',FORWARDC); Mel for end of buffer - for M(unch *) & & &(* Open the workfile *) & &LPAGE:=0; (* Left stack empty *) AP('.',FORWARDC); &MAP('+',FORWARDC); MAP('-',REVERSEC); MAP('?',DUMPC); &MAP('/',SLASHC); MAP('=',EQUALC); MAP('<',RE&RPAGE:=1; (* Right stack contains all of the workfile *) &BUFCOUNT:=1; &CURSOR:=1; &CLEARSCREEN; &WRITELN('>Edit:'); &IF VERSEC);  % &(* Arrows *) & USERINFO.GOTSYM THEN (BEGIN *FILENAME:=CONCAT(USERINFO.SYMVID,':',USERINFO.SYMTID); *CLEANTITLE(FILENAME); *RESET(THEFILE,WF HEFILE); & & &(* If desired, copy the workfile (maximizing editing room) *) & &BACKUP; & & &(* Read in the file *) & &AR F:PHYLE; T:STRING);  (* Change the title of F to T. Note: (1) The file F must be closed with #CLOSE(F,LOCK), and (2) this FILLCHAR(EBUF^,BUFSIZE+1,CHR(0)); &EBUF^[0]:=CHR(EOL); &READFILE; &1: IF (EBUF^[BUFCOUNT-1]<>CHR(EOL)) OR (BUFCOUNT=1) THEN code relies on a "special feature" in the #I/O subsystem, namely when the year is set to 100 the title gets updated #when the (BEGIN *EBUF^[BUFCOUNT]:=CHR(EOL); *BUFCOUNT:=BUFCOUNT+1; (END; & & &(* Initialize everything else! *) & &DIRECTION:='>'file is closed *)  VAR "COLON: INTEGER; "D: DATEREC; "FIBPA: PACKED ARRAY [0..57] OF CHAR;  BEGIN "(* Make sure that the f; &LASTPAT:=1; (* Init to the beginning of the buffer (for equalc) *) ©OK:=FALSE; &LINE1PTR:=1; ilename doesn't include the volume name (or "*") *) "COLON:=POS(':',T); "IF COLON>0 THEN DELETE(T,1,COLON); "IF T[1]='*' THEN&WITH SYSCOM^.CRTINFO DO (BEGIN *ESC:=ORD(ALTMODE); *ETX:=ORD(EOF); *BS:=ORD(CHARDEL); *DEL:=ORD(LINEDEL); *SCREENWIDTH:= DELETE(T,1,1); "MOVELEFT(F,FIBPA,58); (* Transfers the FIB for the file F to FIBPA *) "MOVELEFT(T,FIBPA[38],16); "WITH D DO ! *) .BEGIN 0FILENAME:='*SYSTEM.WRK.TEXT'; 0CLEANTITLE(FILENAME); 0FILLCHAR(EBUF^,BUFSIZE+1,CHR(0)); 0EBUF^[0]:=CHR(EOL); WIDTH-1; *SCREENHEIGHT:=HEIGHT-1; *MIDDLE:=(SCREENHEIGHT DIV 2) + 1; (END; &SYSCOM^.MISCINFO.NOBREAK := TRUE; &SDEFINED:=FA0FILLCHAR(PAGEZERO,SIZEOF(PAGEZERO),CHR(0)); 0REWRITE(THEFILE,WFNAME); 0BACKFNAME:=''; 0IF IORESULT<>0 THEN ERROR('System voLSE; TDEFINED:=FALSE; (* No substring or target *) & & &(* Set up Pagezero if nec. *) & &DEFAULTPZ; &REVISION:=REVISION+1;lume not on line',FATAL); 0(* Establish the length of the file and lock the file 3to be the maximum even length *) 0FLENGTH:= $ " $END(* WITH *); " " "(* Initialize the KIND array for token find *) " "FOR CH:=CHR(0) TO CHR(255) DO KIND[CH]:=ORD(FINDLENGTH(THEFILE); 0IF ODD(FLENGTH) THEN FLENGTH:=FLENGTH-1; 0IF BLOCKWRITE(THEFILE,BUFFER,1,2*FLENGTH-1)<>1 CH); (* Make them all unique *) "FOR CH:='A' TO 'Z' DO KIND[CH]:=ORD('A'); "FOR CH:='a' TO 'z' DO KIND[CH]:=ORD('A'); "FOR C2THEN ERROR('File system terminal error',FATAL); 0CLOSE(THEFILE,LOCK); 0WITH USERINFO DO 2BEGIN 4SYMVID:=SYVID; SYMTID:='SYH:='0' TO '9' DO KIND[CH]:=ORD('A'); "KIND[CHR(EOL)]:=ORD(' '); KIND[CHR(HT)] :=ORD(' '); "FILLCHAR(BLANKAREA,SIZEOF(BLANKAREASTEM.WRK.TEXT'; GOTSYM:=TRUE; 4OPENOLD(THEFILE,'*SYSTEM.WRK.CODE'); CLOSE(THEFILE,PURGE); 4GOTCODE:=FALSE; CODETID:='' 2END; ),' '); (* For unitwriting blanks *) "SAVETOP:=' '; (* for BLANKCRT(1) - saves the prompt or msg line *) "  END(* INITIALIZE0RESET(THEFILE,'*SYSTEM.WRK.TEXT'); 0RPAGE:=FLENGTH; 0GOTO 1; .END; ,CLEANTITLE(FILENAME); ,OPENOLD(THEFILE,WFNAME); ,MSG *);    (*$TO u t*)  SEGMENT FUNCTION OUT: BOOLEAN;  LABEL 1,2;  TYPE "PHYLE=FILE;  VAR "SAVE: PTRTYPE; :='Not present. File? '; *UNTIL IORESULT=0; (END; & & &(* Find out the length of the workfile *) & &FLENGTH:=FINDLENGTH(T"RBNUM,LBNUM,MAXBLKSINBUF,BLKSREAD,I: INTEGER; "BUF: PACKED ARRAY [0..1023] OF CHAR; "FN: STRING;   PROCEDURE CHANGENAME(V ing'); $CH:=UCLC(GETCH); "UNTIL CH IN ['U','E','R']; "IF CH='R' THEN GOTO 2; "IF CH='E' THEN $BEGIN &OUT:=TRUE; &CLEARSCR 2:END;     (*$TC o p y f i l e*)  SEGMENT PROCEDURE COPYFILE;  VAR "STARTPAGE,STOPPAGE,STARTOFFSET,STOPOFFSET, "LEFEEN; &CLOSE(THEFILE,PURGE); &IF LENGTH(BACKFNAME)>0 THEN (BEGIN *RESET(THEFILE,BACKFNAME); *IF IORESULT=0 THEN ,BEGIN .CHTPART,PAGE,NOTNULLS,THEREST,LMOVE: INTEGER; "DONE,OVFLW: BOOLEAN; "BUFR: PACKED ARRAY [0..1023] OF CHAR; "STARTMARK,STOPMARK:ANGENAME(THEFILE,WFNAME); .CLOSE(THEFILE,LOCK); ,END *ELSE ,WRITELN('Backup file not present (tried to remove it).'); *GOTO PACKED ARRAY [0..7] OF CHAR; "FN: STRING; "F: FILE;   PROCEDURE ERRMARKER;  BEGIN "ERROR('Improper marker specification. 2 (END &ELSE GOTO 2; " END; "BLANKCRT(1); "CURSOR:=BUFCOUNT+199; (* Takes care of the slop! *) "WRITE('Writing'); "PUT',NONFATAL); "EXIT(COPYFILE)  END;   PROCEDURE UNSPLITBUF;  (* Stich the buffer back together again. *)  VAR BOGOSITY: PTPAGES(LEFTSTACK); "PAGEZERO.LASTUPD:=THEDATE; (* Reset last update date *) RTYPE;  BEGIN "MOVELEFT(EBUF^[THEREST],EBUF^[CURSOR],LMOVE); "READJUST(LEFTPART+1,CURSOR-(LEFTPART+1)); "BUFCOUNT:=BUFCOUNT+"IF LPAGE+1=RPAGE THEN BEGIN OUT:=TRUE; CLEARSCREEN; GOTO 2 END; "IF LPAGE+1>RPAGE THEN ERROR('LPAGE+1>RPAGE',FATAL); "LBNUM:CURSOR-(LEFTPART+1); "(* Check that two DLE's in a row haven't been generated *) "CHECKINDENT(CURSOR); "BOGOSITY:=LEFTPART+1;=2*(LPAGE+1); "RBNUM:=2*RPAGE; "MAXBLKSINBUF:=BUFSIZE DIV 512; "REPEAT $WRITE('*'); $BLKSREAD:=BLOCKREAD(THEFILE,EBUF^,MAXB "CHECKINDENT(BOGOSITY);  END;   PROCEDURE READERR;  BEGIN "ERROR('Marker exceeds file bounds.',NONFATAL); "UNSPLITBUFF;LKSINBUF,RBNUM); $IF IORESULT<>0 THEN GOTO 1; $IF BLKSREAD<>0 THEN &BEGIN (IF BLOCKWRITE(THEFILE,EBUF^,BLKSREAD,LBNUM)<>BLKS "CENTERCURSOR(TRASH,MIDDLE,TRUE); "EXIT(COPYFILE)  END;   PROCEDURE SPLITBUF; BEGIN DAY:=2; MONTH:=3; YEAR:=100 END; "MOVELEFT(D,FIBPA[56],2); "MOVELEFT(FIBPA,F,58)  END;   PROCEDURE SETLASTBLOCK(LASTREAD THEN GOTO 1; (IF IORESULT<>0 THEN GOTO 1 &END; $LBNUM:=LBNUM+BLKSREAD; $RBNUM:=RBNUM+BLKSREAD "UNTIL BLKSREAD=0; "SETBLOCK:INTEGER);  (* KLUDGE code to remove blocks from the end of the workfile *)  VAR FIBAREA:ARRAY [0..12] OF INTEGER; LASTBLOCK(2*(LPAGE+1+FLENGTH-RPAGE)); "(* Compensate for gap filled in *) "WITH PAGEZERO DO $BEGIN &FOR I:=0 TO COUNT-1 DO  BEGIN "MOVELEFT(THEFILE,FIBAREA,26); "FIBAREA[12]:=LASTBLOCK; "MOVELEFT(FIBAREA,THEFILE,26);  END;   BEGIN "OUT:=FALSE(IF PAGEN[I]>=RPAGE THEN PAGEN[I]:=PAGEN[I]-(RPAGE-LPAGE)+1; $END; "IF BLOCKWRITE(THEFILE,PAGEZERO,2,0)<>2 THEN GOTO 1; "OUT:; "REPEAT $CLEARSCREEN; (* Dumb terminal patch *) $SAVETOP:='>Quit:'; $WRITELN(SAVETOP); $WRITELN(' U(pdate the wor=TRUE; "WRITELN; "WRITELN('The workfile, ',WFNAME, *', is ',2*(LPAGE+1+FLENGTH-RPAGE),' blocks long.'); "IF LENGTH(BACKFNAMEkfile and leave'); $WRITELN(' E(xit (but workfile not updated)'); $WRITELN(' R(eturn to the editor without doing anyth)>0 THEN WRITE('The backup file is ',BACKFNAME); "CLOSE(THEFILE,LOCK); "GOTO 2;  1:ERROR('Writing out the file',FATAL);  NT-CURSOR+1; "LEFTPART:=CURSOR-1; "MOVERIGHT(EBUF^[CURSOR],EBUF^[THEREST],LMOVE)  END;   PROCEDURE PARSEFN;  VAR I,LPTR,R BEGIN "DONE:=BLOCKREAD(F,BUFR,2,PAGE+PAGE)<>2; "IF IORESULT<>0 THEN $BEGIN &ERROR('Bad disk transfer',NONFATAL); PTR,COMMA: INTEGER; $MARK: STRING;  BEGIN "LPTR:=POS('[',FN); "IF LPTR=0 THEN $BEGIN (* whole file *) &STARTMARK:=' &CURSOR:=LEFTPART+1; &UNSPLITBUF; &EXIT(COPYFILE) $END; "WRITE('.'); "IF NOT DONE THEN NOTNULLS:=SCAN(-1024,<>CHR(0),BUFR[ '; &STOPMARK:= ' ' $END "ELSE $BEGIN &RPTR:=POS(']',FN); &IF (RPTR=0) OR (RPTRLENGTH(FN)) THEN ER1023])+1024 "ELSE NOTNULLS:=0; "PAGE:=PAGE+1;  END;   PROCEDURE CHKOVFLW;  BEGIN "IF (STOPOFFSET>=NOTNULLS) AND (STOPPAGRMARKER; &MARK:=COPY(FN,LPTR+1,RPTR-LPTR-1); (* stuff between the brackets *) &FN:=COPY(FN,1,LPTR-1); &COMMA:=POS(',',MARK); EPZ.NAME[I]) DO I:=I+1; $IF MNAME<>PZ.N&FILLCHAR(STOPMARK[I],MAX(0,8-I),' ') $END; "FOR I:=0 TO 7 DO STARTMARK[I]:=UCLC(STARTMARK[I]); "FOR I:=0 TO 7 DO STOPMARK [AME[I] THEN &BEGIN (ERROR('Marker not there.',NONFATAL); (UNSPLITBUFF; (EXIT(COPYFILE) &END; $OFF:=PZ.POFFSET[I]; $PNUM:=I]:=UCLC(STOPMARK[I]); "FOR I:=1 TO LENGTH(FN) DO FN[I]:=UCLC(FN[I]); "IF ((POS('.TEXT',FN)<>LENGTH(FN)-4) OR %(LENGTH(FN)<=PZ.PAGEN[I]; $IF PNUM=0 THEN &BEGIN OFF:=OFF-1; PNUM:=1 END; (* Kludge to maintain compatibility *) "END; "  BEGIN(* findma4)) AND (FN[LENGTH(FN)]<>'.') THEN $FN:=CONCAT(FN,'.TEXT'); "IF FN[LENGTH(FN)]='.' THEN DELETE(FN,LENGTH(FN),1);  END;   Prkers *) "STARTPAGE:=1; STARTOFFSET:=0; (* default values *) "STOPPAGE:=32767; STOPOFFSET:=32767; ROCEDURE STUFFIT(START,STOP:INTEGER);  (* Put the contents of BUFR into EBUF. OVFLW is set to true when there is #no more roo"IF (STARTMARK<>' ') OR (STOPMARK<>' ') THEN $BEGIN &IF BLOCKREAD(F,PZ,2,0)<>2 THEN READERR; &IF STARTMARK<>' m in the buffer. *)  VAR AMOUNT: INTEGER;  BEGIN "IF START<=STOP THEN $BEGIN &AMOUNT:=STOP-START+1; &IF CURSOR+AMOUNT+250( ' THEN SEARCH(STARTMARK,STARTOFFSET,STARTPAGE); &IF STOPMARK<>' ' THEN SEARCH(STOPMARK,STOPOFFSET,STOPPAGE) $END (* Split the buffer at the Cursor. Therest points to the right part, Lmove #is the length of the right part, Leftpart points*slop*)>=THEREST THEN (BEGIN *ERROR('Buffer overflow.',NONFATAL); *CURSOR:=LEFTPART+1; *UNSPLITBUFF; *EXIT(COPYFILE) (END  to the end of the 'left #part', and Cursor remains unchanged. *)  BEGIN "THEREST:=BUFSIZE-(BUFCOUNT-CURSOR); "LMOVE:=BUFCOU&ELSE (BEGIN *MOVELEFT(BUFR[START],EBUF^[CURSOR],AMOUNT); *CURSOR:=CURSOR+AMOUNT (END $END  END;   PROCEDURE GETNEXT;  ; 52: T:='February'; 53: T:='March'; 54: T:='April'; 55: T:='May'; 56: T:='June'; 57: T:='July'; 58: T:='August'; 59: T:N; WRITE(' ') "END; "  PROCEDURE TABSET;  VAR "X,I,NUMTIMES: INTEGER; " "PROCEDURE SETIT(CH:CHAR); "(* Set the tabstop   END;   BEGIN "PROMPTLINE:=' Copy: From what file[marker,marker]? '; "REPEAT $PROMPT; $READLN(FN); $IF LENGTH(FN)=0 TH='September'; 510:T:='October'; 511:T:='November'; 512:T:='December' 4END; 4WRITE(T,' ',DAY); 2END; EN EXIT(COPYFILE); $PARSEFN; $RESET(F,FN); $PROMPTLINE:=' Copy: File not present. Filename? '; "UNTIL IORESULT=0; "PROMPTLI,WRITE(', ',YEAR+1900); *END; &END; "END;  "PROCEDURE ERASE10; "VAR I: INTEGER; "BEGIN $WRITE(' ':10); $FOR I:=1 TO 1NE:=' Copy'; PROMPT; "SPLITBUF; "FINDMARKERS; "PAGE:=STARTPAGE; "GETNEXT; "WHILE (STARTOFFSET>=NOTNULLS) AND NOT DONE DO $0 DO WRITE(CHR(BSPCE)); "END; " "PROCEDURE BOOL(B:BOOLEAN); "BEGIN $IF B THEN WRITE('True') ELSE WRITE('False'); $WRITELN BEGIN &CHKOVFLW; &STARTOFFSET:=STARTOFFSET-NOTNULLS; &GETNEXT; $END; "IF (STOPPAGE=PAGE) OR (STOPOFFGIN (WRITE('T or F'); (FOR TRASH:=0 TO 5 DO WRITE(CHR(BS)); (CH:=UCLC(GETCH) &END; $IF CH='T' THEN &BEGIN (WRITE('True 'SET>=NOTNULLS)) AND NOT DONE DO $BEGIN &CHKOVFLW; &GETNEXT; &IF (STOPPAGE0 THEN ERROR('Disk Error.',NONFATAL); "UNSPLITBUF; "CENTERCURSOR(TRASH,MIDDLE,TRUE); "CLOSE(F);  END;   (*$TE n v i r o n m e n t*)  SEGMENT PROCEDURE ENVIRONMENT;  VAR "I: INTEGER;  "PROCEDURE WRITEDATE(THEDATE:DATEREC); "(* Write out (in text) the date. Please note the restraint involved in %not putting in my birthday! (RSK) *) "VAR T: STRING; "BEGIN $WITH THEDATE DO &BEGIN (IF MONTH=0 THEN" "FUNCTION GETINT: INTEGER; "VAR $CH:CHAR; $N: INTEGER; "BEGIN $ERASE10; $N:=0; $REPEAT &REPEAT (CH:=GETCH; (IF NOT WRITE('NONE') (ELSE *BEGIN ,IF (MONTH=12) AND (DAY=25) THEN .WRITE('Christmas') ,ELSE .IF (MONTH=1) AND (DAY=1) THEN 0WR (CH IN ['0'..'9',CHR(SP),CHR(CR)]) *THEN WRITE('#',CHR(BELL),CHR(BS)); &UNTIL CH IN ['0'..'9',CHR(SP),CHR(CR)]; &IF CH IN [ITE('New Years') .ELSE 0IF (MONTH=10) AND (DAY=31) THEN 2WRITE('Halloween') 0ELSE 2BEGIN 4CASE MONTH OF 51: T:='January''0'..'9'] THEN (BEGIN *WRITE(CH); *IF N<1000 THEN N:=N*10+ORD(CH)-ORD('0') (END; $UNTIL CH IN [CHR(SP),CHR(CR)]; $GETINT:=    END;   PROCEDURE WRITEMENU;  BEGIN "WITH PAGEZERO DO $BEGIN &WRITELN; &WRITE( ' A(uto indent '); BOOL(AUTOIBEGIN "WITH PAGEZERO DO $BEGIN &CLEARSCREEN; &PROMPTLINE:= ' Environment: {options} to leave'; &PROMPT; NEEDPRONDENT); &WRITE( ' F(illing '); BOOL(FILLING); &WRITE( ' L(eft margin '); WRITELN(LMARGIN+1); &WRITE( MPT:=TRUE; &WRITEMENU; &WRITEINFO; &GOTOXY(LENGTH(PROMPTLINE),0); &REPEAT (CH:=UCLC(GETCH); (IF NOT (CH IN ['A','C','F','L ' R(ight margin '); WRITELN(RMARGIN+1); &WRITE( ' P(ara margin '); WRITELN(PARAMARGIN+1); ','P','R','S','T',' ',CHR(CR)]) (THEN *BEGIN ERROR('Not option',NONFATAL); PROMPT; END (ELSE *CASE CH OF +'A': BEGIN GOTOXY&WRITE( ' C(ommand ch '); WRITELN(RUNOFFCH); &WRITE( ' S(et tabstops '); WRITELN; &WRITE( ' T(ok(18,1); AUTOINDENT:=GETBOOL END; +'F': BEGIN GOTOXY(18,2); FILLING:=GETBOOL END; +'L': BEGIN GOTOXY(18,3); LMARGIN:=MAX(0,GETIaccording to the character passed *) "BEGIN $WITH PAGEZERO DO &CASE CH OF ('N','-': BEGIN CH:='-'; TABSTOP[X]:=NONE; END; (en def '); BOOL(TOKDEF); &WRITELN; &WRITELN(BUFCOUNT,' bytes used, ',BUFSIZE-BUFCOUNT+1,' available.'); &WRITELN('There ar'L': TABSTOP[X]:=LEFTJUST; ('R': TABSTOP[X]:=RIGHTJUST; ('D': TABSTOP[X]:=DECIMALSTOP &END; $WRITE(CH); "END; e ',LPAGE,' pages in the left stack, and ', /FLENGTH-RPAGE,' pages in the right stack.'); &WRITELN('You have ',RPAGE-LPAGE-1,'  BEGIN "WITH PAGEZERO DO $BEGIN &CLEARSCREEN; &WRITELN(  'Set tabs: C(ol# {N(o R(ight L(eft D(eci pages of room,', +' and at most ',(BUFCOUNT DIV 960)+1,' pages worth in the buffer.'); &WRITELN; $END;  END;   PROCEDURmal stop} ' &); &WRITELN; &FOR I:=0 TO SCREENWIDTH DO (CASE TABSTOP[I] OF *NONE: WRITE('-'); E WRITEINFO;  BEGIN "WITH PAGEZERO DO $BEGIN &IF SDEFINED OR TDEFINED THEN (BEGIN *WRITELN(' Patterns:'); *IF TDEFINED*LEFTJUST: WRITE('L'); *RIGHTJUST: WRITE('R'); *DECIMALSTOP: WRITE('D') (END; &X:=0; &GOTOXY(4,4); WRITE('Column #'); &RE THEN WRITE(' = ''',TARGET:TLENGTH,''''); *IF SDEFINED THEN WRITE(', = ''',SUBSTRING:SLENGTH,''''); *WRITPEAT (GOTOXY(12,4); WRITE(X+1:3); (GOTOXY(X,2); (CH:=UCLC(GETCH); (NUMTIMES:=GETNUM; (* Also sets COMMAND *) (IF CH IN ['N'ELN; WRITELN; (END; &IF COUNT>0 THEN WRITELN(' Markers:'); &WRITE(' '); &FOR I:=0 TO COUNT-1 DO (BEGIN *WRITE(' '); ,'D','L','R','-'] THEN SETIT(CH) (ELSE *IF CH='C' THEN ,BEGIN .GOTOXY(12,4); .X:=MAX(0,MIN(GETINT,SCREENWIDTH+1)-1); ,END *IF PAGEN[I]=-1 THEN ,WRITE(' ') *ELSE ,IF PAGEN[I]<=LPAGE THEN WRITE('<') ELSE WRITE('>'); *WRITE(NAME[I]); *ELSE ,IF COMMAND=LEFT THEN X:=MAX(0,X-NUMTIMES) ,ELSE .IF COMMAND=RIGHT THEN X:=MIN(X+NUMTIMES,SCREENWIDTH) .ELSE 0IF NOT*IF (I<>COUNT-1) AND ((I+1) MOD 5=0) THEN ,BEGIN WRITELN; WRITE(' ') END (END; &WRITELN; &WRITELN; &WRITE(' Created ') (CH IN [CHR(ETX),' ']) THEN WRITE(CHR(BELL)); &UNTIL CH=CHR(ETX); &CH:='$'; (* So we don't fall out all of the way! *) $END;; WRITEDATE(CREATED); &WRITE('; Last updated '); WRITEDATE(LASTUPD); &WRITE(' (Revision ',REVISION,').'); $END;  END;     BEGIN (* putsyntax *) "WITH USERINFO DO $BEGIN &OPENOLD(F,'*SYSTEM.SYNTAX'); &IF IORESULT<>0 THEN PUTNUM &ELSE (BEGIN *IEGIN "PROMPTLINE:=' Banish: To the L(eft or Right '; "PROMPT; NEEDPROMPT:=TRUE; "SHOWCURSOR; "REPEAT CH:=UCLC(GETCH) UF ERRNUM<=109 THEN BLK:=2 *ELSE ,IF ERRNUM<=131 THEN BLK:=4 ,ELSE .IF ERRNUM<=156 THEN BLK:=6 .ELSE 0IF ERRNUM<=254 THEN BNTIL CH IN ['L','R',CHR(ESC)]; "IF CH<>CHR(ESC) THEN BEGIN GOTOXY(7,0); ERASETOEOL(7,0) END; "IF CH='L' THEN $PUTPAGES(LEFTSTLK:=8 0ELSE BLK:=10; *IF BLOCKREAD(F,BUF,2,BLK)<>2 THEN PUTNUM *ELSE ,BEGIN .IF BUF[0]=CHR(DLE) THEN PTR:=2 ELSE PTR:=0; .ACK) "ELSE $IF CH='R' THEN &PUTPAGES(RIGHTSTACK); "IF CH<>CHR(ESC) THEN CENTERCURSOR(TRASH,MIDDLE,TRUE); "NEXTCOMMAND  ENDD0:=ERRNUM DIV 100; (* convert error number to characters *) .D1:=(ERRNUM-D0*100) DIV 10; .D2:=ERRNUM MOD 10; ;   PROCEDURE NEXT;  VAR "CH: CHAR;  BEGIN "PROMPTLINE:=  ' Next: F(orwards, B(ackwards in the file; S(tart, E(nd of the.T[0]:=CHR(D0+ORD('0')); T[1]:=CHR(D1+ORD('0')); .T[2]:=CHR(D2+ORD('0')); .REPEAT 0FILLCHAR(C,3,'0'); 0COLON:=SCAN(MAXCHAR, file. '; "PROMPT; NEEDPROMPT:=TRUE; "SHOWCURSOR; "REPEAT CH:=UCLC(GETCH) UNTIL CH IN ['F','B','S','E',CHR(ESC)]; "IF =':',BUF[PTR]); 0MOVELEFT(BUF[PTR],C[3-COLON],COLON); 0COLON:=COLON+PTR; 0PTR:=SCAN(MAXCHAR,=CHR(EOL),BUF[PTR])+PTR+3 .UNTILCH<>CHR(ESC) THEN BEGIN GOTOXY(5,0); ERASETOEOL(5,0) END; "IF CH='F' THEN $BEGIN &PUTPAGES(LEFTSTACK); &GETPAGES(RIGHTSTACK) (T=C) OR (BUF[PTR]=CHR(0)); .IF BUF[PTR]=CHR(0) THEN PUTNUM .ELSE 0BEGIN 2MOVELEFT(BUF[COLON+1],MSG[1],(PTR-COLON)-4); 2MS $END "ELSE $IF CH='B' THEN &BEGIN (PUTPAGES(RIGHTSTACK); (GETPAGES(LEFTSTACK) &END $ELSE &IF CH='S' THEN (BEGIN NT-1) END; +'R': BEGIN GOTOXY(18,4); RMARGIN:=MAX(0,GETINT-1) END; +'P': BEGIN GOTOXY(18,5); PARAMARGIN:=MAX(0,GETINT-1) END; G[0]:=CHR(MIN(68,(PTR-COLON)-4)); (* R- required *) 2HOME; CLEARLINE(0); WRITE(MSG,'. Type '); 0END ,END *END(* if iore+'C': BEGIN GOTOXY(18,6); READ(RUNOFFCH) END; +'S': BEGIN 2TABSET; (* New Screen Displayed *) 2CLEARSCREEN; 2PROMPT; sult<>0 *); (SHOWCURSOR; (REPEAT UNTIL GETCH=' '; (ERRBLK:=0; ERRSYM:=0; ERRNUM:=0; (* Only yell once!!! *) &END(* with use2WRITEMENU; 2WRITEINFO; 2GOTOXY(LENGTH(PROMPTLINE),0) 0END; +'T': BEGIN GOTOXY(18,8); TOKDEF:=GETBOOL END *END; (GOTOXY(Lrinfo *)  END(* putsyntax *); "   (*$TE d i t c o r e - Basic Commands*)   SEGMENT PROCEDURE EDITCORE;   (* Core prENGTH(PROMPTLINE),0); &UNTIL CH IN [' ',CHR(CR)]; &REDISPLAY; $END;  END;     (*$TP u t s y n t a x*)  SEGMENT PROCEocedures. Execute these commands until either a set environment #comes along or a quit command. *) #    PROCEDURE NEXTCODURE PUTSYNTAX;  VAR "D0,D1,D2,BLK,PTR,COLON: INTEGER; "T,C:PACKED ARRAY [0..2] OF CHAR; "BUF:PACKED ARRAY [0..1023] OF CHARMMAND; FORWARD;   PROCEDURE FIXDIRECTION;  BEGIN "IF COMMAND=FORWARDC THEN DIRECTION:='>' ELSE DIRECTION:='<'; ; "F: FILE;   PROCEDURE PUTNUM;  BEGIN "MSG:='Syntax Error #'; PUTMSG; "WRITE(USERINFO.ERRNUM,'. Type ');  END;  "HOME; WRITE(DIRECTION); (* Update prompt line *) "SHOWCURSOR; NEXTCOMMAND  END;   PROCEDURE BANISH;  VAR !CH: CHAR;  B  H,MIDDLE,TRUE); "NEXTCOMMAND  END;   PROCEDURE COPY;  BEGIN "PROMPTLINE:=' Copy: B(uffer F(rom file '; "PROMPT; N&IF PAGEN[I]<=LPAGE THEN (WHILE (LPAGE>0) AND (PAGEN[I]<>-1) DO *BEGIN ,GOTOXY(7,0); ERASETOEOL(7,0); ,CURSOR:=1; ,PUTPAGEEEDPROMPT:=TRUE; "REPEAT $CH:=UCLC(GETCH); "UNTIL CH IN ['B','F',CHR(ESC)]; "IF CH='B' THEN $BEGIN &IF NOT COPYOK OR ((BUFS(RIGHTSTACK); ,GETPAGES(LEFTSTACK) *END &ELSE (WHILE (RPAGE-1) DO *BEGIN ,GOTOXY(7,0); ERASETOEOCOUNT+COPYLENGTH+10>COPYSTART) 8AND (COPYSTART>=BUFCOUNT)) (THEN ERROR('Invalid copy.',NONFATAL) (ELSE *IF BUFCOUNT+COPYLENGL(7,0); ,CURSOR:=BUFCOUNT-1; ,PUTPAGES(LEFTSTACK); ,GETPAGES(RIGHTSTACK) *END $END  END;   BEGIN "MUSTREDISP:=FALSE; TH>=BUFSIZE THEN ERROR('No room',NONFATAL) *ELSE ,BEGIN .IF COPYLINE THEN 0BEGIN 2GETLEADING; 2CURSOR:=LINESTART 0END; ."WITH PAGEZERO DO $BEGIN &GETNAME('Jump to',MNAME); &IF MNAME<>' ' THEN (BEGIN *I:=0; *WHILE (IMOVERIGHT(EBUF^[CURSOR],EBUF^[CURSOR+COPYLENGTH],BUFCOUNT-CURSOR+1); .IF (COPYSTART>=CURSOR) AND (COPYSTARTNAME[I] THEN ,ERROR('Not there.',NONFATAL) *ELSE ,BEGIN .(* If text pointed to isn't in the 0MOVELEFT(EBUF^[COPYSTART+COPYLENGTH],EBUF^[CURSOR],COPYLENGTH) .ELSE 0MOVELEFT(EBUF^[COPYSTART],EBUF^[CURSOR],COPYLENGTH); buffer, load it in *) .IF PAGEN[I]<>-1 THEN SHUFFLE; .IF PAGEN[I]<>-1 THEN ERROR('Marker all messed up.',NONFATAL) .ELSE 0CU.BUFCOUNT:=BUFCOUNT+COPYLENGTH; .READJUST(CURSOR,COPYLENGTH); .CHECKINDENT(CURSOR); (* Check the border for two DLE's *) RSOR:=POFFSET[I]; .GETLEADING; .CURSOR:=MAX(CURSOR,STUFFSTART); .CENTERCURSOR(TRASH,MIDDLE,MUSTREDISP) ,END; (END; $END; .LASTPAT:=CURSOR; (* For equalc *) .CURSOR:=CURSOR+COPYLENGTH; .CHECKINDENT(CURSOR); (* ... and also check the othe END; (* jumpmarker *)   BEGIN (* jump *) "PROMPTLINE:=' JUMP: B(eginning E(nd M(arker '; "PROMPT; r border *) .GETLEADING; .CURSOR:=MAX(CURSOR,STUFFSTART); .CENTERCURSOR(TRASH,MIDDLE,TRUE) ,END; $END (* CH='B' *) "ELSE "NEEDPROMPT:=TRUE; (* Need to redisplay EDIT: promptline! *) "REPEAT $CH:=UCLC(GETCH); $IF CH='B' THEN &BEGIN (CURSOR:=1$IF CH='F' THEN EXIT(EDITCORE); "SHOWCURSOR; "NEXTCOMMAND;  END(*COPY*);   PROCEDURE DUMP;  BEGIN "NEXTCOMMAND;  END(* ; (GETLEADING; (CURSOR:=STUFFSTART; (CENTERCURSOR(TRASH,1,FALSE) &END $ELSE &IF CH='E' THEN (BEGIN *CURSOR:=BUFCOUNT-1; *WHILE LPAGE>0 DO ,BEGIN .GOTOXY(5,0); ERASETOEOL(5,0); .CURSOR:=1; .PUTPAGES(RIGHTSTACK); .GETPAGES(LEFTSTACK) ,END; *CDUMP *);   PROCEDURE FIND; FORWARD;   PROCEDURE INSERTIT; FORWARD;   PROCEDURE JUMP;  VAR CH: CHAR;   PROCEDURE JUMURSOR:=1 (END &ELSE (IF CH='E' THEN *BEGIN ,WHILE RPAGECHR(ESC) THEN CENTERCURSOR(TRASust redisplay the screen *) "MUSTREDISP:=TRUE; "WITH PAGEZERO DO $BEGIN &CLEARLINE(0); &WRITE('Leaping');  *CENTERCURSOR(TRASH,SCREENHEIGHT-1,FALSE); (END &ELSE (IF CH='M' THEN JUMPMARKER (ELSE IF CH<>CHR(ESC) THEN ERRWAIT; "UNTI* SETSTUFF *);   PROCEDURE VERIFY;  BEGIN "CENTERCURSOR(TRASH,MIDDLE,TRUE); "SHOWCURSOR; "NEXTCOMMAND L (CH IN ['B','E','M',CHR(ESC)]); "NEXTCOMMAND;  END;   PROCEDURE DEFMACRO;  BEGIN "WITH PAGEZERO DO IF FILLING AND NOT A END (* VERIFY *);   PROCEDURE XMACRO;  VAR "SAVEC,I: INTEGER; "SAVE:PACKED ARRAY [0..MAXSTRING] OF CHAR;  BEGIN "PROMPUTOINDENT THEN $BEGIN &BLANKCRT(1); &THEFIXER(CURSOR,REPEATFACTOR,TRUE); &CENTERCURSOR(TRASH,MIDDLE,TRUE); $END "ELSE ERROTLINE:=' eXchange: TEXT { a char} [ escapes; accepts]'; "PROMPT; NEEDPROMPT:=TRUE; "SHOWCURSOR; "SAVEC:=CURSORR('Inappropriate environment',NONFATAL); "COPYOK:=FALSE; "SHOWCURSOR; "NEXTCOMMAND;  END;   PROCEDURE SETMARKER;  LABEL ; "I:=0; "REPEAT $CH:=GETCH; $IF MAPTOCOMMAND(CH)=LEFT THEN &BEGIN (IF (CURSOR>SAVEC) THEN *BEGIN ,I:=I-1; CURSOR:=CURSO1;  VAR "I,SLOT: INTEGER; "MNAME: PACKED ARRAY [0..7] OF CHAR;  BEGIN "WITH PAGEZERO DO $BEGIN &NEEDPROMPT:=TRUE; &COUNTR-1; (* Decrement both ptrs *) ,EBUF^[CURSOR]:=SAVE[I]; (* Restore buffer *) ,WRITE(CHR(BSPCE),EBUF^[CURSOR],CHR(BSPCE)); *EN:=MIN(20,COUNT); &IF COUNT=20 THEN (BEGIN *BLANKCRT(1); *FOR I:=0 TO COUNT-1 DO ,BEGIN D &END $ELSE &IF CH=CHR(EOL) THEN BEGIN ERRWAIT; SHOWCURSOR END &ELSE (IF NOT (CH IN [CHR(ETX),CHR(ESC)]) AND (EBUF^[CURSOR.WRITE(CHR(ORD('a')+I),') ',NAME[I],' '); .IF (I+1) MOD 4 = 0 THEN WRITELN; ,END; *MSG:= $'Marker overflow. Which one to]<>CHR(EOL)) THEN *BEGIN ,IF NOT (CH IN [' '..'~']) THEN CH:='?'; ,SAVE[I]:=EBUF^[CURSOR]; ,EBUF^[CURSOR]:=CH; ,I:=I+1; CUR replace? (Type in the letter or ) '; *PUTMSG; CH:=UCLC(GETCH); *CENTERCURSOR(TRASH,MIDDLE,TRUE); *IF CH IN ['A'..'T'] THSOR:=CURSOR+1; ,WRITE(CH) *END; "UNTIL CH IN [CHR(ETX),CHR(ESC)]; "IF CH=CHR(ESC) THEN $BEGIN &CURSOR:=SAVEC; &MOVELEFT(SEN SLOT:=ORD(CH)-ORD('A') *ELSE ,GOTO 1; (END &ELSE (SLOT:=COUNT; &GETNAME('Set',MNAME); &IF MNAME<>' ' THEN (BEGAVE[0],EBUF^[CURSOR],I); &SHOWCURSOR; WRITE(SAVE:I); SHOWCURSOR $END; "NEXTCOMMAND;  END (* XMACRO *);  IN *FOR I:=0 TO COUNT-1 DO ,IF NAME[I]=MNAME THEN SLOT:=I; *NAME[SLOT]:=MNAME; *POFFSET[SLOT]:=CURSOR; *PAGEN[SLOT]:=-1; * PROCEDURE ZAPIT;  BEGIN "IF ABS(LASTPAT-CURSOR)>80 THEN $BEGIN &PROMPTLINE:=  ' WARNING! You are about to zap more than IF SLOT=COUNT THEN COUNT:=COUNT+1 (END; $END;  1:END;   PROCEDURE SETSTUFF;  VAR CH: CHAR;  BEGIN "PROMPTLINE:=' Set: E80 chars, do you wish to zap? (y/n)'; &PROMPT; &NEEDPROMPT:=TRUE; &IF UCLC(GETCH)<>'Y' THEN (BEGIN *SHOWCURSOR; *NEXTCOMMA(nvironment M(arker '; "PROMPT; NEEDPROMPT:=TRUE; "REPEAT $CH:=UCLC(GETCH); $IF CH='E' THEN EXIT(EDITCORE) $ELSE &IF ND; *EXIT(ZAPIT) (END; $END; "IF OKTODEL(MIN(CURSOR,LASTPAT),MAX(CURSOR,LASTPAT)) THEN $BEGIN ©LINE:=FALSE; &READJUSTCH='M' THEN SETMARKER &ELSE IF CH<>CHR(ESC) THEN ERRWAIT; "UNTIL CH IN ['E','M',CHR(ESC)]; "SHOWCURSOR; "NEXTCOMMAND;  END((MIN(CURSOR,LASTPAT),-ABS(CURSOR-LASTPAT)); &IF CURSOR>LASTPAT THEN (MOVELEFT(EBUF^[CURSOR],EBUF^[LASTPAT],BUFCOUNT-CURSOR) & NG; "THEREST:=BUFSIZE-(BUFCOUNT-CURSOR); "LMOVE:=BUFCOUNT-CURSOR+1; "MOVERIGHT(EBUF^[CURSOR],EBUF^[THEREST],LMOVE); "GETLEAD is not in legal %range then CHECK is false. This function also warns the user if %s/he is getting too close to overflowing tING; (* Set blanks *) "IF THEREST-CURSOR=THEREST-MAXCHAR THEN &BEGIN (IF NOT WARNED THEN *BEGIN ,ELSE 2);  END;   PROCEDURE WRAPUP;  (* Given the new value of the cursor (one past the last valid character #inserted into the buffer), put back together the two halves of the #buffer. Then, to polish it off, update the screen so that the rest of #the editor can cope *)  VAR PTR: PTRTYPE; $LNGTH: INTEGER;  BEGIN "WITH PAGEZERO DO $IF NOTEXTYET AND (NOT FIRSTLINE) AND '((NOT FILLING) OR AUTOINDENT) AND (CH<>CHR(ESC)) $THEN (* We want the blanks before THEREST *) &BEGIN (BUFCOUNT:=BUFCOUNT+2; (MOVELEFT(EBUF^[LASTPAT],EBUF^[CURSOR],BUFCOUNT-LASTPAT); &BUFCOUNT:=BUFCOUNT-ABS(CURSOR-LASTPAT); &CURSOR:=LASTPAT; &CENTER(THEREST:=THEREST-2; LMOVE:=LMOVE+2; (CURSOR:=SCAN(-MAXCHAR,=CHR(EOL),EBUF^[CURSOR-1])+CURSOR; &END; "MOVELEFT(EBUF^[THERESTCURSOR(TRASH,MIDDLE,TRUE); $END; "SHOWCURSOR; "NEXTCOMMAND;  END;   (*$TI n s e r t C o m m a n d*)   PROCEDURE INSE],EBUF^[CURSOR],LMOVE); "READJUST(LEFTPART+1,CURSOR-(LEFTPART+1)); "BUFCOUNT:=BUFCOUNT+CURSOR-(LEFTPART+1); "WITH PAGEZERO DRTIT;  CONST "FUDGEFACTOR=10;  VAR "THEREST,LEFTPART,SAVEBUFCOUNT: PTRTYPE; "CLEARED,WARNED,OK,NOTEXTYET,EXITPROMPT,FIRSTLIO $IF FILLING AND NOT AUTOINDENT AND (CH=CHR(ETX)) THEN NE: BOOLEAN; "SPACES,LMOVE,X,LINE,EOLDIST,RJUST: INTEGER; "CONTEXT: PACKED ARRAY [0..MAXSTRING] OF CHAR;   PROCEDURE SLAMRI&BEGIN THEFIXER(CURSOR,1,FALSE); FIRSTLINE:=FALSE; FINDXY(X,LINE) END; "UPSCREEN(FIRSTLINE,EXITPROMPT OR (CH=CHR(ESC)),LINE); GHT;  (* Move (slam) the portion of the EBUF^ to the right of (and including) #the cursor so that the last NUL in the file (EB"GETLEADING; "CURSOR:=MAX(CURSOR,STUFFSTART); "LASTPAT:=LEFTPART+1; "COPYOK:=TRUE; COPYSTART:=LASTPAT; COPYLENGTH:=CURSOR-LAUF^[BUFCOUNT]) is now at #EBUF^[BUFSIZE]. THEREST points to the beginning of the right-justified #text. *)  BEGIN "GETLEADISTPAT; "NEXTCOMMAND  END;   FUNCTION CHECK(VALUE:INTEGER): BOOLEAN; "(* VALUE is the potential value of the cursor. If it y the appropriate number of spaces for the #indentation. *)  BEGIN "WITH PAGEZERO DO $BEGIN &IF NOTEXTYET THEN FIXUP; &EBU put in # as it stands *) $MOVELEFT(EBUF^[STUFFSTART],EBUF^[LINESTART+2],CURSOR-STUFFSTART) "ELSE $IF CHECK(CURSOR+2-BYF^[CURSOR]:=CHR(EOL); &IF AUTOINDENT THEN GETLEADING &ELSE (IF FILLING THEN *BEGIN ,GETLEADING; ,IF EBUF^[STUFFSTART]=CHR(TES) THEN &MOVERIGHT(EBUF^[STUFFSTART],EBUF^[STUFFSTART+2-BYTES],CURSOR-STUFFSTART) $ELSE BEGIN OK:=FALSE; EXIT(FIXUP) END; "EOL) THEN (* Empty line *) .BLANKS:=PARAMARGIN ,ELSE BLANKS:=LMARGIN *END (ELSE BLANKS:=0; CURSOR:=CURSOR-(BYTES-2); "EBUF^[LINESTART]:=CHR(DLE); EBUF^[LINESTART+1]:=CHR(32+BLANKS);  END;   PROCEDURE INSERTCH; "(*&IF CHECK(CURSOR+BLANKS+1) THEN (BEGIN *FILLCHAR(EBUF^[CURSOR+1],BLANKS,' '); *CURSOR:=CURSOR+BLANKS+1 (END; &NOTEXTYET:=T This procedure inserts a single character into the buffer. It also %handles all of the control codes (EOL,BS,DEL) and buffer oRUE; $END;  END;   PROCEDURE BACKUP;  (* If the CH is a backspace then decrement cursor by 1. If this would #result in bver- and %under- flow conditions. INSERTCH is called by the CRT handler *)  BEGIN "REPEAT "OK:=TRUE; (* No errors that invaacking over an or a blank compression code, then fall #into the code for a (also changing the CH to for commulidate the current character have occured *) "CH:=GETCH; "IF MAPTOCOMMAND(CH)=LEFT THEN CH:=CHR(BS); ERROR('Please finish up the insertion',NONFATAL); PROMPT; ,GOTOXY(X,LINE); ,WARNED:=TRUE *END; (IF VALUE>THEREST-FUDGEFACTORnication #to the outer block) *)  VAR PTR: PTRTYPE;  BEGIN "IF CH=CHR(DC1) THEN $BEGIN GETLEADING; IF CHECK(LINESTART) THE THEN *BEGIN ,ERROR('Buffer Overflow!!!!',NONFATAL); ,WRAPUP; ,EXIT(INSERTIT); *END &END  END;  N CURSOR:=LINESTART END "ELSE $IF (CH=CHR(BS)) AND 'NOT( (EBUF^[CURSOR-2]=CHR(DLE)) OR (EBUF^[CURSOR-1]=CHR(EOL)) ) THEN &BE PROCEDURE SPACEOVER;  (* This procedure handles spaces and tabs inserted into the buffer *)  VAR NEWX: INTEGER;  BEGIN "IFGIN (IF CURSOR or equivalent *) (CH:=CHR(DEL) CH=CHR(HT) THEN $BEGIN &NEWX:=X+1; &WITH PAGEZERO DO (WHILE (TABSTOP[NEWX]=NONE) AND (NEWX into #the buffer followed b First compress the current line *) "EBUF^[CURSOR]:=CHR(EOL); (* Fool Getleading *) "GETLEADING; "IF BYTES >= 2 THEN (* OK to UNTIL OK;  END;   PROCEDURE POPDOWN;  (* Displays CONTEXT, doing an implied scrollup if nec. *)  BEGIN "IF CLEARED THEN EEZERO DO IF WLENGTH>=RMARGIN-LMARGIN THEN $BEGIN &WRITESP(CH,1); &EXIT(POPOV) $END; "IF CH='-' THEN WRITE('-'); "GOTOXY(X-RASETOEOL(X,LINE) "ELSE BEGIN CLEARED:=TRUE; ERASEOS(X,LINE) END; "GOTOXY(RJUST,LINE); "ERASETOEOL(RJUST,LINE); "WRITE(CHR(LWLENGTH+1,LINE); "ERASETOEOL(X-WLENGTH+1,LINE); "MOVERIGHT(EBUF^[PTR],EBUF^[PTR+3],WLENGTH); "MOVELEFT(EBUF^[PTR+3],WORD,WLENF)); "IF LINE=SCREENHEIGHT THEN BEGIN EXITPROMPT:=TRUE; LINE:=SCREENHEIGHT-1 END; "WRITE(CONTEXT:EOLDIST); "FIRSTLINE:=FALSE;GTH); "CURSOR:=CURSOR+3; "EBUF^[PTR]:=CHR(EOL); "EBUF^[PTR+1]:=CHR(DLE); "WITH PAGEZERO DO IF AUTOINDENT THEN $BEGIN &SAVE (* Says that the whole screen has been affected. *)  END;   PROCEDURE WRITESP(CH:CHAR;HOWMANY:INTEGER);  BEGIN :=CURSOR; (* Set blanks to the indentation of the line above *) &CURSOR:=PTR; &GETLEADING; &CURSOR:=SAVE $END "ELSE $BLANK"IF X+HOWMANY<=SCREENWIDTH THEN WRITE(CH:HOWMANY); "IF X+HOWMANY>=SCREENWIDTH THEN $BEGIN &GOTOXY(SCREENWIDTH,LINE); &IF X+S:=LMARGIN; "EBUF^[PTR+2]:=CHR(BLANKS+32); "CLEANSCREEN; "X:=BLANKS; "GOTOXY(X,LINE); WRITE(WORD:WLENGTH); "X:=X+WLENGTH; HOWMANY>SCREENWIDTH THEN (BEGIN WRITE('!'); GOTOXY(SCREENWIDTH,LINE) END $END; "X:=MIN(SCREENWIDTH,X+HOWMANY)  END;   PRO"NOTEXTYET:=FALSE  END;   BEGIN (* INSERT *) "CLEARED:=FALSE; "EOLDIST:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[CURSOR]); "MOVELEFT(CEDURE CLEANSCREEN;  (* Code to, if possible, only erase the line, otherwise clear #the screen. Then call popdown *)  BEGIN EBUF^[CURSOR],CONTEXT[0],EOLDIST); "RJUST:=SCREENWIDTH-EOLDIST; "SLAMRIGHT; "SAVEBUFCOUNT:=BUFCOUNT; "PROMPTLINE:= "FIRSTLINE:=FALSE; "IF CLEARED THEN $BEGIN &IF X a char, a line} [ accepts, escapes]'; "PROMPT; "EXITPROMPT:=FALSE; NEEDPROMPT:=TRUE; RASEOS(X,LINE); $END; "LINE:=LINE+1; "IF LINE>SCREENHEIGHT THEN $BEGIN &LINE:=LINE-1; &WRITELN; &EXITPROMPT:=TRUE $END; "LEFTPART:=CURSOR-1; "NOTEXTYET:=FALSE; "FINDXY(X,LINE); GOTOXY(X,LINE); "ERASETOEOL(X,LINE); "FIRSTLINE:=TRUE; "IF EOLDI"IF ORD(CH) IN [SP,HT,EOL,BS,DEL,ETX,ESC,DC1] THEN $BEGIN &(* and are handled in the body of insertit *) &IF ORD"IF EOLDIST<>0 THEN POPDOWN  END;   PROCEDURE POPOV;  (* When in filling mode, this procedure is called when a line is ove(CH) IN [SP,HT] THEN SPACEOVER &ELSE (IF ORD(CH)=EOL THEN ENDLINE (ELSE *IF ORD(CH) IN [DC1,BS,DEL] THEN BACKUP; $END "ELSrflowed #(X >= rightmargin). The word is scanned off and "popped" down to the #next line. *)  VAR "WLENGTH: INTEGER; "SAVE $BEGIN (* A character to insert! *) &IF (CH<'!') OR (CH>'~') THEN CH:='?'; (* No non-printing characters *) &IF NOTEXTYET TE,PTR: PTRTYPE; "WORD: PACKED ARRAY [0..MAXSW] OF CHAR;  BEGIN "IF NOTEXTYET THEN FIXUP; HEN FIXUP; &IF CHECK(CURSOR+1) AND OK THEN (BEGIN *NOTEXTYET:=FALSE; *EBUF^[CURSOR]:=CH; *CURSOR:=CURSOR+1 (END; $END; !"PTR:=MAX(SCAN(-MAXCHAR,='-',EBUF^[CURSOR-1]), +SCAN(-MAXCHAR,=' ',EBUF^[CURSOR-1]))+CURSOR; "WLENGTH:=CURSOR-PTR; "WITH PAG Y(RJUST,LINE); WRITE(CONTEXT:EOLDIST); GOTOXY(X,LINE) &END $ELSE (* and it won't fit on the current line *) &BEGIN (FIRSTLI"IF CH=CHR(ESC) THEN CURSOR:=LEFTPART+1; "BUFCOUNT:=SAVEBUFCOUNT; "WRAPUP;  END;   (*$TM o v e i t - Cursor Movement,NE:=FALSE; (ERASEOS(X,LINE);(* Clear the screen *) (WRITELN; (IF LINE=SCREENHEIGHT THEN *BEGIN LINE:=SCREENHEIGHT-1; EXITPRO Page, Adjust, Delete *)   PROCEDURE MOVEIT;  VAR "SCROLLMARK,X,LINE,I: INTEGER; "EXITPROMPT: BOOLEAN; (* PROMPT AFTER LEAMPT:=TRUE END; (GOTOXY(RJUST,LINE+1); WRITE(CONTEXT:EOLDIST); GOTOXY(X,LINE) &END; "REPEAT $INSERTCH; $IF NOT (ORD(CH) IN [VING MOVEIT! *) "OLDLINE,OLDX: INTEGER; "NEWDIST,DIST: INTEGER; "DOFFSCREEN,ATEND,INREPLACE,INDELETE: BOOLEAN; "PTR,ANCHOR,OEOL,ETX,ESC,DEL,DC1]) THEN &BEGIN (IF TRANSLATE[CH]=LEFT THEN *BEGIN IF X<=SCREENWIDTH THEN WRITE(CHR(BSPCE),' ',CHR(BSPCE));LDCURSOR: PTRTYPE;   PROCEDURE SCROLLUP(BOTTOMLINE:PTRTYPE; HOWMANY: INTEGER);  (* bottomline is the "linestart" of the lin X:=X-1 END (ELSE *IF CH=CHR(HT) THEN WRITESP(' ',SPACES) *ELSE e to be scrolled up *)  VAR "PTR: PTRTYPE; "I: INTEGER;  BEGIN "(* DISPLAY THE NEXT LINE ON THE BOTTOM OF THE SCREEN *) "I,IF PAGEZERO.FILLING AND (X+1>=PAGEZERO.RMARGIN) THEN POPOV ,ELSE WRITESP(CH,1); (IF NOT PAGEZERO.FILLING AND (X=SCREENWIDTH-:=0; "PTR:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[LINE1PTR])+LINE1PTR+1; "WHILE (ICHR(BS)) *THEN WRITE(CHR(BELL)); (IF (EOLDIST<>0) AND +(X>=RJUST) AND FIRSTLINE THEN (*ran into context *) *BEGR; PTR:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[PTR])+PTR+1; &I:=I+1 $END; "I:=0; "GOTOXY(0,SCREENHEIGHT); "REPEAT $I:=I+1; $BLANKS:IN ,POPDOWN; ,GOTOXY(X,LINE) *END; &END $ELSE (* ch in [eol,etx,esc,del,dc1] *) &BEGIN (IF CH=CHR(EOL) THEN *BEGIN ,CLE=LEADBLANKS(BOTTOMLINE,BYTES); $WRITE(CHR(LF)); $LINEOUT(BOTTOMLINE,BYTES,BLANKS,SCREENHEIGHT); $LINE:=LINE-1; ANSCREEN; ,X:=BLANKS; ,GOTOXY(X,LINE); *END (ELSE *IF CH=CHR(DEL) THEN ,BEGIN .IF LINE<=1 THEN (* Rubbed out all of what"UNTIL (I>=HOWMANY) OR (BOTTOMLINE>=BUFCOUNT-1); "EXITPROMPT:=TRUE;  END(* SCROLLUP *);   PROCEDURE CLEAR(X1,Y1,X2,Y2: INT was on the screen *) 0BEGIN 2BUFCOUNT:=CURSOR+1; 2EBUF^[CURSOR]:=CHR(EOL); 2CENTERCURSOR(LINE,MIDDLE,TRUE); 2IF EOLDIST<>0EGER); FORWARD;   PROCEDURE CENTER;  BEGIN "IF INDELETE THEN $BEGIN &IF LINE>=SCREENHEIGHT THEN (BEGIN *CENTERCURSOR(LI THEN POPDOWN; 2IF EXITPROMPT THEN BEGIN PROMPT; EXITPROMPT:=FALSE END 0END .ELSE 0BEGIN GOTOXY(0,LINE); CLEARED:=FALSE; 6ENE,2,TRUE); *IF ABS(CURSOR-ANCHOR) > ABS(DIST) THEN CLEAR(0,1,MAX(X-1,0),LINE) (END &ELSE (BEGIN *CENTERCURSOR(LINE,SCREENHRASETOEOL(0,LINE); LINE:=LINE-1 END; .GETLEADING; .X:=BLANKS-BYTES+CURSOR-LINESTART; .GOTOXY(X,LINE) ,END *ELSE ,IF CH=CHREIGHT-1,TRUE); *GOTOXY(X,LINE); *IF ABS(CURSOR-ANCHOR) > ABS(DIST) THEN WRITE(CHR(11)) (END; &DOFFSCREEN:=TRUE; $END "ELSEST<>0 THEN (* A context needs to be displayed *) $IF RJUST>X THEN (* and it will fit on the current line ... *) &BEGIN (GOTOX(DC1) THEN .BEGIN 0X:=0; GOTOXY(X,LINE); ERASETOEOL(X,LINE) .END; &END; "UNTIL CH IN [CHR(ETX),CHR(ESC)];  ) DO $BEGIN &REPEATFACTOR:=REPEATFACTOR-(CURSOR-STUFFSTART+1); (* CHARS MOVED OVER *) &IF EBUF^[CURSOR]=CHR(EOL) THEN CURSOR:%on that line, or the end of the text on that line *) "CURSOR:= +MAX(1, (* The beginning of the buffer *) /MAX(STUFFSTAR=CURSOR-1; &CURSOR:=MAX(SCAN(-MAXCHAR,=CHR(EOL),EBUF^[CURSOR])+CURSOR,1); &LINE:=LINE-1; &GETLEADING; (* RESET LINESTART AND  $IF (COMMAND=PARAC) AND ((DIRECTION='<') OR (LINE MOD SCREENHEIGHT=OLDLINE)) &THEN CENTERCURSOR(LINE,OLDLINE,TRUE) &ELSE CENT, (* The beginning of the text *) 3MIN(X-BLANKS+BYTES+LINESTART, (* same col *) 7SCAN(MAXCHAR,=CHR(EOL),EBUF^[CURSOR])+CURSOTERCURSOR(LINE,MIDDLE,TRUE); "IF EXITPROMPT AND (COMMAND<>QUITC) THEN $BEGIN &PROMPT; EXITPROMPT:=FALSE $END; "OLDLINE:=LINR (* eol *) 6) 3) /); "IF LINE<1 THEN CENTER;  END(* UPALINE *);   PROCEDURE DOWNMOVE;  VAR "I: INTEGER; "NEXTEOL: PE; OLDX:=X;  END;   PROCEDURE UPMOVE;  VAR I:INTEGER;  BEGIN "I:=1; "GETLEADING; "(* FIND THE LINE FIRST *) "WHILE (I<TRTYPE;  BEGIN "I:=1; "NEXTEOL:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[CURSOR])+CURSOR; "WHILE (NEXTEOL1) DO $BEGIN &CURSOR:=LINESTART-1; (* LAST CHAR OF LINE ABOVE *) &GETLEADING; OR) DO $BEGIN &CURSOR:=NEXTEOL+1; &NEXTEOL:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[CURSOR])+CURSOR; &IF NEXTEOLSCREENHEIGH the beginning of the buffer, the beginning of text T THEN $IF (LINE-SCREENHEIGHT>=SCREENHEIGHT) OR (INDELETE) THEN &CENTER $ELSE &SCROLLUP(SCROLLMARK,LINE-SCREENHEIGHT); "GETLEADING; "(* If possible set the cursor at the same x coord we came from. Otherwise, %set it either to the end of the buffer, the beginning of text %on that line, or the end of the text on that line *) "CURSOR:=MIN(BUFCOUNT-1, (* End of the buffer *) 1MAX(STUFFSTART, (* Not in the indentation *) 5MIN(X-BLANKS+BYTES+LINESTART (* Where it wants to be *) 8,SCAN(MAXCHAR,=CHR(EOL),EBUF^[CURSOR])+CURSOR 8) 5) .);  END(* DOWNMOVE *);   PROCEDURE LEFTMOVE;  BEGIN "GETLEADING; (* SET LINESTART AND STUFFSTART *) "WHILE (STUFFSTART>CURSOR-REPEATFACTOR) AND (CURSOR>REPEATFACTOR HEN CURSOR:=CURSOR-1; (* NULL LINE CASE *) *CURSOR:=SCAN(-MAXCHAR,=CHR(EOL),EBUF^[CURSOR])+CURSOR; (* 1 UP *) *IF CURSOR>=1 THTART],EBUF^[LINESTART+2],BUFCOUNT-STUFFSTART) &ELSE (BEGIN *IF BUFCOUNT>BUFSIZE-100 THEN ,BEGIN .ERROR('Buffer overflow',NOEN BEGIN LINE:=LINE-1; I:=I+1 END; (END; &CURSOR:=MAX(1,CURSOR); (* BACK INTO REALITY *) &ATEND:= (CURSOR=1); NFATAL); .EXIT(ADJUSTING) ,END *ELSE ,MOVERIGHT(EBUF^[STUFFSTART],EBUF^[LINESTART+2],BUFCOUNT-STUFFSTART); (END; &IF LINES&IF LINE<1 THEN CENTER $END "ELSE $BEGIN (* DIRECTION='>' *) &WHILE (I<=REPEATFACTOR) AND (CURSORSTUFFSTART THEN (BEGIN *READJUST(LINESTART,LINESTART+2-STUFFSTART); *BUFCOUNT:=BUFCOUNT+LINESTART+2-STUFFSTART; (ENDCURSOR:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[CURSOR])+CURSOR+1; (*1 DOWN *) *IF CURSOR=BUFCOUNT-1); &IF LINE>SCREENHEIGHT THEN (IF (LGOTOXY(0,LINE); ERASETOEOL(0,LINE); (* erase the line *) "LINEOUT(LINESTART,BYTES,BLANKS,LINE); GOTOXY(X,LINE); STUFFSTART *) $END; "CURSOR:=MAX(STUFFSTART,MAX(CURSOR-REPEATFACTOR,1)); "IF LINE<1 THEN CENTER; "FINDXY(X,LINE);  END (* LINE-SCREENHEIGHT>=SCREENHEIGHT) OR +INREPLACE OR (COMMAND=PARAC) OR INDELETE )THEN *CENTER (ELSE *SCROLLUP(SCROLLMARK,LINEFTMOVE *);   PROCEDURE RIGHTMOVE;  VAR "EOLPTR: PTRTYPE;  BEGIN "EOLPTR:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[CURSOR])+CURSOR; E-SCREENHEIGHT); &CURSOR:=MIN(CURSOR,BUFCOUNT-1) $END; "GETLEADING; "CURSOR:=STUFFSTART; (* FORCED TO BEGINNING OF STUFF *) "WHILE (EOLPTRSCREENHEIGHT THEN $IF (LINE-SCREYPE "MODES=(RELATIVE,LEFTJ,RIGHTJ,CENTER);  VAR "LLENGTH,TDELTA,I: INTEGER; "SAVEDIR: CHAR; "MODE: MODES;  ENHEIGHT>=SCREENHEIGHT) OR (INDELETE) THEN &CENTER $ELSE &SCROLLUP(SCROLLMARK,LINE-SCREENHEIGHT); "CURSOR:=MIN(BUFCOUNT-1,CU PROCEDURE DOIT(DELTA:INTEGER);  VAR "EOLDIST: INTEGER; "T: PACKED ARRAY [0..MAXSTRING] OF CHAR;  BEGIN "GETLEADING; (* SeRSOR+REPEATFACTOR); "FINDXY(X,LINE);  END(* RIGHTMOVE *);   PROCEDURE LINEMOVE(REPEATFACTOR: INTEGER);  VAR I: INTEGER;  t linestart, stuffstart, and blanks *) "IF BLANKS+DELTA<0 THEN DELTA:=-BLANKS; "IF (EBUF^[LINESTART]=CHR(DLE)) AND (STUFFSTARTBEGIN "I:=1; "IF DIRECTION='<' THEN $BEGIN &WHILE (I<=REPEATFACTOR) AND (CURSOR>1) DO (BEGIN *IF EBUF^[CURSOR]=CHR(EOL) T-LINESTART=2) THEN $X:=ORD(EBUF^[LINESTART+1])+DELTA-32 "ELSE $BEGIN &IF STUFFSTART-LINESTART>2 THEN (MOVELEFT(EBUF^[STUFFS IN ,IF COMMAND=UP THEN DIRECTION:='<' ELSE DIRECTION:='>'; ,I:=1; ,ATEND:=FALSE; ,WHILE NOT ATEND AND ((I<=REPEATFACTOR) OR NEWX:=X; $WITH PAGEZERO DO &BEGIN (IF DIRECTION='>' THEN *BEGIN ,ENDX:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[CURSOR])+X; ,WHILE (TAINFINITY) DO .BEGIN 0I:=I+1; 0LINEMOVE(1); 0IF NOT ATEND THEN 2BEGIN 4IF MODE=RELATIVE THEN DOIT(TDELTA) 4ELSE 6BEGIN 8BSTOP[NEWX]=NONE) AND (NEWXBLALLENGTH:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[STUFFSTART]); 8CASE MODE OF :LEFTJ: DOIT(LMARGIN-BLANKS); NKS) DO NEWX:=NEWX-1; *END; (REPEATFACTOR:=ABS(NEWX-X); (IF DIRECTION='>' THEN RIGHTMOVE ELSE LEFTMOVE; &END; (* With *) "E:RIGHTJ: DOIT((RMARGIN-LLENGTH+1)-BLANKS); :CENTER: :DOIT(((RMARGIN-LMARGIN+1)-LLENGTH) DIV 2-BLANKS+LMARGIN) 8END (* case *ND (* For *)  END;   PROCEDURE MOVING;  VAR "SAVEX: INTEGER;  BEGIN "INDELETE:=FALSE; "INREPLACE:=FALSE; "EXITPROMPT:=) 6END (* else *) 2END; (* if not atend *) .END (* while ... *) *END (ELSE *IF COMMAND=LEFT THEN ,BEGIN .DOIT(-REPEATFACFALSE; "IF INFINITY THEN $BEGIN &CASE COMMAND OF (UP,LEFT: JUMPBEGIN; (DOWN,RIGHT: JUMPEND; (PARAC,SPACE,ADVANCE,TAB: IF DTOR); TDELTA:=TDELTA-REPEATFACTOR; MODE:=RELATIVE ,END *ELSE ,IF COMMAND=RIGHT THEN .BEGIN 0DOIT(REPEATFACTOR); TDELTA:=TDEIRECTION='<' THEN JUMPBEGIN ELSE JUMPEND &END; &NEEDPROMPT:=TRUE; &NEXTCOMMAND; &EXIT(MOVEIT) $END; "FINDXY(X,LINE); LTA+REPEATFACTOR; MODE:=RELATIVE .END ,ELSE .IF COMMAND IN [LISTC,REPLACEC,COPYC] THEN 0BEGIN 2GETLEADING; 2LLENGTH:=SCAN("REPEAT $OLDX:=X; OLDLINE:=LINE; $CASE COMMAND OF &LEFT: LEFTMOVE; &RIGHT: RIGHTMOVE; &SPACE: IF DIRECTION='<' THEN LEFTMOMAXCHAR,=CHR(EOL),EBUF^[STUFFSTART]); 2IF COMMAND=LISTC THEN 4BEGIN MODE:=LEFTJ; DOIT(LMARGIN-BLANKS) END 2ELSE 4IF COMMAND=VE ELSE RIGHTMOVE; &UP: UPMOVE; &DOWN: DOWNMOVE; &ADVANCE: LINEMOVE(REPEATFACTOR); &PARAC: (IF REPEATFACTOR>1000 THEN ERRO END(* DOIT *);   BEGIN (* adjusting *) "WITH PAGEZERO DO $BEGIN &SAVEDIR:=DIRECTION; EXITPROMPT:=FALSE; INDELETE:=FALSE;REPLACEC THEN 6BEGIN MODE:=RIGHTJ; DOIT((RMARGIN-LLENGTH+1)-BLANKS) END 4ELSE (* COMMAND=COPYC *) 6BEGIN 8MODE:=CENTER; 8DO LASTPAT:=CURSOR; &INREPLACE:=TRUE; &PROMPTLINE:= "' Adjust: L(just R(just C(enter { to leavIT(((RMARGIN-LMARGIN+1)-LLENGTH) DIV 2-BLANKS+LMARGIN) 6END 0END .ELSE ,IF CH<>CHR(ETX) THEN BEGIN ERRWAIT; SHOWCURSOR END; e}'; &PROMPT; NEEDPROMPT:=TRUE; &MODE:=RELATIVE; &SHOWCURSOR; &FINDXY(X,LINE); &TDELTA:=0; &REPEAT (CH:=GETCH; (COMMAND:&1: UNTIL CH=CHR(ETX); &DIRECTION:=SAVEDIR; $END;  END;   PROCEDURE TABBY; =MAPTOCOMMAND(CH); (INFINITY:=FALSE; (IF COMMAND=SLASHC THEN *BEGIN ,REPEATFACTOR:=1; INFINITY:=TRUE; CH:=GETCH; COMMAND:=TR (* Scan along the line until you either hit a tabstop or the end of the line *)  VAR "NEWX,ENDX,I,NUMTODO: INTEGER;  BEGIN ANSLATE[CH] *END (ELSE *IF COMMAND=DIGIT THEN REPEATFACTOR:=GETNUM ELSE REPEATFACTOR:=1; (IF COMMAND IN [UP,DOWN] THEN *BEG"NUMTODO:=REPEATFACTOR; "FOR I:=1 TO NUMTODO DO "BEGIN $REPEATFACTOR:=1; $IF DIRECTION='>' THEN RIGHTMOVE ELSE LEFTMOVE; $ ELSE GOTOXY(X,LINE) (END &ELSE (IF X=OLDX THEN *BEGIN ,IF LINE=OLDLINE+1 THEN WRITE(CHR(LF)) ,ELSE IF LINE=OLDLINE-1 THEN 2; X2:=SAVE $END; "IF ABS(NEWDIST)>ABS(DIST) THEN $CLEAR(X1,Y1,X2,Y2) "ELSE $BEGIN &GOTOXY(X1,Y1); &PUTITBACK(C1,C2) $ENCONTROL(US) ,ELSE GOTOXY(X,LINE); *END (ELSE *GOTOXY(X,LINE); $REPEATFACTOR:=1; $NEXTCOMMAND "UNTIL NOT (COMMAND IN [UP,DD; "GOTOXY(X,LINE)  END;   PROCEDURE DELETING;  LABEL 1;  VAR "ATBOL,ANCHOR,SAVE: PTRTYPE; "OK,ATBOT,NOMOVE: BOOLEAN; OWN,LEFT,RIGHT,ADVANCE,SPACE,TAB]); "IF EXITPROMPT THEN PROMPT; "SHOWCURSOR;  END (* MOVING *);   PROCEDURE PUTITBACK(C1,C"STARTLINE: INTEGER;   BEGIN "DOFFSCREEN:=FALSE; INDELETE:=TRUE; INREPLACE:=FALSE; EXITPROMPT:=FALSE; "ANCHOR:=CURSOR; NEWD2: PTRTYPE);  VAR "PTR: PTRTYPE; "INDENT,LOFF: INTEGER;  BEGIN "PTR:=C1; "WHILE PTR<=C2 DO $BEGIN IST:=0; "GETLEADING; ATBOL:=LINESTART; ATBOT:=(CURSOR=STUFFSTART); "PROMPTLINE:=  ' Delete: < > { to d&IF EBUF^[PTR]=CHR(EOL) THEN (BEGIN *PTR:=PTR+1; WRITELN; *INDENT:=LEADBLANKS(PTR,LOFF); *IF (PTR0) THEN elete, to abort}'; "PROMPT; NEEDPROMPT:=TRUE; "SHOWCURSOR; "FINDXY(X,LINE); "STARTLINE:=LINE; "REPEAT $OLDCURSOR:=CU,WRITE(' ':INDENT); *PTR:=PTR+LOFF (END &ELSE (BEGIN WRITE(EBUF^[PTR]); PTR:=PTR+1 END; $END;  END;   PROCEDURE CLEAR(*RSOR; $DIST:=NEWDIST; $OLDX:=X; OLDLINE:=LINE; $CH:=GETCH; $COMMAND:=TRANSLATE[CH]; $IF COMMAND=DIGIT THEN REPEATFACTOR:=GEX1,Y1,X2,Y2: INTEGER*);  (* Screen co-ordinate (X1,Y1) is assumed to be before (X2,Y2). This #procedure takes these co-ordinaTNUM ELSE REPEATFACTOR:=1; $IF COMMAND IN [REVERSEC..DIGIT,ADVANCE,SPACE] THEN &BEGIN (CASE COMMAND OF *LEFT: LEFTMOVE; tes and clears (writes blanks) over #the screen between them (inclusive) *)  VAR XX,I: INTEGER;  BEGIN "GOTOXY(X1,Y1); "XX*RIGHT: RIGHTMOVE; *SPACE: IF DIRECTION='<' THEN LEFTMOVE ELSE RIGHTMOVE; *UP: UPMOVE; *DOWN: DOWNMOVE; *ADVANCE: LINEMOVE(:=X1; "FOR I:=Y1 TO Y2-1 DO BEGIN IF I<>0 THEN ERASETOEOL(XX,I); XX:=0; WRITELN END; "IF Y1<>Y2 THEN FOR I:=0 TO X2 DO WRITE('REPEATFACTOR); *REVERSEC,FORWARDC: ,BEGIN .IF COMMAND=REVERSEC THEN 0DIRECTION:='<' .ELSE 0DIRECTION:='>'; .GOTOXY(0,0);  ') "ELSE FOR I:=X1 TO X2 DO WRITE(' ')  END;   PROCEDURE RESOLVESCREEN;  VAR "X1,X2,Y1,Y2,SAVE: INTEGER; "C1,C2: PTRTYPWRITE(DIRECTION); GOTOXY(X,LINE) ,END; *TAB: TABBY (END; (NEWDIST:=CURSOR-ANCHOR; (RESOLVESCREEN; &END $ELSE &IF (CH<>CHE;  BEGIN "X1:=X; Y1:=LINE; "X2:=OLDX; Y2:=OLDLINE; "IF NEWDIST>DIST THEN $BEGIN C1:=CURSOR-1; C2:=OLDCURSOR; X1:=X1-1 ER(ESC)) AND (CH<>CHR(ETX)) THEN (BEGIN ERRWAIT; GOTOXY(X,LINE) END "UNTIL (CH IN [CHR(ETX),CHR(ESC)]); "IF CH=CHR(ETX) THEN R('Too many',NONFATAL) (ELSE LINEMOVE(SCREENHEIGHT*REPEATFACTOR); &TAB: TABBY $END; $IF EXITPROMPT OR (COMMAND=PARAC) THEN ND "ELSE $IF NEWDISTY2) OR ((Y1=Y2) AND (X1>X2)) THEN $BEGIN &SAVE:=C1; C1:=C2; C2:=SAVE; &SAVE:=Y1; Y1:=Y2; Y2:=SAVE; &SAVE:=X1; X1:=X (EXIT(FIND); &END; "IF (CH=CHR(EOL)) AND JUSTIN THEN $BEGIN &JUSTIN:=FALSE; &BLANKCRT(1) $END "ELSE $WRITE(CH);  END; ebuf. Update the cursor %to the first non-kind3 character *) "WHILE EBUF^[CURSOR] IN [CHR(SP),CHR(H $BEGIN &GETLEADING; (* Indentation fixup *) &IF ATBOT AND (CURSOR=STUFFSTART) THEN (BEGIN CURSOR:=LINESTART; SAVE:=ANCHOR;   PROCEDURE SKIP;  BEGIN "WHILE CH IN [CHR(SP),CHR(HT),CHR(EOL)] DO NEXTCH  END;   PROCEDURE OPTIONS;  BEGIN "REPEAT ANCHOR:=ATBOL END; &IF OKTODEL(CURSOR,ANCHOR) THEN (BEGIN *READJUST(MIN(CURSOR,ANCHOR),-ABS(CURSOR-ANCHOR)); *COPYLINE:=(CUR$CH:=UCLC(CH); $IF CH='L' THEN &BEGIN MODE:=LITERAL; NEXTCH END $ELSE &IF CH='V' THEN (BEGIN VERIFY:=TRUE; NEXTCH END &ESOR=LINESTART) AND ATBOT; *IF ANCHORCHR(EOL)) AND (I>0) THEN (* Don't go overboard! *) *BEGIN ,WRITE(' ',CHR(BS)); ,I:=I-1 LSE $IF COMMAND=ADJUSTC THEN &BEGIN ADJUSTING; NEXTCOMMAND END $ELSE MOVING;  END;    (*$TF i n d & R e p l a c e*)*END (ELSE CONTROL(FS); (* Make up for the NEXTCH wrote out *) &END $ELSE &BEGIN (PATTERN[I]:=CH; (I:=I+1 &END; "U   PROCEDURE FIND;  LABEL 1;  VAR "ALREADYSAIDGO,THERE,FOUND,LASTPATTERN: BOOLEAN; "TRASH,COULDBE,PLENGTH,START,STOP,NEXTNTIL (CH=DELIMITER) OR (I>=MAXSTRING); "IF I>=MAXCHAR THEN $BEGIN &ERROR('Your pattern is too long',NONFATAL); &IF NOT JUSTSTART: INTEGER; "NEXT,PTR: PTRTYPE; "MODE: (LITERAL,TOKEN); "I: INTEGER; "DELIMITER: CHAR; "JUSTIN: BOOLEAN; "POSSIBLE,PATIN THEN REDISPLAY; &NEXTCOMMAND; EXIT(FIND) $END; "PLENGTH:=I-1;  END (* PARSESTRING *);   FUNCTION OK(PTR: PTRTYPE): BOO: PTYPE; "USEOLD,VERIFY: BOOLEAN;   PROCEDURE NEXTCH;  BEGIN "CH:=GETCH; "IF CH=CHR(ESC) THEN &BEGIN (IF NOT JUSTIN THELEAN;  (* Compare PAT against the buffer *)  VAR I: INTEGER;  BEGIN "I:=0; "WHILE (I BUFCOUNT THE"LASTPATTERN:=FALSE; "START:=NEXTSTART; "STOP:=MIN(TLENGTH-1,START+SCAN(TLENGTH-START,=CHR(EOL),TARGET[START])); "IF STOP=TLEN .FOUND:=FALSE ,ELSE .IF NOT OK(PTR) THEN FOUND:=FALSE; *END; &END; T),CHR(DLE),CHR(EOL)] DO $IF EBUF^[CURSOR]=CHR(DLE) THEN CURSOR:=CURSOR+2 $ELSE CURSOR:=CURSOR+1;  END;   PROCEDURE SCANBANGTH-1 THEN BEGIN STOP:=MAX(STOP,0); LASTPATTERN:=TRUE END; "NEXTSTART:=STOP+1;  END;   PROCEDURE NEXTTOKEN;  (* Given NEXCKWARD;  LABEL 1;  VAR "LOC: PTRTYPE; "CHTHERE: BOOLEAN;  BEGIN "CHTHERE:=TRUE; "THERE:=FALSE; TSTART, calculate START and STOP *)  BEGIN "LASTPATTERN:=FALSE; "START:=NEXTSTART; "(* Skip over leading kind3 characters *)"FILLCHAR(PAT[0],SIZEOF(PAT),' '); "MOVELEFT(TARGET[START],PAT[0],PLENGTH); "WHILE CHTHERE AND NOT THERE DO $BEGIN &1: IF  "WHILE (TARGET[START] IN [CHR(SP),CHR(EOL),CHR(HT)]) AND (START=PLENGTH THEN (* Possibly there *) (LOC:=SCAN(-PTR,=PAT[0],EBUF^[PTR]) &ELSE (LOC:=-PTR; &IF LOC=-PTR THEN (* Not there!xt token *) "WHILE (KIND[TARGET[START]]=KIND[TARGET[STOP+1]]) AND (STOP0 THEN (* still stuff to scan *) &LOC:=SCAN(MAXSCAN,=PAT[0],EBUF^[PTR]) $ELSE &LOC:=MAXSCAN; (* Dummy up 'not found'$IF MODE=LITERAL THEN NEXTLINE ELSE NEXTTOKEN; $PLENGTH:=STOP-START+1; $IF DIRECTION='>' THEN SCANFORWARD ELSE SCANBACKWARD;  IF LORT THEN IF MODE=TOKEN THEN WRITE('L(it') ELSE WRITE('T(ok'); "WRITE(RIGHT)  END;   PROCEDURE REPLACEIT;  LABEL 1;  BREPEATFACTOR,TRUE); "NEEDPROMPT:=TRUE; "NEXTCH; SKIP; "OPTIONS; "IF NOT USEOLD THEN $BEGIN &PARSESTRING(TARGET,TLENGTH);EGIN "IF VERIFY THEN $BEGIN &CENTERCURSOR(TRASH,MIDDLE,NOT JUSTIN);  &TDEFINED:=TRUE $END; "IF COMMAND=REPLACEC THEN $BEGIN &NEXTCH; SKIP; &USEOLD:=FALSE; &OPTIONS; &IF NOT USEOLD THEN (B&PUTPROMPT(' Replace',' aborts, ''R'' replaces, '' '' doesn''t', 0REPEATFACTOR-I+2,FALSE); &SHOWCURSOR; &CH:=GETCH; &IEGIN *PARSESTRING(SUBSTRING,SLENGTH); *SDEFINED:=TRUE (END $END; "HOME; "CLEARLINE(0); "IF ((COMMAND=FINDC) AND TDEFINED)F CH=CHR(ESC) THEN (BEGIN *GETLEADING; CURSOR:=MAX(CURSOR,STUFFSTART); *NEXTCOMMAND; EXIT(FIND) (END; &IF (CH<>'R') AND (CH %OR ((COMMAND=REPLACEC) AND SDEFINED AND TDEFINED) THEN $BEGIN &I:=1; &FOUND:=TRUE; &PTR:=CURSOR; &WHILE ((I<=REPEATFAC<>'r') THEN (BEGIN *REPEATFACTOR:=REPEATFACTOR+1; (* 20-Jun-78 Don't count false hits *) *GOTO 1; (END; $END; $(* ReplacTOR) OR INFINITY) AND FOUND DO (BEGIN *GOFORIT; (* Find the target (handles token and literal mode) *) *I:=I+1; e TARGET with SUBSTRING *) &IF SLENGTH>CURSOR-LASTPAT THEN (IF SLENGTH-(CURSOR-LASTPAT)+BUFCOUNT>BUFSIZE-200 THEN ,BEGIN .ER*IF FOUND THEN ,BEGIN .CURSOR:=PTR+PLENGTH; LASTPAT:=COULDBE; (*Set up for next time*) .IF COMMAND=REPLACEC THEN REPLACEIT; ROR('Buffer full. Aborting Replace',NONFATAL); .GETLEADING; CURSOR:=MAX(CURSOR,STUFFSTART); .NEXTCOMMAND; EXIT(FIND); ,END .IF DIRECTION='<' THEN PTR:=COULDBE-1 ELSE PTR:=CURSOR; ,END *ELSE ,BEGIN .IF (DIRECTION='>') AND (RPAGE2) AND (EBUF^[COULDBE-2]<>CHR(DLE))) OR +(COULDBE<=2) THEN (* w[CURSOR],EBUF^[LASTPAT+SLENGTH],BUFCOUNT-CURSOR); &MOVELEFT(SUBSTRING[0],EBUF^[LASTPAT],SLENGTH); &IF SLENGTH<>CURSOR-LASTPAT hew! *) *IF KIND[EBUF^[COULDBE]]=KIND[EBUF^[COULDBE-1]] THEN ,FOUND:=FALSE; (* False find... don't count it. *) (IF (PTR+PLENTHEN (READJUST(LASTPAT,SLENGTH-(CURSOR-LASTPAT)); &BUFCOUNT:=BUFCOUNT+SLENGTH-(CURSOR-LASTPAT); GTH<=BUFCOUNT-1) AND +(KIND[EBUF^[PTR+PLENGTH-1]]=KIND[EBUF^[PTR+PLENGTH]]) THEN *FOUND:=FALSE; (* Another false find *) %EN&CURSOR :=CURSOR +SLENGTH-(CURSOR-LASTPAT); &JUSTIN:=FALSE;  1:END;   BEGIN "ALREADYSAIDGO:=FALSE; (* OK to go on withoD; "UNTIL FOUND OR NOT THERE;  END(* goforit *);   PROCEDURE PUTPROMPT(LEFT,RIGHT:STRING; REPEATFACTOR:INTEGER; LORT:BOOLEAut asking! *) "JUSTIN:=TRUE; "USEOLD:=FALSE; "VERIFY:=FALSE; "IF PAGEZERO.TOKDEF THEN MODE:=TOKEN ELSE MODE:=LITERAL; "IF CN);  BEGIN "PROMPTLINE:=LEFT; PROMPT; "WRITE('['); "IF INFINITY THEN WRITE('/') ELSE WRITE(REPEATFACTOR); "WRITE(']: '); "OMMAND=FINDC THEN $PUTPROMPT(' Find',' =>',REPEATFACTOR,TRUE) "ELSE $PUTPROMPT(' Replace',' V(fy =>', hing *) 6IF DIRECTION='>' THEN 8BEGIN :CURSOR:=BUFCOUNT-1; :PUTPAGES(LEFTSTACK); :GETPAGES(RIGHTSTACK); 8END 6ELSE 8BEGI: XMACRO; $ZAPC: ZAPIT; $EQUALC: BEGIN &CURSOR:=LASTPAT; &GETLEADING; &CURSOR:=MAX(CURSOR,STUFFSTART); &CENTERCURSOR(TRASHN :CURSOR:=1; :PUTPAGES(RIGHTSTACK); :GETPAGES(LEFTSTACK) 8END; 6PTR:=CURSOR 4END 2ELSE 4GOTO 1; 0END (* ... or ... *) ,MIDDLE,FALSE); &SHOWCURSOR; NEXTCOMMAND $END; $ADJUSTC,DELETEC,PARAC,UP,DOWN,LEFT,RIGHT,ADVANCE,TAB,SPACE: MOVEIT "END (*,END (* if found then ... else ... *) (END; (* While ... *) &IF NOT FOUND THEN (IF NOT( INFINITY AND (I>2) ) THEN *BEGIN  BIG LONG CASE STATEMENT *);  END (* COMMANDER *);   BEGIN (* Editcore *) "NEXTCOMMAND; "WHILE COMMAND<>QUITC DO COMMANDER,IF ALREADYSAIDGO THEN .BEGIN (* Cursor invalid *) 0CURSOR:=1; 0JUSTIN:=FALSE; .END; ,ERROR('Pattern not in the file',NONF  END;    (*$TM i s c. P r o c e d u r e s (Incl. Screen Control) *)   FUNCTION MIN(* (A,B:INTEGER):INTEGER *);  BEGATAL) *END; $END "ELSE $ERROR('No old pattern.',NONFATAL); "1: GETLEADING; "CURSOR:=MAX(STUFFSTART,CURSOR); "CENTERCURSIN "IF AB THEN MAX:=A ELSE MAX:=BOR(TRASH,MIDDLE,NOT JUSTIN); "SHOWCURSOR; "NEXTCOMMAND  END;   (*$TC o m m a n d I n t e r f a c e*)   PROCEDURE NEXT  END;   FUNCTION GETCH(*:CHAR*);  VAR GCH: CHAR;  BEGIN "READ(KEYBOARD,GCH); "IF EOLN(KEYBOARD) THEN GCH:=CHR(EOL); COMMAND;  BEGIN "IF NEEDPROMPT THEN $BEGIN &PROMPTLINE:=  ' Edit: A(djst C(py D(lete F(ind I(nsrt J(mp R(place Q(uit X(chng"GETCH:=GCH;  END;   FUNCTION MAPTOCOMMAND(* (CH:CHAR): COMMANDS *);  BEGIN "IF (CH=SYSCOM^.CRTCTRL.ESCAPE) AND (CH<>CHR( Z(ap [L.2]'; &PROMPT; &NEEDPROMPT:=FALSE; &SHOWCURSOR $END; "CH:=GETCH; "COMMAND:=MAPTOCOMMAND(CH);  END(* NEXTCOMMAND 0)) THEN $BEGIN &CH:=GETCH; &IF CH=SYSCOM^.CRTINFO.LEFT THEN MAPTOCOMMAND:=LEFT &ELSE (IF CH=SYSCOM^.CRTINFO.RIGHT THEN MAP*);   PROCEDURE COMMANDER;  BEGIN "INFINITY:=FALSE; "IF COMMAND=SLASHC THEN $BEGIN REPEATFACTOR:=1; INFINITY:=TRUE; NEXTTOCOMMAND:=RIGHT (ELSE *IF CH=SYSCOM^.CRTINFO.UP THEN MAPTOCOMMAND:=UP *ELSE ,IF CH=SYSCOM^.CRTINFO.DOWN THEN MAPTOCOMMAND:=COMMAND END "ELSE $IF COMMAND=DIGIT THEN REPEATFACTOR:=GETNUM ELSE REPEATFACTOR:=1; "CASE COMMAND OF $ILLEGAL: BEGIN ERRWAIDOWN ,ELSE .MAPTOCOMMAND:=ILLEGAL $END "ELSE $MAPTOCOMMAND:=TRANSLATE[CH];  END;   FUNCTION UCLC(*(CH:CHAR):CHAR*); (* ECTION='<') AND (LPAGE>0) THEN 0BEGIN 2IF ALREADYSAIDGO THEN CH:='Y' 2ELSE 4BEGIN 1MSG:='End of Buffer encountered. Get morT; SHOWCURSOR; NEXTCOMMAND END; $REVERSEC,FORWARDC: FIXDIRECTION; $BANISHC: BANISH; $COPYC: COPY; $DUMPC: DUMP; e from disk? (Y/N)'; 6PUTMSG; 6ALREADYSAIDGO:=TRUE; 6REPEAT CH:=UCLC(GETCH) UNTIL CH IN ['Y','N']; 4END; 2IF CH='Y' THEN 4$FINDC: FIND; $INSERTC: INSERTIT; $JUMPC: JUMP; $LISTC: NEXTCOMMAND; (* NOT YET, DEPENDS ON TERAK PAN *) $MACRODEFC: DEFMACBEGIN 6JUSTIN:=FALSE; (* FORCES REDISPLAY!!! *) 6MSG:='Finding'; PUTMSG; 6FOUND:=TRUE; 6I:=I-1; (* Really haven't found anytRO; $NEXTC: NEXT; $QUITC: ; (* EXIT HANDLED IN OUTER BLOCK *) $REPLACEC: FIND; $SETC: SETSTUFF; $VERIFYC: VERIFY; $XECUTEC Map Lower Case to Upper Case *)  BEGIN "IF CH IN ['a'..'z'] THEN UCLC:=CHR(ORD(CH)-32) ELSE UCLC:=CH  END;   PROCEDURE CON(UNITWRITE(2,BLANKAREA,SCREENWIDTH-X) &ELSE (UNITWRITE(2,BLANKAREA,SCREENWIDTH-X+1) $END; "GOTOXY(X,LINE); "*) "CONTROL(ETROL(*CH:CTYPE*);  (* Based on the parameter passed, use crtctrl to put out the #appropriate control code for the host terminaTOEOL);  END;   PROCEDURE ERASEOS(*X,LINE*);  VAR I: INTEGER;  BEGIN "(* "ERASETOEOL(X,LINE); "FOR I:=LINE+1 TO SCREENHl *)  BEGIN "WITH SYSCOM^.CRTCTRL DO $BEGIN &IF ESCAPE<>CHR(0) THEN WRITE(ESCAPE); &CASE CH OF (FS: WRITE(NDFS); (GOHEIGHT DO BEGIN WRITELN; CLEARLINE(I) END; "*) "CONTROL(ETOEOS);  END;   PROCEDURE PROMPT;  BEGIN "PROMPTLINE[1]:=DIRECTIOME: WRITE(HOME); (ETOEOL: WRITE(ERASEEOL); (ETOEOS: WRITE(ERASEEOS); (US: WRITE(RLF) &END $END  END;  ON; "SAVETOP:=PROMPTLINE; "CONTROL(GOHOME); "CLEARLINE(0); "WRITE(PROMPTLINE)  END;   PROCEDURE ERRWAIT;  BEGIN "WRITE (* LOOK AT ME! LOOK AT ME! LOOK AT ME! LOOK AT ME! LOOK AT ME! LOOK AT ME! *)  PROCEDURE CLEARSCREEN;  (* Set the screen to(CHR(BELL)); "PROMPT;  END;   PROCEDURE BLANKCRT(*Y: INTEGER*);  BEGIN "(* "IF Y=1 THEN $BEGIN &CLEARSCREEN; &WRITELN all blanks and leave the cursor in the upper left-hand #corner (0,0). Note that the control code for this operation is hard- (SAVETOP) $END "ELSE $BEGIN &GOTOXY(0,Y); &ERASEOS(0,Y); $END; "*) "GOTOXY(0,Y); "CONTROL(ETOEOS)  END;   PROCEDURE#wired (i.e. it doesn't go through SYSCOM), and thus entails a recomp- #ilation to change terminals. P.S. 12 is a FF. *)  B ERROR(*S: STRING;HOWBAD: ERRORTYPE*);  BEGIN "UNITCLEAR(1); (* Throw away all characters queued up *) EGIN "WRITE(CHR(12))  END;   PROCEDURE CLEARLINE(*Y:INTEGER*);  (* If your terminal has an ERASELINE capability; that is a"IF HOWBAD=FATAL THEN $BLANKCRT(1) "ELSE $BEGIN HOME; CLEARLINE(0) END; "WRITE('ERROR: ',S); "IF HOWBAD=FATAL THEN $EXIT( control code #that will clear the line the cursor is on, and leave the cursor at #the first column (0,Y) then substitute thiEDITOR) "ELSE $BEGIN &WRITE(' Please press to continue.'); &REPEAT UNTIL GETCH=' '; NEEDPROMPT:=TRUE $END;  ENs code with a single character #write *)  BEGIN "(* "IF Y<>SCREENHEIGHT THEN UNITWRITE(2,BLANKAREA,SCREENWIDTH+1) "ELSE UNID;   (*$TU t i l i t y P r o c e d u r e s*)   FUNCTION LEADBLANKS(* (PTR: PTRTYPE; VAR BYTES: INTEGER): INTEGER *);  (TWRITE(2,BLANKAREA,SCREENWIDTH); "GOTOXY(0,Y); "*) "GOTOXY(0,Y); CONTROL(ETOEOL);  END;   PROCEDURE PUTMSG;  BEGIN "CON* On entry- &PTR points to the beginning of a line #On exit- &function returns the number of leading blanks on that line. &bTROL(GOHOME); "CLEARLINE(0); "SAVETOP:=MSG; "WRITE(MSG);  END;   PROCEDURE HOME; BEGIN CONTROL(GOHOME) END;  ytes has the offset into the line of the first non-blank character *)  VAR "OLDPTR: PTRTYPE; "INDENT: INTEGER;  BEGIN "OLD PROCEDURE ERASETOEOL(*X,LINE:INTEGER*);  BEGIN "(* "IF X=0 THEN CLEARLINE(LINE) "ELSE $BEGIN &IF LINE=SCREENHEIGHT THEN PTR:=PTR; INDENT:=0; "WHILE ORD(EBUF^[PTR]) IN [HT,SP,DLE] DO $BEGIN &IF EBUF^[PTR]=CHR(DLE) THEN (BEGIN PTR:=PTR+1; INDENT: #is made to position the cursor at line "linesup". line is then updated #to the actual line the cursor was forced to. *)  VA *N:=N*10+ORD(CH)-ORD('0'); *CH:=GETCH (END $UNTIL (NOT (CH IN ['0'..'9'])) OR OVERFLOW; "IF OVERFLOW THEN $BEGIN &ERROR(R "MARK: INTEGER; "PTR: PTRTYPE;  BEGIN "IF EBUF^[CURSOR]=CHR(EOL) THEN PTR:=CURSOR ELSE PTR:=CURSOR+1; "LINE:=0; "REPEAT 'Repeatfactor > 10,000',NONFATAL); &GETNUM:=0; $END "ELSE $GETNUM:=N; "COMMAND:=MAPTOCOMMAND(CH); (* Takes CH and maps it t$PTR:=PTR-1; $PTR:=SCAN(-MAXCHAR,=CHR(EOL),EBUF^[PTR])+PTR; $LINE:=LINE+1; $IF LINE=LINESUP THEN MARK:=PTR; "UNTIL (LINE>SCo a command *)  END;   PROCEDURE GETLEADING;  BEGIN "(* Sets: =INDENT+ORD(EBUF^[PTR])-32 END &ELSE (IF ORD(EBUF^[PTR])=SP THEN INDENT:=INDENT+1 (ELSE *(*HT*) INDENT:=((INDENT DIV 8)+1)*REENHEIGHT) OR ((LINE1PTR=PTR+1) AND NOT NEWSCREEN) OR (PTR<1); "IF LINE>SCREENHEIGHT THEN (* Off the screen *) $BEGIN LINE1PT8; (* KLUDGE FOR COLUMNAR TAB! *) &PTR:=PTR+1 $END; "BYTES:=PTR-OLDPTR; "LEADBLANKS:=INDENT;  END(*LEADBLANKS*);  R:=MARK+1; REDISPLAY; LINE:=LINESUP END "ELSE $IF LINE1PTR=PTR+1 THEN &BEGIN (IF NEWSCREEN THEN REDISPLAY &END $ELSE &BE PROCEDURE REDISPLAY;  (* Do a total update of the screen. Note that this code is partially a #duplicate of lineout/upscreenGIN (LINE1PTR:=1; REDISPLAY &END;  END;   PROCEDURE FINDXY(*VAR INDENT,LINE: INTEGER*);  VAR "I,LEAD: INTEGER; "PTR,EOL for reasons of speed. This procedure is #called only from centercursor *)  VAR "LINEDIST,EOLDIST,LINE: INTEGER; "PTR: PTRTPTR: PTRTYPE;  BEGIN "(* Place CRT cursor on the screen at the position corresponding %to the logical cursor. *) "LINE:=1; YPE; "T: PACKED ARRAY [0..MAXSW] OF CHAR;  BEGIN "BLANKCRT(1); "LINE:=1; "PTR:=LINE1PTR; "REPEAT $BLANKS:=MIN(LEADBLANKS("PTR:=LINE1PTR; "EOLPTR:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[PTR])+PTR; "WHILE EOLPTRCHR(EOL) THEN (* Line truind the indentation on that line of the cursor *) "LEAD:=LEADBLANKS(PTR,I); "INDENT:=MIN(SCREENWIDTH,(LEAD-I)+(CURSOR-PTR)); ncation *) &T[MAX(0,LINEDIST-1)]:='!'; $WRITE(T:LINEDIST); $PTR:=PTR+EOLDIST+1; LINE:=LINE+1 "UNTIL (LINE>SCREENHEIGHT) OR (:(* (extra spaces) + (offset into line) *)  END;(* FINDXY *)   PROCEDURE SHOWCURSOR;  VAR "X,Y: INTEGER;  BEGIN "FINDXY(PTR>=BUFCOUNT)  END;   PROCEDURE CENTERCURSOR  (*VAR LINE: INTEGER; LINESUP: INTEGER; NEWSCREEN: BOOLEAN*);  (* Figure outX,Y); "GOTOXY(X,Y)  END(* SHOWCURSOR *);   FUNCTION GETNUM(*:INTEGER*);  VAR "N: INTEGER; "OVERFLOW: BOOLEAN;  BEGIN  if the cursor is still on the screen. If it is, and #newscreen is false, then no redisplay is done. Otherwise an attempt "N:=0; "OVERFLOW:=FALSE; "IF NOT (CH IN ['0'..'9']) THEN N:=1 "ELSE $REPEAT &IF N > 1000 THEN OVERFLOW:=TRUE &ELSE (BEGIN ENGTH:=ABS(CURSOR-ANCHOR); ©START:=BUFSIZE-COPYLENGTH+1; T(PTR,BYTES,BLANKS,LINE); (* Writes out the line at ptr *) *LINE:=LINE+1 (UNTIL (LINE>SCREENHEIGHT) OR (PTR>=BUFCOUNT) &END; &MOVELEFT(EBUF^[MIN(CURSOR,ANCHOR)],EBUF^[COPYSTART],COPYLENGTH); &OKTODEL:=TRUE $END;  END;  $  PROCEDURE LINEOUT(*VAR  END;   PROCEDURE READJUST(*CURSOR:PTRTYPE; DELTA: INTEGER*);  (* if DELTA<0 then move all affected markers to CURSOR. AlsPTR:PTRTYPE; BYTES,BLANKS,LINE:INTEGER*);  (* Write a line out *)  VAR "LINEDIST,EOLDIST: INTEGER; "T: PACKED ARRAY [0..MAXo adjust all #markers >= CURSOR by DELTA *)  VAR "I: INTEGER;  BEGIN "WITH PAGEZERO DO $FOR I:=0 TO COUNT-1 DO &IF PAGEN[SW] OF CHAR;  BEGIN "GOTOXY(BLANKS,LINE); "PTR:=PTR+BYTES; "EOLDIST:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[PTR]); "LINEDIST:=MAX(0,MI]=-1 THEN (IF POFFSET[I]>=CURSOR THEN *BEGIN ,POFFSET[I]:=MAX(POFFSET[I]+DELTA,CURSOR); *END; IN(EOLDIST,SCREENWIDTH-BLANKS+1)); "MOVELEFT(EBUF^[PTR],T[0],LINEDIST); "IF EBUF^[PTR+LINEDIST]<>CHR(EOL) THEN (* Line truncat"IF (COPYSTART>=CURSOR) AND (COPYSTART(BUFSIZE-BUFCOUNT)+LINE); ERASETOEOL(0,LINE); (* Clean the line *) &LINEOUT(LINESTART,BYTES,BLANKS,LINE) (* Just this line *) $END "ELSE $IF WH10 THEN $BEGIN &MSG:=  'There is no room to copy the deletion. Do you wish to delete anyway? (y/n)'; &PUTMSG; &IF UCLC(GETOLESCREEN THEN &CENTERCURSOR(TRASH,MIDDLE,TRUE) $ELSE (* Only update the part of the screen after the cursor *) &BEGIN (GOTOCH)='Y' THEN OKTODEL:=TRUE ELSE OKTODEL:=FALSE; $END "ELSE $BEGIN &(* COPYLINE is set by the caller *) ©OK:=TRUE; COPYLXY(0,LINE); ERASEOS(0,LINE); (GETLEADING; (PTR:=LINESTART; (REPEAT *BLANKS:=MIN(LEADBLANKS(PTR,BYTES),SCREENWIDTH); *LINEOU ] THEN EXIT(THEFIXER); &IF WHOLE THEN (* Scan backwards for the beginning of the paragraph *) (BEGIN *REPEAT ,CURSOR:=LINESTEGIN ,IF EBUF^[CURSOR]=CHR(0) THEN DONE:=TRUE ,ELSE .BEGIN 0GETLEADING; 0DONE:=(EBUF^[STUFFSTART]=CHR(EOL)) 6OR (EBUF^[START-1; ,GETLEADING *UNTIL (LINESTART<=1) OR (EBUF^[STUFFSTART] IN [RUNOFFCH,CHR(EOL)]); UFFSTART]=RUNOFFCH); 0(* The last transfer will move 3over the for the paragraph *) 0IF NOT DONE THEN 2BEGIN 4EBUF^[*IF EBUF^[STUFFSTART] IN [RUNOFFCH,CHR(EOL)] THEN ,PTR:=CURSOR+1 *ELSE ,PTR:=1; *X:=PARAMARGIN; (END &ELSE (BEGIN *PTR:PTR+WLENGTH-1]:=' '; 4(* If , map to one space only *) 4IF EBUF^[CURSOR-2]=' ' THEN PTR:=PTR-1; 2END .END *END; =LINESTART; *IF BLANKS=PARAMARGIN THEN X:=PARAMARGIN ELSE X:=LMARGIN (END; &CURSOR:=BUFSIZE-(BUFCOUNT-PTR)+1; (* Split the bu(X:=X+WLENGTH; (PTR:=PTR+WLENGTH; &UNTIL DONE; &READJUST(PARAPTR,(BUFSIZE-CURSOR+PTR+1)-BUFCOUNT); &BUFCOUNT:=BUFSIZE-CURSORffer *) &MOVERIGHT(EBUF^[PTR],EBUF^[CURSOR],BUFCOUNT-PTR); &(* Now dribble back the (rest of the) paragraph *) &EBUF^[PTR]:=C+PTR+1; &MOVELEFT(EBUF^[CURSOR],EBUF^[PTR],BUFSIZE-CURSOR+1); &EBUF^[BUFCOUNT]:=CHR(0); &CURSOR:=MIN(BUFCOUNT-1,SAVE); HR(DLE); &EBUF^[PTR+1]:=CHR(X+32); &PTR:=PTR+2; &EBUF^[CURSOR-1]:=CHR(EOL); (* sentinel for getleading *) &DONE:=FALSE; &RE&GETLEADING; &CURSOR:=MAX(CURSOR,STUFFSTART) #END;  END;   PROCEDURE GETNAME(*MSG:STRING; VAR M:NAME*);  VAR "I: INTEGEPEAT (WHILE EBUF^[CURSOR] IN [CHR(HT),CHR(SP),CHR(DLE)] DO *IF EBUF^[CURSOR]=CHR(DLE) THEN CURSOR:=CURSOR+2 ELSE CURSOR:=CURSOR; "S: STRING;  BEGIN "NEEDPROMPT:=TRUE; HOME; CLEARLINE(0); WRITE(MSG,' what marker? '); "READLN(S); "FOR I:=1 TO LENGTH(SR+1; (WPTR:=CURSOR; ((* Skip over a token *) (WHILE NOT (EBUF^[CURSOR] IN [CHR(EOL),' ','-']) DO CURSOR:=CURSOR+1; ((* Speci) DO S[I]:=UCLC(S[I]); "MOVELEFT(S[1],M[0],MIN(8,LENGTH(S))); "FILLCHAR(M[LENGTH(S)],MAX(0,8-LENGTH(S)),' ')  END;    PRal cases for "." and "-" *) (IF EBUF^[CURSOR]='-' THEN IF EBUF^[CURSOR+1]=' ' THEN CURSOR:=CURSOR+1; (IF (EBUF^[CUOCEDURE DISKERR;  BEGIN "ERROR('Bad disk transfer.',NONFATAL);  END;   FUNCTION WRITEIT(*WHICH:LEFTRIGHT):BOOLEAN*);  VAR paragraph is filled, otherwise only that directly after the cursor #is filled. RFAC, when implemented will tell how many paraRSOR-1] IN ['.','?','!','"']) THEN IF +(EBUF^[CURSOR]=' ') AND (EBUF^[CURSOR+1]=' ') THEN CURSOR:=CURSOR+1; graphs to be #filled. Note: A paragraph is defined as lines of text delimited by a line #with no text on it whatsoever, or a (WLENGTH:=CURSOR-WPTR+1; (* Including the delimiter *) (IF (X+WLENGTH>RMARGIN) OR (RMARGIN-LMARGIN+1<=WLENGTH) THEN *BEGIN ,line of a text whose first character is #RUNOFFCH *) #  VAR "SAVE,PTR,WPTR: INTEGER; "WLENGTH,X: INTEGER; "DONE: BOOLEAN; IF EBUF^[PTR-1]=' ' THEN PTR:=PTR-1; ,EBUF^[PTR]:=CHR(EOL); EBUF^[PTR+1]:=CHR(DLE); ,EBUF^[PTR+2]:=CHR(LMARGIN+32); ,PTR:=P BEGIN "WITH PAGEZERO DO $BEGIN &SAVE:=CURSOR; &CURSOR:=PARAPTR; &GETLEADING; &IF EBUF^[STUFFSTART] IN [CHR(EOL),RUNOFFCHTR+3; ,X:=LMARGIN *END; (CURSOR:=CURSOR+1; (MOVELEFT(EBUF^[WPTR],EBUF^[PTR],WLENGTH); (IF EBUF^[CURSOR-1]=CHR(EOL) THEN *B 1; *IF BLOCKWRITE(THEFILE,PAGEBUFFER,2,LPAGE+LPAGE)<>2 THEN DISKERR (END &ELSE (BEGIN *RPAGE:=RPAGE-1; *IF BLOCKWRITE(THEFST:=BUFSIZE-BUFCOUNT+1; &START:=THEREST-1; &READJUST(1,START); &MOVERIGHT(EBUF^[1],EBUF^[THEREST],BUFCOUNT); &WHILE (START>=ILE,PAGEBUFFER,2,RPAGE+RPAGE)<>2 THEN DISKERR (END $END; "WRITEIT:=NOT FULL  END;   FUNCTION READIT(*WHICH:LEFTRIGHT): BO3000) AND NOTDONE DO (BEGIN *NOTDONE:=READIT(WHICH); OLEAN*);  VAR "TAPCITY: BOOLEAN;  BEGIN "TAPCITY:=((WHICH=LEFTSTACK) AND (LPAGE<=0)) OR ,((WHICH=RIGHTSTACK) AND (RPAGE>=FLENGTH)); "IF NOT TAPCITY THEN $BEGIN &IF WHICH=LEFTSTACK THEN (BEGIN *IF BLOCKREAD(THEFILE,PAGEBUFFER,2,LPAGE+LPAGE)<>2 THEN DISKERR; *LPAGE:=LPAGE-1 (END &ELSE (BEGIN *IF BLOCKREAD(THEFILE,PAGEBUFFER,2,RPAGE+RPAGE)<>2 THEN DISKERR; *RPAGE:=RPAGE+1 (END $END; "READIT:=NOT TAPCITY;  END;   PROCEDURE GETPAGES(*WHICH:LEFTRIGHT*);  (*WHICH is which stack you want to read from. Stopping condition: approximately "2000 characters of slop left in the buffer o*IF NOTDONE THEN ,BEGIN .NOTNULLS:=SCAN(-MAXCHAR,<>CHR(0),PAGEBUFFER[1023])+1024; .MOVELEFT(PAGEBUFFER,EBUF^[START-NOTNULLS+r no more stuff to read *)  VAR "I,START,STUFFCOUNT,THEREST,NOTNULLS: INTEGER; "NOTDONE: BOOLEAN;  BEGIN "IF COPYSTART>BUFC1],NOTNULLS); .START:=START-NOTNULLS; .WITH PAGEZERO DO (* Swap in markers *) 0FOR I:=0 TO COUNT-1 DO 2IF PAGEN[I]=LPAGE+1 TOUNT THEN COPYOK:=FALSE; (* Trash copy buffer *) "NOTDONE:=TRUE; "IF WHICH=RIGHTSTACK THEN $BEGIN &START:=BUFCOUNT; &WHILE HEN 4BEGIN 6PAGEN[I]:=-1; 6POFFSET[I]:=POFFSET[I]+START+1; 4END; .WRITE('.'); ,END (END; &STUFFCOUNT:=BUFSIZE-START; &C(STARTCHR(0),URSOR:=CURSOR+STUFFCOUNT-BUFCOUNT; &READJUST(1,-START); &BUFCOUNT:=STUFFCOUNT; &MOVELEFT(EBUF^[START+1],EBUF^[1],STUFFCOUNT);PAGEBUFFER[1023])+1024; .MOVELEFT(PAGEBUFFER,EBUF^[START],NOTNULLS); .WITH PAGEZERO DO (* Swap in markers *)  $END; "EBUF^[BUFCOUNT]:=CHR(0);  END;   PROCEDURE PUTPAGES(*WHICH:LEFTRIGHT*);  (* If WHICH=LEFTSTACK then swap out to t0FOR I:=0 TO COUNT-1 DO 2IF PAGEN[I]=RPAGE-1 THEN 4BEGIN 6PAGEN[I]:=-1; 6POFFSET[I]:=POFFSET[I]+START; 4END; .START:=STARhe left stack otherwise swap out to the #right stack. *)  VAR "I,STOPMARK,SAVE,ONEPAGE,PTR,LAST: INTEGER; "OK: BOOLEAN;   "FULL: BOOLEAN;  BEGIN "FULL:=(LPAGE+1>=RPAGE); "IF NOT FULL THEN $BEGIN &IF WHICH=LEFTSTACK THEN (BEGIN *LPAGE:=LPAGE+T+NOTNULLS; .WRITE('.') ,END (END; &BUFCOUNT:=START; &EBUF^[BUFCOUNT]:=CHR(0); $END "ELSE $BEGIN (* leftstack *) &THERE  ifted past PTR *) &WITH PAGEZERO DO (FOR I:=0 TO COUNT-1 DO *IF PAGEN[I]=-1 THEN ,BEGIN .POFFSET[I]:=MAX(1,POFFSET[I]-PTR+1>0 THEN PUTSYNTAX; $REPEAT &HOME; CLEARLINE(0); &EDITCORE; &IF COMMAND=SETC THEN ENVIRONMENT &ELSE IF COMMAND=COPYC THEN CO); ,END; &CURSOR:=CURSOR-PTR+1; $END "ELSE $BEGIN (* Right *) &PTR:=BUFCOUNT-1; &SAVE:=CURSOR; &CURSOR:=MIN(CURSOR+200,BPYFILE $UNTIL COMMAND=QUITC; "UNTIL OUT; "SYSCOM^.MISCINFO.NOBREAK := FALSE (* 28 SEPT 77*)  END;   BEGIN END.   FUNCTION MOVEITOUT(START,STOP:INTEGER): BOOLEAN;  VAR I: INTEGER;  BEGIN "IF STOP>=START THEN $BEGIN &MOVELEFT(EBUF^[STARUFCOUNT-1); &GETLEADING; &LAST:=LINESTART; &REPEAT (ONEPAGE:=MAX(PTR-1022,LAST); (IF ONEPAGE=LAST THEN *STOPMARK:=ONEPAGE T],PAGEBUFFER,STOP-START+1); &FILLCHAR(PAGEBUFFER[STOP-START+1],1023-(STOP-START),CHR(0)); &MOVEITOUT:=WRITEIT(WHICH); (ELSE *STOPMARK:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[ONEPAGE])+ONEPAGE+1; (IF STOPMARK < PTR THEN *BEGIN ,OK:=MOVEITOUT(STOPMARK,P&WITH PAGEZERO DO (* Swap out markers *) (FOR I:=0 TO COUNT-1 DO *IF (PAGEN[I]=-1) AND (POFFSET[I]>=START) AND (POFFSET[I]<=STR); ,IF OK THEN .PTR:=STOPMARK-1 ,ELSE .ERROR('Ran out of disk room',NONFATAL); & END (ELSE *OK:=FALSE; &UNTIL (ONEPTOP) THEN ,BEGIN .IF WHICH=LEFTSTACK THEN PAGEN[I]:=LPAGE .ELSE PAGEN[I]:=RPAGE; .POFFSET[I]:=POFFSET[I]-START; ,END; &WRIAGE=LAST) OR NOT OK; ©OK:=(COPYOK AND (COPYSTART>BUFCOUNT)) OR .(COPYOK AND (COPYSTART+COPYLENGTH2 THEN (* Potentially trouble! *) $ disk room',NONFATAL); & END (ELSE *OK:=FALSE; &UNTIL NOT OK OR (ONEPAGE=LAST); &(* PTR now points to the first valid chBEGIN &MOVELEFT(EBUF^[STUFFSTART],EBUF^[LINESTART+2],BUFCOUNT-STUFFSTART); &READJUST(LINESTART,LINESTART+2-STUFFSTART); &CURSaracter in the buffer *) &IF COPYSTART= ''',TARGET:TLENGTH,'''' TO 10 DO WRITE(CHR(BS)); "END; " "PROCEDURE BOOL(B:BOOLEAN); "BEGIN $IF B THEN WRITE('True') ELSE WRITE('False'); $WRITEL); *IF SDEFINED THEN WRITE(', = ''',SUBSTRING:SLENGTH,''''); *WRITELN; WRITELN; & END; &IF COUNT>0 THEN WRITELN(' N "END; " "FUNCTION GETBOOL: BOOLEAN; "VAR CH: CHAR; "BEGIN $ERASE10; CH:=UCLC(GETCH); $WHILE NOT (CH IN ['T','F']) DO & Markers:'); &WRITE(' '); &FOR I:=0 TO COUNT-1 DO & BEGIN WRITE(' ':6,NAME[I]); BEGIN (WRITE('T or F'); (FOR TRASH:=0 TO 5 DO WRITE(CHR(BS)); (CH:=UCLC(GETCH) &END; $IF CH='T' THEN &BEGIN (WRITE('True *IF (I+4) MOD 3=0 THEN BEGIN WRITELN; WRITE(' ') END (END; &WRITELN; &WRITELN; &WRITELN(' Date Created: ',CREATED.MONTH '); (GETBOOL:=TRUE &END $ELSE &BEGIN (WRITE('False '); (GETBOOL:=FALSE &END; "END; " "FUNCTION GETINT: INTEGER; "VAR,'-',CREATED.DAY,'-', BCREATED.YEAR,' Last Used: ', BLASTUSED.MONTH,'-',LASTUSED.DAY,'-', BLASTUSED.YEAR); &GOTOXY(LENGTH( $CH:CHAR; $N: INTEGER; "BEGIN $ERASE10; $N:=0; $REPEAT &REPEAT (CH:=GETCH; (IF NOT (CH IN ['0'..'9',CHR(SP),CHR(CR)])  *THEN WRITE('#',CHR(BELL),CHR(BS)); &UNTIL CH IN ['0'..'9',CHR(SP),CHR(CR)]; &IF CH IN ['0'..'9'] THEN (BEGIN *WRITE(CH); O^*IF N<1000 THEN N:=N*10+ORD(CH)-ORD('0') (END; $UNTIL CH IN [CHR(SP),CHR(CR)]; $GETINT:=N; WRITE(' ') "END; "  BEGIN "WITH PAGEZERO DO $BEGIN &CLEARSCREEN; &PROMPTLINE:= ' Environment: {options} or to leave'; &PROMPT; NEEDPROMPT:=TRUE; &WRITELN; &WRITE( ' A(uto indent '); BOOL(AUTOINDENT); &WRITE( ' F(illing '); BOOL(FILLING); &WRITE( ' L(eft margin '); WRITELN(LMARGIN); &WRITE( ' R(ight margin '); WRITELN(RMARGIN); &WRITE( ' P(ara margin '); WRITELN(PARAMARGIN); &WRITE( ' C(ommand ch '); WRITELN(RUNOFFCH); &WRITE( ' T(oken def '); BOOL(TOKDEF); &WRITELN; &WRITELN(' ',BUFCOUNT,' bytes used, ',BUFSIZE-BUFCOUNT+1,' available.'); &WRITELN; &IF" ADJUST(LEFTPART+1,CURSOR-(LEFTPART+1)); "BUFCOUNT:=BUFCOUNT+CURSOR-(LEFTPART+1); "CURSOR:=LEFTPART+1; (* Cursor points to the O^beginning of the file *)  END;   PROCEDURE READERR;  BEGIN ERROR('Marker exceeds file bounds.',NONFATAL); "UNSPLITBUFF; "CENTERCURSOR(TRASH,MIDDLE,TRUE); "EXIT(COPYFILE)  END;   PROCEDURE SPLITBUF;  (* Split the buffer at the Cursor. Therest points to the right part, Lmove #is the length of the right part, Leftpart points to the end of the 'left #part', and Cursor remains unchanged. *)  BEGIN "THEREST:=BUFSIZE-(BUFCOUNT-CURSOR); "LMOVE:=BUFCOUNT-CURSOR+1; "LEFTPART:=CURSOR-1; "MOVERIGHT(EBUF^[CURSOR],EBUF^[THEREST],LMOVE)  END;   PROCEDURE PARSEFN;  VAR I,LPTR,RPTR,COMMA: INTEGER;   MARK: STRING;  BEGIN "LPTR:=POS('[',FN); "IF LPTR=0 THEN $BEGIN (* whole file *) &STARTMARK:=' '; &STOPMARK:= '  ' $END "ELSE $BEGIN &RPTR:=POS(']',FN); &IF (RPTR=0) OR (RPTRLENGTH(FN)) THEN ERRMARKER; &MARK:=COPYPROMPTLINE),0); &REPEAT (CH:=UCLC(GETCH); (IF NOT (CH IN ['A','C','F','L','P','R','T',' ',CHR(ETX),CHR(CR)]) THEN *BEGIN ERROR('Not option',NONFATAL); PROMPT; END (ELSE *CASE CH OF +'A': BEGIN GOTOXY(18,1); AUTOINDENT:=GETBOOL END; +'F': BEGIN GOTOSEGMENT PROCEDURE COPYFILE;  VAR "STARTPAGE,STOPPAGE,STARTOFFSET,STOPOFFSET, "LEFTPART,PAGE,NOTNULLS,THEREST,LMOVE: INTEGER; XY(18,2); FILLING:=GETBOOL END; +'L': BEGIN GOTOXY(18,3); LMARGIN:=GETINT END; +'R': BEGIN GOTOXY(18,4); RMARGIN:=GETINT END; "DONE,OVFLW: BOOLEAN; "BUFR: PACKED ARRAY [0..1023] OF CHAR;  STARTMARK,STOPMARK: PACKED ARRAY [0..7] OF CHAR; "FN: STRING+'P': BEGIN GOTOXY(18,5); PARAMARGIN:=GETINT END; +'C': BEGIN GOTOXY(18,6); READ(RUNOFFCH) END; +'T': BEGIN GOTOXY(18,7); TOK; "F: FILE;   PROCEDURE ERRMARKER;  BEGIN "ERROR('Improper marker specification.',NONFATAL); "EXIT(COPYFILE)  END;   DEF:=GETBOOL END *END; (GOTOXY(LENGTH(PROMPTLINE),0); &UNTIL CH IN [' ',CHR(ETX),CHR(CR)]; &REDISPLAY; $END;  END;  PROCEDURE UNSPLITBUF;  (* Stich the buffer back together again. *)  BEGIN "MOVELEFT(EBUF^[THEREST],EBUF^[CURSOR],LMOVE); "RE# A-1],MAX(0,8-(COMMA-1)),' '); &MOVELEFT(MARK[COMMA+1],STOPMARK,MIN(I,8)); &FILLCHAR(STOPMARK[I],MAX(0,8-I),' ') $END; "FOR I&BEGIN (ERROR('Marker not there.',NONFATAL); (UNSPLITBUFF; (EXIT(COPYFILE) &END; $OFF:=PZ.POFFSET[I]; $PNUM:=PZ.PAGEN[I]; :=0 TO 7 DO STARTMARK[I]:=UCLC(STARTMARK[I]); "FOR I:=0 TO 7 DO STOPMARK [I]:=UCLC(STOPMARK[I]); $IF PNUM=0 THEN &BEGIN OFF:=OFF-1; PNUM:=1 END; (* Kludge to maintain compatibility *) "END; "  BEGIN(* findmarkers *) "ST"FOR I:=1 TO LENGTH(FN) DO FN[I]:=UCLC(FN[I]); "IF ((POS('.TEXT',FN)<>LENGTH(FN)-4) OR %(LENGTH(FN)<=4)) AND (FN[LENGTH(FN)]ARTPAGE:=1; STARTOFFSET:=0; (* default values *) "STOPPAGE:=32767; STOPOFFSET:=32767; "IF (STARTMARK<>' ') OR (STO<>'.') THEN $FN:=CONCAT(FN,'.TEXT');  IF FN[LENGTH(FN)]='.' THEN DELETE(FN,LENGTH(FN),1);  END;   PROCEDURE STUFFIT(STARPMARK<>' ') THEN $BEGIN &IF BLOCKREAD(F,PZ,2,0)<>2 THEN READERR; &IF STARTMARK<>' ' THEN SEARCH(STARTMARK,STARTT,STOP:INTEGER);  (* Put the contents of BUFR into EBUF. OVFLW is set to true when there is #no more room in the buffer. *) OFFSET,STARTPAGE); &IF STOPMARK<>' ' THEN SEARCH(STOPMARK,STOPOFFSET,STOPPAGE) $END  END;   BEGIN  VAR AMOUNT: INTEGER;  BEGIN "IF START<=STOP THEN $BEGIN &AMOUNT:=STOP-START+1; &IF CURSOR+AMOUNT+250(*slop*)>=THEREST THEN"PROMPTLINE:=' Copy: From what file[marker,marker]? '; "REPEAT $PROMPT; $READLN(FN); $IF LENGTH(FN)=0 THEN EXIT(COPYFILE);  & BEGIN *ERROR('Buffer overflow.',NONFATAL); *UNSPLITBUFF; *CENTERCURSOR(TRASH,MIDDLE,TRUE); *EXIT(COPYFILE) (END &ELSE$PARSEFN; $RESET(F,FN); $PROMPTLINE:=' Copy: File not present. Filename? '; "UNTIL IORESULT=0; "PROMPTLINE:=' Copy'; PROMPT (BEGIN *MOVELEFT(BUFR[START],EBUF^[CURSOR],AMOUNT); *CURSOR:=CURSOR+AMOUNT (END $END  END;   PROCEDURE GETNEXT;  BEGI; "SPLITBUF;  FINDMARKERS; "PAGE:=STARTPAGE;  GETNEXT; "WHILE (STARTOFFSET>=NOTNULLS) AND NOT DONE DO $BEGIN &CHKOVFLN "DONE:=BLOCKREAD(F,BUFR,2,PAGE+PAGE)<>2; "WRITE('.'); "IF NOT DONE THEN NOTNULLS:=SCAN(-1024,<>CHR(0),BUFR[1023])+1024 "ELW; &STARTOFFSET:=STARTOFFSET-NOTNULLS; &GETNEXT; $END; "IF (STOPPAGE=NOTNULLS) AND (STOPPAGE=PAGE) OR (STOPOFFSET>=NOTNULLS))$BEGIN &STOPPAGE:=STOPPAGE+1; &STOPOFFSET:=STOPOFFSET-NOTNULLS; $END;  END;   PROCEDURE FINDMARKERS;  (* Given STARTMAR AND NOT DONE DO $BEGIN &CHKOVFLW; &GETNEXT; &IF (STOPPAGEPZ.NAME[I]) DO I:=I+1; $IF MNAME<>PZ.NAME[I] THEN $ k character *)  VAR "OLDPTR: PTRTYPE; "INDENT: INTEGER;  BEGIN "OLDPTR:=PTR; INDENT:=0; "WHILE ORD(EBUF^[PTR]) IN [HT,SP,CURSOR]=CHR(EOL) THEN PTR:=CURSOR ELSE PTR:=CURSOR+1; "LINE:=0; "REPEAT $PTR:=PTR-1; TOPOFFSET-1)) &ELSE (STUFFIT(0,NOTNULLS-1) $END; "IF IORESULT<>0 THEN ERROR('Disk Error.',NONFATAL);  UNSPLITBUF;  CENDLE] DO $BEGIN &IF EBUF^[PTR]=CHR(DLE) THEN (BEGIN PTR:=PTR+1; INDENT:=INDENT+ORD(EBUF^[PTR])-32 END &ELSE (IF ORD(EBUF^[PTTERCURSOR(TRASH,MIDDLE,TRUE);  CLOSE(F);  END;  R])=SP THEN INDENT:=INDENT+1 (ELSE *(*HT*) INDENT:=((INDENT DIV 8)+1)*8; (* KLUDGE FOR COLUMNAR TAB! *) &PTR:=PTR+1 $END; O^"BYTES:=PTR-OLDPTR; "LEADBLANKS:=INDENT;  END(*LEADBLANKS*);   PROCEDURE REDISPLAY;  (* Do a total update of the screen.  Note that this code is partially a #duplicate of lineout/upscreen for reasons of speed. This procedure is #called only from centercursor *)  VAR "LINEDIST,EOLDIST,LINE: INTEGER; "PTR: PTRTYPE; "T: PACKED ARRAY [0..MAXSW] OF CHAR;  BEGIN "BLANKCRT(1); "LINE:=1; "PTR:=LINE1PTR; "REPEAT $BLANKS:=MIN(LEADBLANKS(PTR,BYTES),SCREENWIDTH); $GOTOXY(BLANKS,LINE); $PTR:=PTR+BYTES; $EOLDIST:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[PTR]); $LINEDIST:=MAX(0,MIN(EOLDIST,SCREENWIDTH-BLANKS+1)); $MOVELEFT(EBUF^[PTR],T[0],LINEDIST); $IF EBUF^[PTR+LINEDIST]<>CHR(EOL) THEN (* Line truncation *) &T[MAX(0,LINEDIST-1)]:='!'; $WRITE(T:LINEDIST); $PTR:=PTR+EOLDIST+1; LINE:=LINE+1 "UNTIL (LINE>SCREENHEIGHT) OR (PTR>=BUFCOUNT)  END;   PROCEDURE CENTERCURSOR  (*VAR LINE: INTEGER; LINESUP: INTEGER; NEWSCREEN: BOOLEAN*);  (* Figure out if the cursor is still on the screen. If it is, aFUNCTION LEADBLANKS(* (PTR: PTRTYPE; VAR BYTES: INTEGER): INTEGER *);  (* On entry- &PTR points to the beginning of a line #Ond #newscreen is false, then no redisplay is done. Otherwise an attempt #is made to position the cursor at line "linesup". ln exit- &function returns the number of leading blanks on that line. &bytes has the offset into the line of the first non-blanine is then updated #to the actual line the cursor was forced to. *)  VAR "MARK: INTEGER; "PTR: PTRTYPE;  BEGIN "IF EBUF^[% (X,Y); "GOTOXY(X,Y)  END(* SHOWCURSOR *);   FUNCTION GETNUM(*:INTEGER*);  VAR "N: INTEGER; "OVERFLOW: BOOLEAN;  BEGIN  $  PROCEDURE LINEOUT(*VAR PTR:PTRTYPE; BYTES,BLANKS,LINE:INTEGER*);  (* Write a line out *)  VAR "LINEDIST,EOLDIST: INTEG"N:=0; "OVERFLOW:=FALSE; "IF NOT (CH IN ['0'..'9']) THEN N:=1 "ELSE $REPEAT &IF N > 1000 THEN OVERFLOW:=TRUE &ELSE (BEGIER; "T: PACKED ARRAY [0..MAXSW] OF CHAR;  BEGIN "GOTOXY(BLANKS,LINE); "PTR:=PTR+BYTES; N *N:=N*10+ORD(CH)-ORD('0'); *CH:=GETCH (END $UNTIL (NOT (CH IN ['0'..'9'])) OR OVERFLOW; "IF OVERFLOW THEN $BEGIN &ERROR"EOLDIST:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[PTR]); "LINEDIST:=MAX(0,MIN(EOLDIST,SCREENWIDTH-BLANKS+1)); "MOVELEFT(EBUF^[PTR],T[0],('Repeatfactor > 10,000',NONFATAL); &GETNUM:=0; $END "ELSE $GETNUM:=N;  COMMAND:=MAPTOCOMMAND(CH); (* Takes CH and maps iLINEDIST); "IF EBUF^[PTR+LINEDIST]<>CHR(EOL) THEN (* Line truncation *) $BEGIN &LINEDIST:=MAX(LINEDIST,1); &T[LINEDIST-1]:='$PTR:=SCAN(-MAXCHAR,=CHR(EOL),EBUF^[PTR])+PTR; $LINE:=LINE+1; $IF LINE=LINESUP THEN MARK:=PTR; "UNTIL (LINE>SCREENHEIGHT) ORt to a command *)  END;   PROCEDURE GETLEADING;  BEGIN "(* Sets: (LINESTART ......... A pointer to the beginning of the l ((LINE1PTR=PTR+1) AND NOT NEWSCREEN) OR (PTR<1); "IF LINE>SCREENHEIGHT THEN (* Off the screen *) $BEGIN LINE1PTR:=MARK+1; REDine (STUFFSTART ........ A pointer to the beginning of the text on the line (BYTES ............. The number of bytes between ISPLAY; LINE:=LINESUP END "ELSE $IF LINE1PTR=PTR+1 THEN &BEGIN (IF NEWSCREEN THEN REDISPLAY &END $ELSE &BEGIN (LINE1PTRLINESTART and (BUFSIZE-BUFCOUNT)+10 THEN $BEGIN &MSG:=  'There r the next line *) &EOLPTR:=SCAN(MAXCHAR,=CHR(EOL),EBUF^[PTR])+PTR $END; "(* Now find the indentation on that line of the curis no room to copy the deletion. Do you wish to delete anyway? (y/n)'; &PUTMSG; &IF UCLC(GETCH)='Y' THEN OKTODEL:=TRUE ELSE Osor *) "LEAD:=LEADBLANKS(PTR,I); "INDENT:=MIN(SCREENWIDTH,(LEAD-I)+(CURSOR-PTR)); KTODEL:=FALSE; $END "ELSE $BEGIN &(* COPYLINE is set by the caller *) ©OK:=TRUE; COPYLENGTH:=ABS(CURSOR-ANCHOR); ©:(* (extra spaces) + (offset into line) *)  END;(* FINDXY *)   PROCEDURE SHOWCURSOR;  VAR "X,Y: INTEGER;  BEGIN "FINDXYSTART:=BUFSIZE-COPYLENGTH+1; &MOVELEFT(EBUF^[MIN(CURSOR,ANCHOR)],EBUF^[COPYSTART],COPYLENGTH); &OKTODEL:=TRUE $END;  END;  & $ELSE (* Only update the part of the screen after the cursor *) &BEGIN (GOTOXY(0,LINE); ERASEOS(0,LINE); (GETLEADING; (PTR:[RUNOFFCH,CHR(EOL)]); *IF EBUF^[STUFFSTART] IN [RUNOFFCH,CHR(EOL)] THEN * PTR:=CURSOR+1 *ELSE ,PTR:=1; *X:=PARAMARGIN; (E=LINESTART; (REPEAT *BLANKS:=MIN(LEADBLANKS(PTR,BYTES),SCREENWIDTH); *LINEOUT(PTR,BYTES,BLANKS,LINE); (* Writes out the line ND &ELSE (BEGIN *PTR:=LINESTART; *IF BLANKS=PARAMARGIN THEN X:=PARAMARGIN ELSE X:=LMARGIN (END; &CURSOR:=BUFSIZE-(BUFCOUNTat ptr *) *LINE:=LINE+1 (UNTIL (LINE>SCREENHEIGHT) OR (PTR>=BUFCOUNT) &END;  END;   PROCEDURE READJUST(*CURSOR:PTRTYPE; D-PTR)+1; (* Split the buffer *) &MOVERIGHT(EBUF^[PTR],EBUF^[CURSOR],BUFCOUNT-PTR); ELTA: INTEGER*);  (* if DELTA<0 then move all affected markers to CURSOR. Also adjust all #markers >= CURSOR by DELTA *)  VA&(* Now dribble back the (rest of the) paragraph *) &EBUF^[PTR]:=CHR(DLE); &EBUF^[PTR+1]:=CHR(X+32); &PTR:=PTR+2; &EBUF^[CUR "I: INTEGER;  BEGIN "WITH PAGEZERO DO $FOR I:=0 TO COUNT-1 DO &IF POFFSET[I]>=CURSOR THEN POFFSET[I]:=MAX(POFFSET[I]+DELTRSOR-1]:=CHR(EOL); (* sentinel for getleading *) &DONE:=FALSE; &REPEAT (WHILE EBUF^[CURSOR] IN [CHR(HT),CHR(SP),CHR(DLE)] DO A,CURSOR);  IF (COPYSTART>=CURSOR) AND (COPYSTART" and "-" *) (IF EBUF^[CURSOR]='!'; $END; "WRITE(T:LINEDIST); "PTR:=PTR+EOLDIST+1  END;   PROCEDURE UPSCREEN(*FIRSTLINE,WHOLESCREEN: BOOLEAN; LINE: INTEG the #entire paragraph is filled, otherwise only that directly after the cursor ER*);  (* Zap, Insert and Delete call this procedure to update (possibly partially) #the screen. FIRSTLINE means only the lin#is filled. RFAC, when implemented will tell how many paragraphs to be #filled. Note: A paragraph is defined as lines of texe that the cursor is on need #be updated. WHOLESCREEN means that everything must be updated. If #neither of these is true tt delimited by a line #with no text on it whatsoever, or a line of a text whose first character is #RUNOFFCH *) #  VAR "SAVhen only the part of the screen that's after #the cursor is updated *)  VAR "PTR: PTRTYPE;   BEGIN (* Upscreen *) "IF FIRE,PTR,WPTR: INTEGER; "WLENGTH,X: INTEGER; "DONE: BOOLEAN;  BEGIN "WITH PAGEZERO DO $BEGIN &SAVE:=CURSOR; &CURSOR:=PARAPTRSTLINE THEN $BEGIN &GETLEADING; &GOTOXY(0,LINE); ERASETOEOL(0,LINE); (* Clean the line *) &LINEOUT(LINESTART,BYTES,BLANKS,LI; &GETLEADING; &IF EBUF^[STUFFSTART] IN [CHR(EOL),RUNOFFCH] THEN EXIT(THEFIXER); &IF WHOLE THEN (* Scan backwards for the begNE) (* Just this line *) $END "ELSE $IF WHOLESCREEN THEN &CENTERCURSOR(TRASH,MIDDLE,TRUE) inning of the paragraph *) (BEGIN *REPEAT ,CURSOR:=LINESTART-1; ,GETLEADING *UNTIL (LINESTART<=1) OR (EBUF^[STUFFSTART] IN ' TR+2]:=CHR(LMARGIN+32); ,PTR:=PTR+3; ,X:=LMARGIN *END; (CURSOR:=CURSOR+1; (MOVELEFT(EBUF^[WPTR],EBUF^[PTR],WLENGTH); (IF EBUF^[CURSOR-1]=CHR(EOL) THEN *BEGIN ,IF EBUF^[CURSOR]=CHR(0) THEN DONE:=TRUE ,ELSE .BEGIN 0GETLEADING; 0DONE:=(EBUF^[STUFFSTART]=CHR(EOL)) 6OR (EBUF^[STUFFSTART]=RUNOFFCH); 0(* The last transfer will move 3over the for the paragraph *) 0IF NOT DONE THEN 0 BEGIN 4EBUF^[PTR+WLENGTH-1]:=' '; . (* If , map to one space only *) 4IF EBUF^[CURSOR-2]=' ' THEN PTR:=PTR-1; 2END .END *END; (X:=X+WLENGTH; (PTR:=PTR+WLENGTH; &UNTIL DONE; &READJUST(PARAPTR,(BUFSIZE-CURSOO^R+PTR+1)-BUFCOUNT); &BUFCOUNT:=BUFSIZE-CURSOR+PTR+1; &MOVELEFT(EBUF^[CURSOR],EBUF^[PTR],BUFSIZE-CURSOR+1); &EBUF^[BUFCOUNT]:=CHR(0); &CURSOR:=MIN(BUFCOUNT-1,SAVE); &GETLEADING; &CURSOR:=MAX(CURSOR,STUFFSTART) #END;  END;   PROCEDURE GETNAME(*MSG:STRING; VAR M:NAME*);  VAR "I: INTEGER; "S: STRING;  BEGIN "NEEDPROMPT:=TRUE; HOME; CLEARLINE(0); WRITE(MSG,' what marker?  '); "READLN(S); "FOR I:=1 TO LENGTH(S) DO S[I]:=UCLC(S[I]); "MOVELEFT(S[1],M[0],MIN(8,LENGTH(S))); "FILLCHAR(M[LENGTH(S)],MAX(0,8-LENGTH(S)),' ')  END;  -' THEN IF EBUF^[CURSOR+1]=' ' THEN CURSOR:=CURSOR+1; (IF (EBUF^[CURSOR-1]='.') THEN IF +(EBUF^[CURSOR]=' ') AND (EBUF^[CURSOR+1]=' ') THEN CURSOR:=CURSOR+1; (WLENGTH:=CURSOR-WPTR+1; (* Including the delimiter *) (IF (X+WLENGTH>RMARGIN) OR (RMARGIN-LMARGIN+1<=WLENGTH) THEN *BEGIN ,IF EBUF^[PTR-1]=' ' THEN PTR:=PTR-1; ,EBUF^[PTR]:=CHR(EOL); EBUF^[PTR+1]:=CHR(DLE); ,EBUF^[P( OF INTEGER; "USERINFO: INFOREC; "TRASHYY: ARRAY [0..4] OF INTEGER; "SYVID,DKVID: VID;  THEDATE: DATEREC;    SEGMENT PROCEDURE EDITOR(XXX,YYY: INTEGER);  CONST "(* Unless otherwise noted all constants are upper bounds %from zero. (*$U-*)  CONST "VIDLENG = 7; (* Number of characters in a volume ID *) "TIDLENG = 15; (* Number of characters in a title ID *)  "MAXBUFSIZE=32767; "MAXSW=84; (* Maximum allowable SCREENWIDTH *) "MAXSTRING=127; "MAXCHAR=1023; (* The maximum numbe*) %  TYPE  "DATEREC=PACKED RECORD ,MONTH: 0..12; ,DAY: 0..31; ,YEAR: 0..100 *END; * "VID = STRING[VIDLENG]; " "r of characters on a line in the EBUF *) "TIDLENG=15; (* From SYSCOM *) "CHARINBUF=2048; (* For final version. Not used. *) TID = STRING[TIDLENG]; " "INFOREC = RECORD .TRASH1,TRASH2: INTEGER; .ERRSYM,ERRBLK,ERRNUM: INTEGER; (* Error com for EDIT"MAXOFFSET=1023; (* Maximum offset in a page *) "MAXPAGE=255; (* Ridiculous upper bound! *) "  *) .TRASH3: ARRAY [0..2] OF INTEGER; .GOTSYM,GOTCODE: BOOLEAN; .WORKVID,SYMVID,CODEVID: VID; (* Perm&Cur workfile volum"(* The following ASCII characters are hard-wired in *) "HT=9; LF=10; EOL=13; DLE=16; SP=32; "DC1=17; BELL=7; RUBOUT=127; CR=es *) .WORKTID,SYMTID,CODETID: TID (* Perm&Cur workfile titles *) ,END (*INFOREC*) ; " "SYSCOMREC = RECORD 0JUNK: ARR13; "   TYPE "PTRTYPE=0..MAXBUFSIZE; "BUFRTYPE=PACKED ARRAY [0..0] OF CHAR; "BLOCKTYPE=PACKED ARRAY [0..511] OF CHAR; "EAY [0..6] OF INTEGER; 0LASTMP: INTEGER; 0EXPANSION: ARRAY [0..20] OF INTEGER; 0MISCINFO: PACKED RECORD  false *) -COUNT: INTEGER; (* The count of valid markers *) -NAME: TH: INTEGER; (* Length of target and substring *) "SDEFINED,TDEFINED: BOOLEAN; (* Whether the strings are valid *) "CO ARRAY [0..9] OF